home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 311.lha / HAMmmm2 / mmm_screen < prev    next >
Encoding:
Text File  |  1980-12-05  |  4.0 KB  |  146 lines
  1. \ Make screen and window for HAMmmm display.
  2. \ Use double buffering to achieve smooth animation.
  3. \
  4. \ MOD: PLB 7/18/89 Use GR.OPENCURW for safer open.
  5. \
  6. \ Author: Phil Burk
  7. \ Copyright 1987 Phil Burk
  8. \ This code is considered to be in the public domain and
  9. \ may be freely distributed but may not be sold for profit.
  10.  
  11. ANEW TASK-MMM_SCREEN
  12.  
  13. \ Declare Intuition structures.
  14. NewScreen HAMNewScreen
  15. NewWindow HAMNewWindow
  16.  
  17. VARIABLE HAMScreen  ( holder for relative screen pointer )
  18.  
  19. \ Define drawing surface.
  20. 0 constant HAM_XMIN
  21. 10 constant HAM_YMIN
  22. 320 constant HAM_XMAX
  23. 200 constant HAM_YMAX
  24.  
  25. : HAM.OPEN ( -- window | NULL , open custom HAM screen and window)
  26.      gr.init   
  27. \ Set to default values.
  28.      HAMNewScreen NewScreen.Setup
  29.      HAMNewWindow NewWindow.Setup
  30. \
  31. \ Modify defaults for this demo.
  32.      HAM HAMNewScreen ..! ns_viewmodes   ( Change to HAM )
  33.      6 HAMNewScreen ..! ns_depth
  34.      0" HAMmmm2    by Phil Burk" >abs
  35.         HAMNewScreen ..! ns_DefaultTitle
  36. \
  37. \ Open Screen and store pointer in NewWindow structure.
  38.      HAMNewScreen openscreen() dup
  39.      IF  dup HAMScreen !  ( Open screen. )
  40.          >abs HAMNewWindow ..! nw_screen ( Modify window for this screen)
  41. \
  42. \ Sometimes the Amiga can build a bad COPPER list for screens.
  43. \ This can happen if you have Emacs up in INTERLACE mode and open a
  44. \ NON-INTERLACE screen.
  45. \ The following call will correct this problem (hopefully).
  46.         RemakeDisplay()
  47. \
  48. \ Set up Backdrop window.
  49.         CUSTOMSCREEN   HAMNewWindow ..! nw_type
  50.         0    HAMNewWindow ..! nw_TopEdge
  51.         ham_xmax  HAMNewWindow ..! nw_Width
  52.         ham_ymax  HAMNewWindow ..! nw_Height
  53.         BACKDROP  ACTIVATE | BORDERLESS | HAMNewWindow ..! nw_flags
  54.         MENUVERIFY MENUPICK | HAMNewWindow ..! nw_IDCMPFlags
  55.         HAMNewWindow gr.opencurw
  56.     ELSE drop NULL
  57.     THEN
  58. ;
  59.  
  60. : HAM.CLOSE ( -- , Close screen and window.)
  61.     gr.closecurw
  62.     HAMScreen @ ?dup
  63.     IF closescreen()
  64.     THEN
  65. ;
  66.  
  67. \ -----------------------------------------------
  68. \ ------- Double Buffering ----------------------
  69. \ -----------------------------------------------
  70. \
  71. \ A BACKDROP window's Rastport points to the Bitmap
  72. \ that is contained in the screen structure.  This
  73. \ Bitmap points to 6 planes allocated by intuition.
  74. \ We can switch to a new drawing surface by replacing
  75. \ the original 6 plane pointers with pointers to
  76. \ our own 6 planes.  We can then draw into these planes
  77. \ using the Rastport from the window.  When we are through
  78. \ drawing we can make these visible by rebuilding the
  79. \ display Copper lists. By repeating this process we can
  80. \ always be drawing into a surface that is not visible
  81. \ thus eliminating visual breakup of the display.
  82.  
  83. 6 array BIT-PLANES-0  ( store pointers to drawing surfaces )
  84. 6 array BIT-PLANES-1
  85.  
  86. : ALLOC.BIT.PLANES ( -- , allocate second drawing surface )
  87.     6 0
  88.     DO 320 200 allocraster() >abs
  89.        i bit-planes-1 !
  90.     LOOP
  91. ;
  92. : FREE.BIT.PLANES ( -- , free when done )
  93.     6 0
  94.     DO i bit-planes-1 @ ?dup
  95.        IF >rel 320 200 freeraster()
  96.        THEN
  97.     LOOP
  98. ;
  99.  
  100. : SCREEN.PLANE.BASE  ( -- addr , of pointer to first plane )
  101.     hamscreen @ .. sc_bitmap .. bm_planes
  102. ;
  103.  
  104. variable PLANES-CURRENT  ( 0/1 )
  105.  
  106. : GRAB.FIRST.BUFFER ( -- , get planes allocated by OpenScreen )
  107.     screen.plane.base 0 bit-planes-0 6 cells move
  108.     0 planes-current !
  109. ;
  110.  
  111. : HAM.REBUILD ( -- , rebuild HAM screen , make changes visible )
  112.     hamscreen @ >abs call intuition_lib makescreen drop
  113.     call intuition_lib rethinkdisplay drop
  114. ;
  115.  
  116. : SWAP.BUFFERS ( -- , swap bit planes so draw in next buffer )
  117.     planes-current @ 0=
  118.     IF 0 bit-planes-1
  119.     ELSE 0 bit-planes-0
  120.     THEN
  121.     screen.plane.base 6 cells move
  122.     planes-current @ 1 xor planes-current !
  123. ;
  124.  
  125. : HAM.SHOW&SWAP ( flag -- )
  126.     dup not
  127.     HAMScreen @ swap showtitle()  ( force REdraw )
  128.     HAMScreen @ swap showtitle()
  129.     swap.buffers
  130. ;
  131.  
  132. : BUFFERS.INIT ( -- )
  133.     alloc.bit.planes
  134.     grab.first.buffer
  135.     swap.buffers
  136.     1 ham.show&swap
  137. ;
  138.  
  139. : BUFFERS.TERM  ( -- )
  140. \ Make sure CloseScreen deallocates proper planes.
  141.     planes-current @ 0= 0=
  142.     IF swap.buffers
  143.     THEN
  144.     free.bit.planes
  145. ;
  146.