home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / armforth / !ARMforth / Examples / Breakout / BrkStructs < prev    next >
Encoding:
Text File  |  1989-12-02  |  4.7 KB  |  201 lines

  1.  
  2. 0 CONSTANT WALL-BLOCK-LIST-F
  3. WALL-BLOCK-LIST-F 4 + CONSTANT WALL-NO-BRICKS-F
  4. WALL-NO-BRICKS-F 4 + CONSTANT WALL-SIZE
  5.  
  6. : WALL-BLOCK-LIST WALL-BLOCK-LIST-F + ;
  7. : WALL-NO-BRICKS WALL-NO-BRICKS-F + ;
  8.  
  9. : DEF-WALL
  10.    <BUILDS
  11.       WALL-SIZE ALLOT
  12.    DOES>
  13.    ;
  14.  
  15. 0 CONSTANT BLOCK-HEIGHT-F
  16. BLOCK-HEIGHT-F 4 + CONSTANT BLOCK-WIDTH-F
  17. BLOCK-WIDTH-F 4 + CONSTANT BLOCK-XSIZE-F
  18. BLOCK-XSIZE-F 4 + CONSTANT BLOCK-YSIZE-F
  19. BLOCK-YSIZE-F 4 + CONSTANT BLOCK-BRICKS-F
  20. BLOCK-BRICKS-F CONSTANT BLOCK-SIZE
  21.  
  22. : BLOCK-HEIGHT BLOCK-HEIGHT-F + ;
  23. : BLOCK-WIDTH BLOCK-WIDTH-F + ;
  24. : BLOCK-XSIZE BLOCK-XSIZE-F + ;
  25. : BLOCK-YSIZE BLOCK-YSIZE-F + ;
  26. : BLOCK-BRICKS BLOCK-BRICKS-F + ;
  27.  
  28. : DEF-WALL-BLOCK ( XSIZE / YSIZE / XBRICKS / YBRICKS )
  29.    <BUILDS
  30.       HERE >R
  31.       2DUP
  32.       * 2 << BLOCK-SIZE + ALLOT
  33.       R
  34.       BLOCK-HEIGHT !
  35.       R
  36.       BLOCK-WIDTH !
  37.       R
  38.       BLOCK-YSIZE !
  39.       R>
  40.       BLOCK-XSIZE !
  41.    DOES>
  42.    ;
  43.  
  44. 0 CONSTANT WALL-BLOCK-F
  45. WALL-BLOCK-F 4 + CONSTANT BLOCK-BOT-LEFTX-F
  46. BLOCK-BOT-LEFTX-F 4 + CONSTANT BLOCK-BOT-LEFTY-F
  47. BLOCK-BOT-LEFTY-F 4 + CONSTANT BLOCK-LIST-SIZE
  48.  
  49. : WALL-BLOCK WALL-BLOCK-F + ;
  50. : BLOCK-BOT-LEFTX BLOCK-BOT-LEFTX-F + ;
  51. : BLOCK-BOT-LEFTY BLOCK-BOT-LEFTY-F + ;
  52.  
  53. : DEF-WALL-BLOCK-LIST ( NUM-ELEMENTS -> )
  54.    <BUILDS
  55.       1+ BLOCK-LIST-SIZE * ALLOT
  56.       HERE BLOCK-LIST-SIZE - ( START OF LAST ELEMENT )
  57.       WALL-BLOCK -1 SWAP ! ( STORE -1 AS END OF LIST MARKER )
  58.    DOES>
  59.    ;
  60.  
  61. : DEF-WALL-BLOCK-ROW ( BRICK-COLOURS ... / ROW-NO / BLOCK -> )
  62.    DUP >R ( SAVE BLOCK ADDRESS )
  63.    BLOCK-WIDTH @ 2 << *
  64.    R BLOCK-BRICKS + ( ADDRESS OF REQUIRED ROW )
  65.    R BLOCK-WIDTH @ 2 << + 4 - ( ADDRESS OF END OF ROW )
  66.    R> BLOCK-WIDTH @ 0 DO
  67.       >R ( ADDRESS )
  68.       18 << OR ( MERGE SCORE WITH COLOUR )
  69.       R ! ( STORE BRICK COLOUR )
  70.       R> 4 - ( DECREMENT ADDRESS )
  71.    LOOP
  72.    DROP
  73.    ;
  74.  
  75. : INSERT-LIST-ELT ( XPOS / YPOS / BLOCK / BLOCK-LIST / ELT-NO -> )
  76.    BLOCK-LIST-SIZE * + ( ADDR OF ELEMENT )
  77.    >R R WALL-BLOCK ! ( STORE PTR TO BLOCK IN LIST ELEMENT )
  78.    R BLOCK-BOT-LEFTY !
  79.    R> BLOCK-BOT-LEFTX !
  80.    ;
  81.  
  82. : ATTACH-LIST ( BLOCK-LIST / WALL -> )
  83.    WALL-BLOCK-LIST !
  84.    ;
  85.  
  86. 0 CONSTANT BATX-F
  87. BATX-F 4 + CONSTANT BATY-F
  88. BATY-F 4 + CONSTANT BAT-WIDTH-F
  89. BAT-WIDTH-F 4 + CONSTANT BAT-MINX-F
  90. BAT-MINX-F 4 + CONSTANT BAT-MAXX-F
  91. BAT-MAXX-F 4 + CONSTANT BAT-HEIGHT-F
  92. BAT-HEIGHT-F 4 + CONSTANT BAT-XINC-F
  93. BAT-XINC-F 4 + CONSTANT BAT-SPRITE-CTRL-F
  94. BAT-SPRITE-CTRL-F 4 + CONSTANT BAT-SIZE
  95.  
  96. : BATX BATX-F + ;
  97. : BATY BATY-F + ;
  98. : BAT-WIDTH BAT-WIDTH-F + ;
  99. : BAT-MINX BAT-MINX-F + ;
  100. : BAT-MAXX BAT-MAXX-F + ;
  101. : BAT-HEIGHT BAT-HEIGHT-F + ;
  102. : BAT-XINC BAT-XINC-F + ;
  103. : BAT-SPRITE-CTRL BAT-SPRITE-CTRL-F + ;
  104.  
  105. : DEF-BAT ( SPRITE-AREA / SPRITE-NO / XINC / MINX / MAXX / X / Y )
  106.    <BUILDS
  107.       HERE >R
  108.       BAT-SIZE ALLOT
  109.       R BATY !
  110.       R BATX !
  111.       R BAT-MAXX !
  112.       R BAT-MINX !
  113.       R BAT-XINC !
  114.       >R DUP R>
  115.       GET-SPRITE-CTRL-BLOCK
  116.       DUP
  117.       R BAT-SPRITE-CTRL !
  118.       SPRITE-SIZE
  119.       2DUP 2 << R BAT-HEIGHT !
  120.       1 << R BAT-WIDTH !
  121.       DROP
  122.       1 <<
  123.       R BAT-MAXX @
  124.       SWAP -
  125.       R> BAT-MAXX !
  126.    DOES>
  127.    ;
  128.  
  129. 0 CONSTANT BALLX-F
  130. BALLX-F 4 + CONSTANT BALLY-F
  131. BALLY-F 4 + CONSTANT BALL-INCX-F
  132. BALL-INCX-F 4 + CONSTANT BALL-INCY-F
  133. BALL-INCY-F 4 + CONSTANT BALL-MINX-F
  134. BALL-MINX-F 4 + CONSTANT BALL-MINY-F
  135. BALL-MINY-F 4 + CONSTANT BALL-MAXX-F
  136. BALL-MAXX-F 4 + CONSTANT BALL-MAXY-F
  137. BALL-MAXY-F 4 + CONSTANT BALL-WIDTH-F
  138. BALL-WIDTH-F 4 + CONSTANT BALL-HEIGHT-F
  139. BALL-HEIGHT-F 4 + CONSTANT BALL-CENTRE-COL-F
  140. BALL-CENTRE-COL-F 4 + CONSTANT BALL-SPRITE-CTRL-F
  141. BALL-SPRITE-CTRL-F 4 + CONSTANT BALL-SIZE
  142.  
  143. : BALLX BALLX-F + ;
  144. : BALLY BALLY-F + ;
  145. : BALL-INCX BALL-INCX-F + ;
  146. : BALL-INCY BALL-INCY-F + ;
  147. : BALL-MINX BALL-MINX-F + ;
  148. : BALL-MINY BALL-MINY-F + ;
  149. : BALL-MAXX BALL-MAXX-F + ;
  150. : BALL-MAXY BALL-MAXY-F + ;
  151. : BALL-WIDTH BALL-WIDTH-F + ;
  152. : BALL-HEIGHT BALL-HEIGHT-F + ;
  153. : BALL-CENTRE-COL BALL-CENTRE-COL-F + ;
  154. : BALL-SPRITE-CTRL BALL-SPRITE-CTRL-F + ;
  155.  
  156. : DEF-BALL ( SPRITE-AREA / SPRITE-NO / MINX / MINY / MAXX / MAXY /
  157.              INITX / INITY / INCX / INCY -> )
  158.    <BUILDS
  159.       HERE >R
  160.       BALL-SIZE ALLOT
  161.       R BALL-INCY !
  162.       R BALL-INCX !
  163.       R BALLY !
  164.       R BALLX !
  165.       R BALL-MAXY !
  166.       R BALL-MAXX !
  167.       R BALL-MINY !
  168.       R BALL-MINX !
  169.       >R DUP R>
  170.       GET-SPRITE-CTRL-BLOCK
  171.       DUP
  172.       R BALL-SPRITE-CTRL !
  173.       2DUP SPRITE-SIZE
  174.       DUP 1 << R BALL-HEIGHT FORTH !
  175.       1 >>
  176.       SWAP
  177.       DUP R BALL-WIDTH !
  178.       1 >>
  179.       SWAP
  180.       READ-SPRITE-PIXEL
  181.       R> BALL-CENTRE-COL !
  182.    DOES>
  183.    ;
  184.  
  185. 0 CONSTANT BALL-F
  186. BALL-F 4 + CONSTANT BALL-LIST-SIZE
  187. : BALL BALL-F + ;
  188.  
  189. : DEF-BALL-LIST ( NUM-ELEMENTS -> )
  190.    <BUILDS
  191.       1+ BALL-LIST-SIZE * ALLOT
  192.       HERE BALL-LIST-SIZE - ( ADDRESS OF LAST DUMMY ELEMENT )
  193.       BALL -1 SWAP !
  194.    DOES>
  195.    ;
  196.  
  197. : ATTACH-BALL ( BALL / BALL-LIST / ELT-NO -> )
  198.    BALL-LIST-SIZE * + ( ADDR OF WANTED ELEMENT )
  199.    BALL !
  200.    ;
  201.