diff --git a/bin/games/chase.fasl b/bin/games/chase.fasl deleted file mode 100644 index 29e9cb0b..00000000 Binary files a/bin/games/chase.fasl and /dev/null differ diff --git a/build/lisp.tcl b/build/lisp.tcl index 4ac94427..9d2fa038 100644 --- a/build/lisp.tcl +++ b/build/lisp.tcl @@ -835,3 +835,9 @@ respond "*" "complr\013" respond "_" "games;_games;wa 10\r" respond "_" "\032" type ":kill\r" + +# chase +respond "*" "complr\013" +respond "_" "games;_chase\r" +respond "_" "\032" +type ":kill\r" diff --git a/src/ejs/ngame.272 b/src/ejs/ngame.273 similarity index 99% rename from src/ejs/ngame.272 rename to src/ejs/ngame.273 index 099050ad..9f7b339c 100644 --- a/src/ejs/ngame.272 +++ b/src/ejs/ngame.273 @@ -1482,7 +1482,7 @@ inctl: .uai INDEV: 'DSK ' INFN1: 'CHASE ' INFN2: 'INFO ' -INDIR: 'GAMES ' +INDIR: 'GAMES ' outctl: .uao outdev: 'TTY ' diff --git a/src/games/chase.79 b/src/games/chase.79 new file mode 100644 index 00000000..32df1090 --- /dev/null +++ b/src/games/chase.79 @@ -0,0 +1,414 @@ +(DECLARE (*EXPR INIT-MAZE PRINT-MAZE CHASE WINNER) + (MAPEX T) + ;(NEWIO T) + (SPECIAL DEBUG NEXTCHAR BIGX LITX BIGO LITO TIME-INTERVAL + INTERGAME-DELAY XSCORE OSCORE LEAVE-FLAG MAZE) + (UNSPECIAL BIGXDIR BIGODIR LITXDIR LITODIR) + (ARRAY* (FIXNUM (MAZE 24. 80.))) + (FIXNUM X Y XSCORE OSCORE) + (FLONUM TIME-INTERVAL)) + +(FASLOAD STATTY FASL DSK LIBLSP) + +(SETQ MAZE (ARRAY NIL FIXNUM 24. 80.)) + +(eval-when (compile eval load) + (defun newcopy (x) (append x nil)) + + (setq makeintern t) + (DEFUN MAKESYM (A) + ;; FUNCTION MAKESYM MAKES UP A GENSYM OF ITS ARG + (PUTPROP A + (ADD1 (OR (GET A 'MAKESYM) 0.)) + 'MAKESYM) + (SETQ A (MAKNAM (APPEND (OR (GET A 'EXPLO) + (PUTPROP A + (EXPLODE A) + 'EXPLO)) + (EXPLODE (GET A 'MAKESYM))))) + (COND (MAKEINTERN (INTERN A)) (A))) +) + + +(DEFUN MAZE MACRO (X) (NCONC (NEWCOPY '(ARRAYCALL FIXNUM)) X)) + +(SETQ DEBUG NIL TERPRI T NEXTCHAR '(BIGO BIGX LITO LITX) + ERRLIST '((INPUT-ACTIVATE NIL) (INPUT-ECHO T)) + TIME-INTERVAL .07 INTERGAME-DELAY 10. *NOPOINT T LEAVE-FLAG NIL + IBASE 10. BASE 10.) + +(PROG2 (NCONC NEXTCHAR NEXTCHAR) T) + +(DEFUN INIT-MAZE (LIST) + (MAPC + '(LAMBDA (EL) + (COND + ((ATOM (CAR EL)) + (DO ((I (CAADR EL) (1+ I))) + ((= I (CADADR EL))) + (STORE (MAZE (CAR EL) I) 95.))) + (T + (DO ((I (CAAR EL) (1+ I))) + ((= I (CADAR EL))) + (STORE (MAZE I (CADR EL)) 124.))))) + LIST) + (AND DEBUG + (DO ((X 0. (1+ X))) + ((= X 23.) T) + (AND (NOT (ODDP X)) (STORE (MAZE X 0.) (+ 48. (REMAINDER X 10.))))) + (DO ((Y 0. (1+ Y))) + ((= Y 79.)) + (AND (NOT (ODDP Y)) (STORE (MAZE 0. Y) (+ 48. (REMAINDER Y 10.)))))) ) + +(DEFUN PRINT-MAZE () + (CURSORPOS 'C) + (DO ((X 0. (1+ X))) + ((= X 23.)) + (DO ((Y 0. (1+ Y))) + ((= Y 79.)) + (COND + ((ZEROP (MAZE X Y))) + (T (CURSORPOS X Y) (TYO (MAZE X Y))))))) + +(DEFUN CHASE () +(PROG (XSCORE OSCORE XLEFT) + (SETQ XSCORE 0. OSCORE 0.) + (INIT-MAZE + '(((6. 12.) 67.) + ((14. 16.) 58.) + (11. (56. 67.)) + ((5. 13.) 15.) + (12. (6. 15.)) + (14. (10. 18.)) + ((15. 19.) 10.) + (22. (15. 22.)) + ((15. 19.) 26.) + ((6. 20.) 17.) + (4. (15. 34.)) + (11. (18. 28.)) + ((5. 10.) 23.) + ((7. 12.) 28.) + ((5. 17.) 33.) + (15. (22. 30.)) + ((13. 16.) 24.) + ((13. 17.) 44.) + (16. (34. 38.)) + (16. (39. 44.)) + (12. (38. 45.)) + (6. (34. 41.)) + (8. (38. 45.)) + ((4. 9.) 44.) + (10. (34. 41.)) + (10. (47. 54.)) + ((8. 11.) 54.) + ((11. 16.) 51.) + (5. (45. 52.)) + (0. (0. 80.)) + (22. (0. 80.)) + ((1. 24.) 0.) + ((1. 24.) 78.) + ((1. 3.) 20.) + ((3. 5.) 28.) + ((16. 23.) 64.) + (4. (66. 78.)) + ((17. 23.) 14.) + ((19. 23.) 22.) + ((14. 20.) 60.) + ((14. 20.) 70.) + (13. (60. 71.)) + ((5. 10.) 65.) + (7. (1. 11.)) + ((9. 13.) 6.) + ((8. 11.) 10.) + (15. (52. 58.)) + (19. (53. 60.)) + + )) + (PRINT-MAZE) + NEWGAME + (COND (XLEFT (SETQ XLEFT NIL)) (T (SETQ XLEFT T))) + (SETQ BIGXDIR NIL LITXDIR NIL BIGODIR NIL LITODIR NIL) + (COND + (XLEFT + (SETQ BIGX (NEWCOPY '(2. 2.)) LITX (NEWCOPY '(20. 2.)) + BIGO (NEWCOPY '(2. 74.)) LITO (NEWCOPY '(20. 74.)))) + (T (SETQ BIGX (NEWCOPY '(2. 74.)) LITX (NEWCOPY '(20. 74.)) + BIGO (NEWCOPY '(2. 2.)) LITO (NEWCOPY '(20. 2.))))) + (SETQ ALARMCLOCK + (FUNCTION + (LAMBDA (FOO) + (SETQ NEXTCHAR (CDR NEXTCHAR)) + (COND + ((EQ (CAR NEXTCHAR) 'BIGX) + (CURSORPOS (CAR BIGX) (CADR BIGX)) + (CURSORPOS 'F) (CURSORPOS 'X) + (COND + ((NULL BIGXDIR)) + ((EQ BIGXDIR 'UP) + (RPLACA (CDR BIGX) (1+ (CADR BIGX))) + (AND + (OR (NOT (ZEROP (MAZE (CAR BIGX) (CADR BIGX)))) + (AND (EQ (CAR BIGX) (CAR BIGO)) + (EQ (CADR BIGX) (CADR BIGO)))) + (RPLACA (CDR BIGX) (1- (CADR BIGX))))) + ((EQ BIGXDIR 'DOWN) + (RPLACA (CDR BIGX) (1- (CADR BIGX))) + (AND + (OR (NOT (ZEROP (MAZE (CAR BIGX) (CADR BIGX)))) + (AND (EQ (CAR BIGX) (CAR BIGO)) + (EQ (CADR BIGX) (CADR BIGO)))) + (RPLACA (CDR BIGX) (1+ (CADR BIGX))))) + ((EQ BIGXDIR 'LEFT) + (RPLACA BIGX (1- (CAR BIGX))) + (AND + (OR (NOT (ZEROP (MAZE (CAR BIGX) (CADR BIGX)))) + (AND (EQ (CAR BIGX) (CAR BIGO)) + (EQ (CADR BIGX) (CADR BIGO)))) + (RPLACA BIGX (1+ (CAR BIGX))))) + ((EQ BIGXDIR 'RIGHT) + (RPLACA BIGX (1+ (CAR BIGX))) + (AND + (OR (NOT (ZEROP (MAZE (CAR BIGX) (CADR BIGX)))) + (AND (EQ (CAR BIGX) (CAR BIGO)) + (EQ (CADR BIGX) (CADR BIGO)))) + (RPLACA BIGX (1- (CAR BIGX)))))) + (CURSORPOS (CAR BIGX) (CADR BIGX)) + (TYO 88.) + (AND (= (CAR BIGX) (CAR LITO)) (= (CADR BIGX) (CADR LITO)) + (WINNER 'X) (SETQ LEAVE-FLAG T))) + ((EQ (CAR NEXTCHAR) 'BIGO) + (CURSORPOS (CAR BIGO) (CADR BIGO)) + (CURSORPOS 'F) (CURSORPOS 'X) + (COND + ((NULL BIGODIR)) + ((EQ BIGODIR 'UP) + (RPLACA (CDR BIGO) (1+ (CADR BIGO))) + (AND + (OR (NOT (ZEROP (MAZE (CAR BIGO) (CADR BIGO)))) + (AND (EQ (CAR BIGO) (CAR BIGX)) + (EQ (CADR BIGO) (CADR BIGX)))) + (RPLACA (CDR BIGO) (1- (CADR BIGO))))) + ((EQ BIGODIR 'DOWN) + (RPLACA (CDR BIGO) (1- (CADR BIGO))) + (AND + (OR (NOT (ZEROP (MAZE (CAR BIGO) (CADR BIGO)))) + (AND (EQ (CAR BIGO) (CAR BIGX)) + (EQ (CADR BIGO) (CADR BIGX)))) + (RPLACA (CDR BIGO) (1+ (CADR BIGO))))) + ((EQ BIGODIR 'LEFT) + (RPLACA BIGO (1- (CAR BIGO))) + (AND + (OR (NOT (ZEROP (MAZE (CAR BIGO) (CADR BIGO)))) + (AND (EQ (CAR BIGO) (CAR BIGX)) + (EQ (CADR BIGO) (CADR BIGX)))) + (RPLACA BIGO (1+ (CAR BIGO))))) + ((EQ BIGODIR 'RIGHT) + (RPLACA BIGO (1+ (CAR BIGO))) + (AND + (OR (NOT (ZEROP (MAZE (CAR BIGO) (CADR BIGO)))) + (AND (EQ (CAR BIGO) (CAR BIGX)) + (EQ (CADR BIGO) (CADR BIGX)))) + (RPLACA BIGO (1- (CAR BIGO)))))) + (CURSORPOS (CAR BIGO) (CADR BIGO)) + (TYO 79.) + (AND (= (CAR BIGO) (CAR LITX)) (= (CADR BIGO) (CADR LITX)) + (WINNER 'O) (SETQ LEAVE-FLAG T))) + ((EQ (CAR NEXTCHAR) 'LITO) + (CURSORPOS (CAR LITO) (CADR LITO)) + (CURSORPOS 'F) (CURSORPOS 'X) + (COND + ((NULL LITODIR)) + ((EQ LITODIR 'UP) + (RPLACA (CDR LITO) (1+ (CADR LITO))) + (AND + (OR (NOT (ZEROP (MAZE (CAR LITO) (CADR LITO)))) + (AND (EQ (CAR LITO) (CAR LITX)) + (EQ (CADR LITO) (CADR LITX)))) + (RPLACA (CDR LITO) (1- (CADR LITO))))) + ((EQ LITODIR 'DOWN) + (RPLACA (CDR LITO) (1- (CADR LITO))) + (AND + (OR (NOT (ZEROP (MAZE (CAR LITO) (CADR LITO)))) + (AND (EQ (CAR LITO) (CAR LITX)) + (EQ (CADR LITO) (CADR LITX)))) + (RPLACA (CDR LITO) (1+ (CADR LITO))))) + ((EQ LITODIR 'LEFT) + (RPLACA LITO (1- (CAR LITO))) + (AND + (OR (NOT (ZEROP (MAZE (CAR LITO) (CADR LITO)))) + (AND (EQ (CAR LITO) (CAR LITX)) + (EQ (CADR LITO) (CADR LITX)))) + (RPLACA LITO (1+ (CAR LITO))))) + ((EQ LITODIR 'RIGHT) + (RPLACA LITO (1+ (CAR LITO))) + (AND + (OR (NOT (ZEROP (MAZE (CAR LITO) (CADR LITO)))) + (AND (EQ (CAR LITO) (CAR LITX)) + (EQ (CADR LITO) (CADR LITX)))) + (RPLACA LITO (1- (CAR LITO)))))) + (CURSORPOS (CAR LITO) (CADR LITO)) + (TYO 111.) + (AND (= (CAR BIGX) (CAR LITO)) (= (CADR BIGX) (CADR LITO)) + (WINNER 'X) (SETQ LEAVE-FLAG T))) + ((EQ (CAR NEXTCHAR) 'LITX) + (CURSORPOS (CAR LITX) (CADR LITX)) + (CURSORPOS 'F) (CURSORPOS 'X) + (COND + ((NULL LITXDIR)) + ((EQ LITXDIR 'UP) + (RPLACA (CDR LITX) (1+ (CADR LITX))) + (AND + (OR (NOT (ZEROP (MAZE (CAR LITX) (CADR LITX)))) + (AND (EQ (CAR LITX) (CAR LITO)) + (EQ (CADR LITX) (CADR LITO)))) + (RPLACA (CDR LITX) (1- (CADR LITX))))) + ((EQ LITXDIR 'DOWN) + (RPLACA (CDR LITX) (1- (CADR LITX))) + (AND + (OR (NOT (ZEROP (MAZE (CAR LITX) (CADR LITX)))) + (AND (EQ (CAR LITX) (CAR LITO)) + (EQ (CADR LITX) (CADR LITO)))) + (RPLACA (CDR LITX) (1+ (CADR LITX))))) + ((EQ LITXDIR 'LEFT) + (RPLACA LITX (1- (CAR LITX))) + (AND + (OR (NOT (ZEROP (MAZE (CAR LITX) (CADR LITX)))) + (AND (EQ (CAR LITX) (CAR LITO)) + (EQ (CADR LITX) (CADR LITO)))) + (RPLACA LITX (1+ (CAR LITX))))) + ((EQ LITXDIR 'RIGHT) + (RPLACA LITX (1+ (CAR LITX))) + (AND + (OR (NOT (ZEROP (MAZE (CAR LITX) (CADR LITX)))) + (AND (EQ (CAR LITX) (CAR LITO)) + (EQ (CADR LITX) (CADR LITO)))) + (RPLACA LITX (1- (CAR LITX)))))) + (CURSORPOS (CAR LITX) (CADR LITX)) + (TYO 120.) + (AND (= (CAR BIGO) (CAR LITX)) (= (CADR BIGO) (CADR LITX)) + (WINNER 'O) (SETQ LEAVE-FLAG T)))) + (COND ((NULL LEAVE-FLAG) (ALARMCLOCK 'TIME TIME-INTERVAL)) + (T (SETQ LEAVE-FLAG NIL) (SETQ ALARMCLOCK NIL)))))) + (ALARMCLOCK 'TIME TIME-INTERVAL) + (INPUT-ACTIVATE T) + (INPUT-ECHO NIL) + ((LAMBDA (READTABLE) + (SSTATUS MACRO 59. NIL) + (SSTATUS MACRO 39. NIL) + (MAPC '(LAMBDA (C) (SETSYNTAX C 1245184. NIL)) + '(/ A S D W F G H T /; /' /{ /[ /4 /5 /6 /8 /n / )) + (DO ((CH (READ) (READ))) + (NIL) + (COND + ((EQ CH '/W) + (COND ((EQ BIGXDIR 'RIGHT) (SETQ BIGXDIR NIL)) + (T (SETQ BIGXDIR 'LEFT)))) + ((EQ CH 'A) + (COND ((EQ BIGXDIR 'UP) (SETQ BIGXDIR NIL)) + (T (SETQ BIGXDIR 'DOWN)))) + ((EQ CH 'S) + (COND ((EQ BIGXDIR 'LEFT) (SETQ BIGXDIR NIL)) + (T (SETQ BIGXDIR 'RIGHT)))) + ((EQ CH 'D) + (COND ((EQ BIGXDIR 'DOWN) (SETQ BIGXDIR NIL)) + (T (SETQ BIGXDIR 'UP)))) + ((EQ CH 'T) + (COND ((EQ LITXDIR 'RIGHT) (SETQ LITXDIR NIL)) + (T (SETQ LITXDIR 'LEFT)))) + ((EQ CH 'F) + (COND ((EQ LITXDIR 'UP) (SETQ LITXDIR NIL)) + (T (SETQ LITXDIR 'DOWN)))) + ((EQ CH 'G) + (COND ((EQ LITXDIR 'LEFT) (SETQ LITXDIR NIL)) + (T (SETQ LITXDIR 'RIGHT)))) + ((EQ CH 'H) + (COND ((EQ LITXDIR 'DOWN) (SETQ LITXDIR NIL)) + (T (SETQ LITXDIR 'UP)))) + ((EQ CH '/[) + (COND ((EQ BIGODIR 'RIGHT) (SETQ BIGODIR NIL)) + (T (SETQ BIGODIR 'LEFT)))) + ((EQ CH '/;) + (COND ((EQ BIGODIR 'UP) (SETQ BIGODIR NIL)) + (T (SETQ BIGODIR 'DOWN)))) + ((EQ CH '/') + (COND ((EQ BIGODIR 'LEFT) (SETQ BIGODIR NIL)) + (T (SETQ BIGODIR 'RIGHT)))) + ((EQ CH '/{) + (COND ((EQ BIGODIR 'DOWN) (SETQ BIGODIR NIL)) + (T (SETQ BIGODIR 'UP)))) + ((EQ CH '/8) + (COND ((EQ LITODIR 'RIGHT) (SETQ LITODIR NIL)) + (T (SETQ LITODIR 'LEFT)))) + ((EQ CH '/4) + (COND ((EQ LITODIR 'UP) (SETQ LITODIR NIL)) + (T (SETQ LITODIR 'DOWN)))) + ((EQ CH '/5) + (COND ((EQ LITODIR 'LEFT) (SETQ LITODIR NIL)) + (T (SETQ LITODIR 'RIGHT)))) + ((EQ CH '/6) + (COND ((EQ LITODIR 'DOWN) (SETQ LITODIR NIL)) + (T (SETQ LITODIR 'UP)))) + ((EQ CH '/n) + (DO ((X 10. (1+ X))) + ((= X 15.)) + (CURSORPOS X 33.) + (DO (( Y 33. (1+ Y))) + ((= Y 48.)) + (TYO (COND ((ZEROP (MAZE X Y)) 32.)(T (MAZE X Y)))))) + (RETURN NIL)) + ((EQ CH '/ ) + (SETQ BIGXDIR NIL BIGODIR NIL LITXDIR NIL LITODIR NIL) + (ALARMCLOCK 'TIME -1) + (PRINT-MAZE) + (ALARMCLOCK 'TIME TIME-INTERVAL)) + ((EQ CH '/) (SETQ ALARMCLOCK NIL) + (INPUT-ACTIVATE NIL) + (INPUT-ECHO T))))) + (GET (*ARRAY (GENSYM) 'READTABLE T) 'ARRAY)) + (GO NEWGAME))) +)))) + +(DEFUN WINNER (W) + (PROG () + (CURSORPOS (CAR BIGX) (CADR BIGX)) (CURSORPOS 'F) (CURSORPOS 'X) + (CURSORPOS (CAR BIGO) (CADR BIGO)) (CURSORPOS 'F) (CURSORPOS 'X) + (CURSORPOS (CAR LITX) (CADR LITX)) (CURSORPOS 'F) (CURSORPOS 'X) + (CURSORPOS (CAR LITO) (CADR LITO)) (CURSORPOS 'F) (CURSORPOS 'X) + (MAPC '(LAMBDA (X) (CURSORPOS (CAR (EVAL X)) (CADR (EVAL X))) + (CURSORPOS 'F) + (CURSORPOS 'X)) + '(BIGX BIGO LITX LITO)) + (TYO 7.) + (CURSORPOS 10. 33.) + (PRINC '|**************|) + (CURSORPOS 11. 33.) + (PRINC '|* *|) + (CURSORPOS 12. 33.) + (COND + ((EQ W 'X) (PRINC '|* X WINS!! *|)) + (T (PRINC '|* O WINS!! *|))) + (CURSORPOS 13. 33.) + (PRINC '|* *|) + (CURSORPOS 14. 33.) + (PRINC '|**************|) + (SLEEP 5.) + (CURSORPOS 12. 37.) + (REPEAT 8. (CURSORPOS 'X)) + (COND ((EQ W 'X) (SETQ XSCORE (1+ XSCORE))) + (T (SETQ OSCORE (1+ OSCORE)))) + (CURSORPOS 12. 35.) + (PRINC XSCORE) + (PRINC '| |) + (CURSORPOS 12. (COND ((> OSCORE 10.) 43.) (T 44.))) + (PRINC OSCORE) + (CURSORPOS 1. 1.) + (SLEEP 5.) + (CURSORPOS 12. 34.) + (PRINC '| READY |) + (CURSORPOS 1. 1.) + (RETURN T))) + +;;; (C) Bill Kornfeld, 1978 + + +