github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-03-06 11:23:32 +00:00
Code Issues Releases Wiki Activity

Resolved #910: fix NGAME's path for CHASE documentation.

Browse Source 
Resolved #391: Build CHASE game from source.
This commit is contained in:
Eric Swenson
2018-05-20 21:17:29 -07:00
parent 088ec2d6d9
commit d07f118808
4 changed files with 421 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
bin/games/chase.fasl
View File

Binary file not shown.

6
build/lisp.tcl
View File

@@ -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"

2
src/ejs/ngame.272 → src/ejs/ngame.273
View File

@@ -1482,7 +1482,7 @@ inctl: .uai
INDEV: 'DSK '
INFN1: 'CHASE '
INFN2: 'INFO '
INDIR: 'GAMES '
INDIR: 'GAMES '
outctl: .uao
outdev: 'TTY '

414
src/games/chase.79 Normal file
View File

@@ -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