home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d01xx / d0118.lha / HAMmmm / mmm_draw < prev    next >
Text File  |  1987-12-03  |  4KB  |  172 lines
  1. \ HAM drawing routine for HAMmmm.
  2. \ Provides several points which bounce around on screen.
  3. \ Lines are then drawn beteen pairs of points.
  4.  
  5. ANEW TASK-MMM_DRAW
  6.  
  7. ham_xmax ham_xmin - 16 / constant HAM_X/16
  8.  
  9. : HAM.SHOW.COLORS  ( -- , test routine )
  10.     16 0
  11.     DO i gr.color!
  12.        ham_xmin ham_x/16 i * + ham_ymin
  13.        over ham_x/16 + ham_ymax gr.rect
  14.     LOOP
  15. ;
  16.  
  17. : HAM.SET.RGB ( n red green blue -- )
  18.     >r >r >r >r
  19.     hamscreen @ .. sc_viewport >abs
  20.     r> r> r> r>
  21.     call graphics_lib setrgb4 drop
  22. ;
  23.  
  24. : HAM.SET.COLORS  ( -- , create a rainbow like spectrum )
  25.     0 0 0 0 ham.set.rgb  ( set zero to black )
  26.     8 0  ( red to green )
  27.     DO i 1+  ( index )
  28.        15  i 15 * 8 / -   ( red )
  29.        i 15 * 8 /         ( green )
  30.        0  ( blue )
  31.        ham.set.rgb
  32.     LOOP
  33.     8 0  ( green to blue )
  34.     DO i 8 +
  35.        0  ( red )
  36.        15  i 15 * 8 / -   ( green )
  37.        i 15 * 8 /         ( blue )
  38.        ham.set.rgb
  39.     LOOP
  40. ;     
  41.        
  42. \ Constants for building colors.
  43. $ 10 constant HAM_CHANGE_BLUE
  44. $ 20 constant HAM_CHANGE_RED
  45. $ 30 constant HAM_CHANGE_GREEN
  46.  
  47. : HAM.COLOR!  ( RGB new_value -- , set HAM color )
  48.     OR gr.color!
  49. ;
  50.  
  51. ham_ymax ham_ymin  + 2/ constant HAM_1/2Y
  52.  
  53. : HAM.FILL.SCREEN ( -- , split into Redless top and Blueless bottom )
  54.     ham_change_red 0 ham.color!
  55.     ham_xmin ham_ymin ham_xmax ham_1/2y gr.rect
  56.     ham_change_blue 0 ham.color!
  57.     ham_xmin ham_1/2y ham_xmax ham_ymax gr.rect
  58. ;
  59.  
  60. 10 constant HAM_NUM_LINES
  61. ham_num_lines 2* constant HAM_NUM_POINTS
  62.  
  63. ham_num_points array HAM-X-POS
  64. ham_num_points array HAM-Y-POS
  65. ham_num_points array HAM-X-VEL
  66. ham_num_points array HAM-Y-VEL
  67.  
  68. \ ------------------------------------------------------
  69. : HAM.GET.RECT ( index -- , get unsorted corners )
  70.     >r
  71.     r@ ham-x-pos @ r@ ham-y-pos @
  72.     r@ ham_num_lines + ham-x-pos @
  73.     r@ ham_num_lines + ham-y-pos @
  74.     rdrop
  75. ;
  76. : HAM.DRAW.LINE  ( index -- )
  77.     ham.get.rect
  78.     gr.move gr.draw
  79. ;
  80.  
  81. ham_ymin ham_ymax + constant ham_ysum
  82. : REFLECT.Y  ( y -- y' )
  83.     ham_ysum swap -
  84. ;
  85.  
  86. : HAM.DRAW.LINES ( index -- )
  87.     dup ham.draw.line
  88.     ham.get.rect
  89.     reflect.y >r >r
  90.     reflect.y r> r>   ( reflect about y center )
  91.     gr.move gr.draw
  92. ;
  93.  
  94. : HAM.MOVE.DIM  { position velocity minpos maxpos -- }
  95.     position @ velocity @ + dup minpos maxpos within?
  96.     IF position !
  97.     ELSE drop velocity @ negate velocity !
  98.     THEN
  99. ;
  100.  
  101. : HAM.MOVE.POINT  ( index -- )
  102.     >r
  103.     r@ ham-x-pos r@ ham-x-vel ham_ymin ham_xmax ham.move.dim
  104.     r@ ham-y-pos r@ ham-y-vel ham_ymin ham_ymax ham.move.dim
  105.     rdrop
  106. ;
  107.  
  108. : HAM.MOVE.LINE  ( -- )
  109.     dup ham.move.point
  110.     ham_num_lines + ham.move.point
  111. ;
  112.  
  113. : HAM.SETUP.POS  ( -- , choose initial random cluster )
  114.     ham_xmax 60 -  ham_ymax 2/
  115.     ham_num_points 0
  116.     DO 2dup 20 choose + i ham-y-pos !
  117.        20 choose + i ham-x-pos !
  118.     LOOP 2drop
  119. ;
  120.  
  121. : CHOOSE.NONZERO ( -- num , return nonzero random number )
  122.     16 choose 7 - dup 1 <
  123.     IF 1- THEN
  124. ;
  125.  
  126. : HAM.SETUP.VEL ( -- , choose random velocities )
  127.     ham_num_points 0
  128.     DO choose.nonzero i ham-y-vel !
  129.        choose.nonzero i ham-x-vel !
  130.     LOOP
  131. ;
  132.  
  133. VARIABLE HAM-COLOR-OFFSET
  134.  
  135. : HAM.MOVING.LINES ( -- , draw one complete pass )
  136.     swap.buffers     ( next surface )
  137.     ham.fill.screen  ( clear screen )
  138. \
  139. \ Move all points.
  140.     ham_num_points 0  
  141.     DO i ham.move.point
  142.     LOOP
  143. \
  144. \ Draw lines between them.
  145.     ham-color-offset @ -4 ashift
  146.     ham_num_lines 0
  147.     DO  i 3 * over + 63 and
  148.         gr.color!  ( move through rgb spectrum )
  149.         i ham.draw.lines
  150.     LOOP drop
  151. \
  152. \ Make visible.
  153.     ham.rebuild
  154.     1 ham-color-offset +!
  155. ;
  156.  
  157. : HAM.DUMP.POS ( -- , for debugging )
  158.     cr ham_num_points 0
  159.     DO i . i ham-x-pos @ .
  160.        i ham-y-pos @ . cr
  161.     LOOP
  162. ;
  163.  
  164. : HAM.DUMP.VEL ( -- , for debugging )
  165.     cr ham_num_lines 0
  166.     DO i .
  167.        i ham-x-vel @ .
  168.        i ham-y-vel @ . cr
  169.     LOOP
  170. ;
  171.  
  172.