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 / doublebuffer.e < prev    next >
Text File  |  1977-12-31  |  6KB  |  145 lines
  1. -> doublebuffer.e - Show the use of a double-buffered screen
  2.  
  3. MODULE 'intuition/screens',  -> Screen data structures
  4.        'graphics/rastport',  -> RastPort and other structures
  5.        'graphics/view',      -> ViewPort and other structures
  6.        'graphics/gfx'        -> BitMap and other structures
  7.  
  8. -> Characteristics of the screen
  9. CONST SCR_WIDTH=320, SCR_HEIGHT=200, SCR_DEPTH=2
  10.  
  11. -> Exception values
  12. -> E-Note: exceptions are a much better way of handling errors
  13. ENUM ERR_NONE, ERR_SCRN, ERR_RAST
  14.  
  15. -> Automatically raise exceptions
  16. -> E-Note: these take care of a lot of error cases
  17. RAISE ERR_SCRN IF OpenScreen()=NIL,
  18.       ERR_RAST IF AllocRaster()=NIL
  19.  
  20. -> Main routine.  Setup for using the double buffered screen.  Clean up all
  21. -> resources when done or on any error.
  22. PROC main() HANDLE
  23.   DEF myBitMaps=NIL:PTR TO LONG, screen=NIL:PTR TO screen
  24.   -> E-Note: E automatically opens the Intuition and Graphics libraries
  25.   myBitMaps:=setupBitMaps(SCR_DEPTH, SCR_WIDTH, SCR_HEIGHT)
  26.  
  27.   -> Open a simple quiet screen that is using the first of the two bitmaps.
  28.   -> E-Note: use a typed list to get an initialised object
  29.   -> E-Note: automatically error-checked (automatic exception)
  30.   screen:=OpenScreen([0,           -> LeftEdge
  31.                       0,           -> TopEdge
  32.                       SCR_WIDTH,   -> Width
  33.                       SCR_HEIGHT,  -> Height
  34.                       SCR_DEPTH,   -> Depth
  35.                       0,           -> DetailPen
  36.                       1,           -> BlockPen
  37.                       V_HIRES,     -> ViewModes
  38.                       CUSTOMSCREEN OR CUSTOMBITMAP OR SCREENQUIET,  -> Type
  39.                       NIL,         -> Font
  40.                       NIL,         -> DefaultTitle
  41.                       NIL,         -> Gadgets
  42.                       myBitMaps[0] -> CustomBitMap
  43.                      ]:ns)
  44.   -> Indicate that the rastport is double buffered.
  45.   screen.rastport.flags:=RPF_DBUFFER
  46.   runDBuff(screen, myBitMaps)
  47.  
  48.   -> E-Note: exit and clean up via handler
  49. EXCEPT DO
  50.   IF screen THEN CloseScreen(screen)
  51.   IF myBitMaps THEN freeBitMaps(myBitMaps, SCR_DEPTH, SCR_WIDTH, SCR_HEIGHT)
  52.   -> E-Note: we can print a minimal error message
  53.   SELECT exception
  54.   CASE ERR_SCRN; WriteF('Error: Failed to open custom screen\n')
  55.   CASE ERR_RAST; WriteF('Error: Ran out of memory in AllocRaster()\n')
  56.   CASE "MEM";    WriteF('Error: Ran out of memory\n')
  57.   ENDSELECT
  58. ENDPROC
  59.  
  60. -> setupBitMaps(): allocate the bit maps for a double buffered screen.
  61. PROC setupBitMaps(depth, width, height) HANDLE
  62.   DEF myBitMaps:PTR TO LONG
  63.   -> E-Note: an immediate list in E takes the place of the static in C
  64.   -> E-Note: initialise the two bitmaps to NIL pointers 
  65.   myBitMaps:=[NIL,NIL]
  66.   -> E-Note: NewR raises an exception if it fails
  67.   myBitMaps[0]:=NewR(SIZEOF bitmap)
  68.   myBitMaps[1]:=NewR(SIZEOF bitmap)
  69.   InitBitMap(myBitMaps[0], depth, width, height)
  70.   InitBitMap(myBitMaps[1], depth, width, height)
  71.   setupPlanes(myBitMaps[0], depth, width, height)
  72.   setupPlanes(myBitMaps[1], depth, width, height)
  73. EXCEPT
  74.   freeBitMaps(myBitMaps, depth, width, height)
  75.   -> E-Note: exception must be passed on to caller
  76.   ReThrow()
  77. ENDPROC myBitMaps
  78.  
  79. -> runDBuff(): loop through a number of iterations of drawing into alternate
  80. -> frames of the double-buffered screen.  Note that the object is drawn in
  81. -> colour 1.
  82. PROC runDBuff(screen:PTR TO screen, myBitMaps:PTR TO LONG)
  83.   DEF ktr, xpos, ypos, toggleFrame=0
  84.   SetAPen(screen.rastport, 1)
  85.   FOR ktr:=1 TO 199
  86.     -> Calculate a position to place the object, these calculations ensure the
  87.     -> object will stay on the screen given the range of ktr and the size of
  88.     -> the object.
  89.     xpos:=ktr
  90.     ypos:=IF Mod(ktr,100)>=50 THEN 50-Mod(ktr,50) ELSE Mod(ktr,50)
  91.  
  92.     -> Switch the bitmap so that we are drawing into the correct place
  93.     screen.rastport.bitmap:=myBitMaps[toggleFrame]
  94.     screen.viewport.rasinfo.bitmap:=myBitMaps[toggleFrame]
  95.  
  96.     -> Draw the object
  97.     -> Here we clear the old frame and draw a simple filled rectangle
  98.     SetRast(screen.rastport, 0)
  99.     RectFill(screen.rastport, xpos, ypos, xpos+100, ypos+100)
  100.  
  101.     -> Update the physical display to match the newly drawn bitmap
  102.     MakeScreen(screen)  -> Tell Intuition to do its stuff
  103.     RethinkDisplay()    -> Intuition compatible MrgCop() & LoadView()
  104.                         ->   It also does a WaitTOF()
  105.  
  106.     -> Switch the frame number for the next time through
  107.     -> E-Note: this is exactly what the C version does...
  108.     toggleFrame:=Eor(toggleFrame, 1)
  109.   ENDFOR
  110. ENDPROC
  111.  
  112. -> freeBitMaps(): free up the memory allocated by setupBitMaps()
  113. PROC freeBitMaps(myBitMaps:PTR TO LONG, depth, width, height)
  114.   -> E-Note: freeBitMaps() can be safely if written carefully
  115.   IF myBitMaps[0]
  116.     freePlanes(myBitMaps[0], depth, width, height)
  117.     Dispose(myBitMaps[0])
  118.   ENDIF
  119.   IF myBitMaps[1]
  120.     freePlanes(myBitMaps[1], depth, width, height)
  121.     Dispose(myBitMaps[1])
  122.   ENDIF
  123. ENDPROC
  124.  
  125. -> setupPlanes(): allocate the bit planes for a screen bit map
  126. PROC setupPlanes(bitMap:PTR TO bitmap, depth, width, height)
  127.   DEF plane_num, planes:PTR TO LONG
  128.   planes:=bitMap.planes
  129.   FOR plane_num:=0 TO depth-1
  130.     -> E-Note: automatically error-checked (automatic exception)
  131.     planes[plane_num]:=AllocRaster(width, height)
  132.     BltClear(planes[plane_num], (width/8)*height, 1)
  133.   ENDFOR
  134.   -> E-Note: exceptions handled in caller, which frees memory
  135. ENDPROC
  136.  
  137. -> freePlanes(): free up the memory allocated by setupPlanes()
  138. PROC freePlanes(bitMap:PTR TO bitmap, depth, width, height)
  139.   DEF plane_num, planes:PTR TO LONG
  140.   planes:=bitMap.planes
  141.   FOR plane_num:=0 TO depth-1
  142.     IF planes[plane_num] THEN FreeRaster(planes[plane_num], width, height)
  143.   ENDFOR
  144. ENDPROC
  145.