home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / RkrmSrc / Intuition / Screens / dualplayfield.e < prev    next >
Encoding:
Text File  |  1996-08-29  |  5.1 KB  |  158 lines
  1. -> dualplayfield.e - Shows how to turn on dual-playfield mode in a screen.
  2.  
  3. MODULE 'intuition/intuition',  -> Intuition data structures and tags
  4.        'intuition/screens',    -> Screen data structures and tags
  5.        'graphics/modeid',      -> Release 2 Amiga display mode ID's
  6.        'exec/memory',          -> Memory flags
  7.        'graphics/gfx',         -> Bitmap and other structures
  8.        'graphics/rastport',    -> RastPort and other structures
  9.        'graphics/view'         -> ViewPort and other structures
  10.  
  11. ENUM ERR_NONE, ERR_SCRN, ERR_WIN, ERR_RAST, ERR_MODEID
  12.  
  13. RAISE ERR_SCRN   IF OpenScreenTagList()=NIL,
  14.       ERR_WIN    IF OpenWindowTagList()=NIL,
  15.       ERR_RAST   IF AllocRaster()=NIL,
  16.       ERR_MODEID IF GetVPModeID()=INVALID_ID
  17.  
  18. PROC main() HANDLE
  19.   DEF win=NIL, scr=NIL
  20.   -> E-Note: E automatically opens the Intuition and Graphics libraries
  21.   scr:=OpenScreenTagList(NIL,
  22.                         [SA_DEPTH,     2,
  23.                          SA_DISPLAYID, HIRES_KEY,
  24.                          SA_TITLE,     'Dual Playfield Test Screen',
  25.                          NIL])
  26.   win:=OpenWindowTagList(NIL,
  27.                         [WA_TITLE,        'Dual Playfield Mode',
  28.                          WA_IDCMP,        IDCMP_CLOSEWINDOW,
  29.                          WA_WIDTH,        200,
  30.                          WA_HEIGHT,       100,
  31.                          WA_DRAGBAR,      TRUE,
  32.                          WA_CLOSEGADGET,  TRUE,
  33.                          WA_CUSTOMSCREEN, scr,
  34.                          NIL])
  35.   doDualPF(win)
  36.  
  37.   -> E-Note: exit and clean up via handler
  38. EXCEPT DO
  39.   IF win THEN CloseWindow(win)
  40.   IF scr THEN CloseScreen(scr)
  41.   -> E-Note: we can print a minimal error message
  42.   SELECT exception
  43.   CASE ERR_SCRN;   WriteF('Error: Failed to open custom screen\n')
  44.   CASE ERR_WIN;    WriteF('Error: Failed to open window\n')
  45.   CASE ERR_RAST;   WriteF('Error: Ran out of memory in AllocRaster\n')
  46.   CASE ERR_MODEID; WriteF('Error: Bad/invalid mode ID for viewport\n')
  47.   CASE "MEM";      WriteF('Error: Ran out of memory\n')
  48.   ENDSELECT
  49. ENDPROC
  50.  
  51. -> Allocate all of the stuff required to add dual playfield to a screen.
  52. PROC doDualPF(win:PTR TO window) HANDLE
  53.   DEF myscreen:PTR TO screen,  rinfo2=NIL:PTR TO rasinfo,
  54.       bmap2=NIL:PTR TO bitmap, rport2=NIL:PTR TO rastport
  55.  
  56.   myscreen:=win.wscreen  -> Find the window's screen
  57.  
  58.   -> Allocate the second playfield's rasinfo, bitmap, and bitplane
  59.   -> E-Note: NewM raises an exception if it fails
  60.   rinfo2:=NewM(SIZEOF rasinfo, MEMF_PUBLIC OR MEMF_CLEAR)
  61.   -> Get a rastport, and set it up for rendering into bmap2
  62.   rport2:=NewM(SIZEOF rastport, MEMF_PUBLIC)
  63.   bmap2:=NewM(SIZEOF bitmap, MEMF_PUBLIC OR MEMF_CLEAR)
  64.   InitBitMap(bmap2, 1, myscreen.width, myscreen.height)
  65.   
  66.   -> Extra playfield will only use one bitplane here.
  67.   -> E-Note: automatically error checked (automatic exception)
  68.   bmap2.planes[0]:=AllocRaster(myscreen.width, myscreen.height)
  69.   InitRastPort(rport2)
  70.   rinfo2.bitmap:=bmap2
  71.   rport2.bitmap:=bmap2
  72.  
  73.   SetRast(rport2, 0)
  74.  
  75.   -> E-Note: an exception will be raised if installDualPF fails
  76.   installDualPF(myscreen, rinfo2)
  77.   SetRGB4(myscreen.viewport, 9, 0, $F, 0)
  78.  
  79.   drawSomething(rport2)
  80.  
  81.   handleIDCMP(win)
  82.  
  83.   removeDualPF(myscreen)
  84.  
  85.   -> E-Note: exit and clean up via handler
  86. EXCEPT DO
  87.   IF bmap2
  88.     IF bmap2.planes[0] -> E-Note: NewM makes this zero when bmap2 allocated
  89.       FreeRaster(bmap2.planes[0], myscreen.width, myscreen.height)
  90.     ENDIF
  91.     Dispose(bmap2)
  92.   ENDIF
  93.   IF rport2 THEN Dispose(rport2)
  94.   IF rinfo2 THEN Dispose(rinfo2)
  95.   -> E-Note: pass exception on if it was an error
  96.   ReThrow()
  97. ENDPROC
  98.  
  99. -> Manhandle the viewport: install second playfield and change modes
  100. PROC installDualPF(scrn:PTR TO screen, rinfo2)
  101.   -> You can only play with the bits in the Modes field if the upper half of
  102.   -> the screen mode ID is zero!!!
  103.   -> E-Note: automatic and explicit exceptions raised here
  104.   IF GetVPModeID(scrn.viewport) AND $FFFF0000 THEN Raise(ERR_MODEID)
  105.  
  106.   Forbid()
  107.  
  108.   -> Install rinfo2 for viewport's second playfield
  109.   scrn.viewport.rasinfo.next:=rinfo2
  110.   scrn.viewport.modes:=scrn.viewport.modes OR V_DUALPF
  111.  
  112.   Permit()
  113.  
  114.   -> Put viewport change into effect
  115.   MakeScreen(scrn)
  116.   RethinkDisplay()
  117. ENDPROC
  118.  
  119. -> Draw some lines in a rast port... This is used to get some data into the
  120. -> second playfield.  The windows on the screen will move underneath these
  121. -> graphics without disturbing them.
  122. PROC drawSomething(rp:PTR TO rastport)
  123.   DEF width, height, r, c
  124.  
  125.   width:=rp.bitmap.bytesperrow * 8
  126.   height:=rp.bitmap.rows
  127.  
  128.   SetAPen(rp, 1)
  129.  
  130.   FOR r:=0 TO height-1 STEP 40
  131.     FOR c:=0 TO width-1 STEP 40
  132.       -> E-Note: we could use E's graphics functions
  133.       Move(rp, 0, r)
  134.       Draw(rp, c, 0)
  135.     ENDFOR
  136.   ENDFOR
  137. ENDPROC
  138.  
  139. -> Simple event loop to wait for the user to hit the close gadget on the window.
  140. PROC handleIDCMP(win)
  141.   WHILE WaitIMessage(win)<>IDCMP_CLOSEWINDOW
  142.   ENDWHILE
  143. ENDPROC
  144.  
  145. -> Remove the effects of installDualPF().
  146. -> Only call if installDualPF() succeeded.
  147. PROC removeDualPF(scrn:PTR TO screen)
  148.   Forbid()
  149.  
  150.   scrn.viewport.rasinfo.next:=NIL
  151.   scrn.viewport.modes:=scrn.viewport.modes AND Not(V_DUALPF)
  152.  
  153.   Permit()
  154.  
  155.   MakeScreen(scrn)
  156.   RethinkDisplay()
  157. ENDPROC
  158.