home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / amigae / e_v3.2a / rkrmsrc / intuition / screens / clonescreen.e next >
Text File  |  1977-12-31  |  5KB  |  121 lines
  1. -> clonescreen.e - clone an existing public screen
  2.  
  3. MODULE 'intuition/screens', -> Screen data structures and tags
  4.        'graphics/text',     -> Text font structure
  5.        'graphics/modeid',   -> Release 2 Amiga display mode ID's
  6.        'exec/nodes',        -> Nodes -- get font name
  7.        'exec/ports'         -> Ports -- get font name
  8.  
  9. ENUM ERR_NONE, ERR_SCRN, ERR_LOCKPUB, ERR_GETDRAW, ERR_MODEID, ERR_FONT
  10.  
  11. RAISE ERR_SCRN    IF OpenScreenTagList()=NIL,
  12.       ERR_LOCKPUB IF LockPubScreen()=NIL,
  13.       ERR_GETDRAW IF GetScreenDrawInfo()=NIL,
  14.       ERR_MODEID  IF GetVPModeID()=INVALID_ID,
  15.       ERR_FONT    IF OpenFont()=NIL,
  16.       "MEM"       IF String()=NIL
  17.  
  18. PROC main()
  19.   DEF pub_screen_name
  20.   pub_screen_name:='Workbench'
  21.  
  22.   IF KickVersion(37)
  23.     -> Require version 37
  24.     -> E-Note: E automatically opens the Intuition and Graphics libraries
  25.     cloneScreen(pub_screen_name)
  26.   ENDIF
  27. ENDPROC
  28.  
  29. -> Clone a public screen whose name is passed to the routine.  Width, Height,
  30. -> Depth, Pens, Font and DisplayID attributes are all copied from the screen.
  31. -> Overscan is assumed to be OSCAN_TEXT, as there is no easy way to find the
  32. -> overscan type of an existing screen.  AutoScroll is turned on, as it does
  33. -> not hurt.  Screens that are smaller than the display clip will not scroll.
  34.  
  35. PROC cloneScreen(pub_screen_name) HANDLE
  36.   DEF my_screen=NIL:PTR TO screen, screen_modeID, pub_scr_font_name,
  37.       font_name, pub_screen_font:PTR TO textattr, opened_font,
  38.       pub_screen=NIL:PTR TO screen, screen_drawinfo=NIL:PTR TO drawinfo
  39.  
  40.   -> pub_screen_name is a pointer to the name of the public screen to clone
  41.   -> E-Note: automatically error-checked (automatic exception)
  42.   pub_screen:=LockPubScreen(pub_screen_name)
  43.  
  44.   -> Get the DrawInfo structure from the locked screen
  45.   -> E-Note: automatically error-checked (automatic exception)
  46.   screen_drawinfo:=GetScreenDrawInfo(pub_screen)
  47.  
  48.   -> E-Note: pub_screen.viewport is a structure in C and (as usual) a pointer
  49.   -> to the structure in E
  50.   -> E-Note: automatically error-checked (automatic exception)
  51.   screen_modeID:=GetVPModeID(pub_screen.viewport)
  52.  
  53.   -> Get a copy of the font
  54.   -> The name of the font must be copied as the public screen may go away at
  55.   -> any time after we unlock it.  Allocate enough memory to copy the font
  56.   -> name, create a TextAttr that matches the font, and open the font.
  57.   -> E-Note: pointer typing needed to multiply select from system objects
  58.   pub_scr_font_name:=screen_drawinfo.font.mn.ln.name
  59.  
  60.   -> E-Note: allocate and copy all in one go
  61.   -> E-Note: automatically error-checked (automatic exception)
  62.   font_name:=StrCopy(String(StrLen(pub_scr_font_name)), pub_scr_font_name)
  63.  
  64.   -> E-Note: use a typed list for initialised object
  65.   pub_screen_font:=[font_name,
  66.                     screen_drawinfo.font.ysize,
  67.                     screen_drawinfo.font.style,
  68.                     screen_drawinfo.font.flags]:textattr
  69.   
  70.   -> E-Note: pub_screen_font is a structure in C and (as usual) a pointer to
  71.   ->         the structure in E
  72.   -> E-Note: automatically error-checked (automatic exception)
  73.   opened_font:=OpenFont(pub_screen_font)
  74.  
  75.   -> screen_modeID may now be used in a call to OpenScreenTagList() with the
  76.   -> tag SA_DISPLAYID
  77.   -> E-Note: automatically error-checked (automatic exception)
  78.   my_screen:=OpenScreenTagList(NIL,
  79.                               [SA_WIDTH,      pub_screen.width,
  80.                                SA_HEIGHT,     pub_screen.height,
  81.                                SA_DEPTH,      screen_drawinfo.depth,
  82.                                SA_OVERSCAN,   OSCAN_TEXT,
  83.                                SA_AUTOSCROLL, TRUE,
  84.                                SA_PENS,       screen_drawinfo.pens,
  85.                                SA_FONT,       pub_screen_font,
  86.                                SA_DISPLAYID,  screen_modeID,
  87.                                SA_TITLE,      'Cloned Screen',
  88.                                NIL])
  89.  
  90.   -> Free the drawinfo and public screen as we don't need them any more.
  91.   -> We now have our own screen.
  92.   FreeScreenDrawInfo(pub_screen, screen_drawinfo)
  93.   screen_drawinfo:=NIL
  94.   UnlockPubScreen(pub_screen_name, pub_screen)
  95.   pub_screen:=NIL
  96.  
  97.   Delay(300)  -> Should be the rest of the program
  98.  
  99.   -> E-Note: exit and clean up via handler
  100. EXCEPT DO
  101.   -> The first two are freed in the main code if OpenScreenTagList() does not
  102.   -> fail.  If something goes wrong, free them here.
  103.   IF screen_drawinfo THEN FreeScreenDrawInfo(pub_screen, screen_drawinfo)
  104.   IF pub_screen THEN UnlockPubScreen(pub_screen_name, pub_screen)
  105.   IF my_screen THEN CloseScreen(my_screen)
  106.   IF opened_font THEN CloseFont(opened_font)
  107.   -> E-Note: it is not strictly necessary, but tidy, to free the font_name
  108.   IF font_name THEN DisposeLink(font_name)
  109.   -> E-Note: we can print a minimal error message
  110.   SELECT exception
  111.   CASE ERR_FONT
  112.     -> E-Note: it's helpful to say which font went wrong
  113.     WriteF('Error: Failed to open font "\s"\n', font_name)
  114.   CASE ERR_GETDRAW; WriteF('Error: Failed to get DrawInfo of screen\n')
  115.   CASE ERR_LOCKPUB; WriteF('Error: Failed to locked public screen\n')
  116.   CASE ERR_MODEID;  WriteF('Error: Public screen has invalid mode ID\n')
  117.   CASE ERR_SCRN;    WriteF('Error: Failed to open custom screen\n')
  118.   CASE "MEM";       WriteF('Error: Ran out of memory\n')
  119.   ENDSELECT
  120. ENDPROC
  121.