home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / forth / !FORTH / TestProgs / BreakOut < prev    next >
Encoding:
Text File  |  1989-07-25  |  2.1 KB  |  57 lines
  1. CORE
  2. 10 ARRAY HighScores
  3. 4 VARIABLE X
  4. 1 VARIABLE oldX
  5. 1 VARIABLE Xinc
  6. 6 VARIABLE Y
  7. 1 VARIABLE oldY
  8. 1 VARIABLE Yinc
  9. 39 VARIABLE BatPos
  10. 25 ARRAY FrontWall
  11. 25 ARRAY MiddleWall
  12. 25 ARRAY BackWall
  13. : InitHighSc 9 0 DO 10000 I> 1000 * - HighScores [I]! LOOP ;
  14. : Rules ." The rules of the game go here. " CRET
  15.         ." PRESS ANY KEY TO CONTINUE" KEY CLS ;
  16. : 3Char DUP ECHO DUP ECHO ECHO ;
  17. : InitVars InitHighSc ;
  18. : PlotBat BatPos @ 22 TAB 66 3Char ;
  19. : MoveBatLeft BatPos @ 1- 4 MAX DUP BatPos ! 22 TAB 66 3Char 32 ECHO ;
  20. : MoveBatRight BatPos @ 1+ 72 MIN DUP BatPos ! 1- 22 TAB 32 ECHO 66 3Char ;
  21. : InitBat BatPos @ PlotBat ;
  22. : InitWall 23 0 DO 1 FrontWall [I]! 1 MiddleWall [I]! 1 BackWall [I]! LOOP
  23.            11 0 DO I> 6 * 4 + DUP 3 TAB 67 3Char 68 3Char
  24.                               DUP 4 TAB 69 3Char 70 3Char
  25.                                  5 TAB 71 3Char 72 3Char LOOP
  26.            3 BackWall 24 4* + !
  27.            4 MiddleWall 24 4* + !
  28.            5 FrontWall 24 4* + ! ;
  29. : InitSides 24 0 DO 3 I> TAB 124 ECHO 76 I> TAB 124 ECHO LOOP ;
  30. : InitScreen InitWall InitSides InitBat ;
  31. : Initialise 1 PRINT_MODE ! CLS InitVars Rules InitScreen ;
  32. : EndGame CLS ."   High Score Table " CRET CRET 
  33.               9 0 DO ."    Mike   " HighScores [I]@ . CRET LOOP ;
  34. : PlotA X @ Y @ TAB 65 ECHO ;
  35. : UnPlotA oldX @ oldY @ TAB 32 ECHO ;
  36. : Touch X @ 4- 3 / DUP 4* 2OVER + DUP @
  37.         IF 0 SWAP ! 3 * 4 + SWAP 24 4* + @ TAB 32 3Char 0 Yinc @ - Yinc !
  38.         ELSE DROP DROP DROP ENDIF ;
  39. : incXY X @ DUP oldX ! Xinc @ + DUP X !
  40.     DUP 74 > IF -1 Xinc ! ENDIF
  41.          5 < IF 1 Xinc ! ENDIF
  42.     Y @ DUP oldY ! Yinc @ + DUP Y !
  43.     DUP 20 > IF -1 Yinc ! ENDIF
  44.     DUP  3 = IF BackWall Touch ENDIF
  45.     DUP  4 = IF MiddleWall Touch ENDIF
  46.     DUP  5 = IF FrontWall Touch ENDIF
  47.          1 < IF 1 Yinc ! ENDIF ;
  48. : GameOver 0 23 0 DO FrontWall [I]@ + MiddleWall [I]@ + BackWall [I]@ + LOOP 0 = ;
  49. : MoveBat 1 INKEY IF DUP 44 = IF MoveBatLeft ENDIF 46 = IF MoveBatRight ENDIF ENDIF ;
  50. : Play BEGIN
  51.           TIME 2+ incXY PlotA UnPlotA FALSE ELSE 32 = SWAP 2+
  52.           BEGIN MoveBat DUP TIME < END DROP
  53.           GameOver
  54.        END TRUE ;
  55. : GAME Initialise BEGIN Play END EndGame ;
  56. GAME
  57.