mirror of
https://github.com/PDP-10/its.git
synced 2026-03-04 02:35:00 +00:00
492 lines
13 KiB
Common Lisp
492 lines
13 KiB
Common Lisp
;;; -*- LISP -*-
|
||
;;; A B C
|
||
;;; D E
|
||
;;; F G H
|
||
|
||
(COND ((NOT (MEMQ 'CURSORPOS (STATUS FILEM TYO)))
|
||
(CURSORPOS 'A TYO)
|
||
(PRINC '|Sorry, THINK-A-DOT currently only works on display terminals.|)
|
||
(TERPRI TYO)
|
||
(QUIT)))
|
||
|
||
(SSTATUS RANDOM (APPLY '* (APPEND (STATUS DATE) (STATUS DAYTIME))))
|
||
|
||
(EVAL-WHEN (EVAL COMPILE)
|
||
(SSTATUS MACRO /# '(LAMBDA () ((LAMBDA (IBASE) (READ)) 2.))))
|
||
|
||
(EVAL-WHEN (EVAL COMPILE)
|
||
(DO ((C (TYI) (TYI))
|
||
(L () (CONS C L)))
|
||
((= C 31.) (SETQ LONG-RULES (MAKNAM (NREVERSE L))))))
|
||
|
||
Think-a-dot is sold as a children's game, but can be played by
|
||
people of all ages. It allows as much or as little planning as you want
|
||
to put into it.
|
||
The equipment needed is a plastic box with colored dots on the
|
||
side of it and 5 holes (three on top, one on each side), as shown on the
|
||
next screen. (Note: A well-designed think-a-dot simulator running on a PDP-10
|
||
may substitute for the plastic box.)
|
||
|
||
A B C
|
||
___ ___ ___
|
||
----------------------------
|
||
| |
|
||
| (A) (B) (C) |
|
||
| Blue Yellow Blue |
|
||
| |
|
||
| |
|
||
| (D) (E) |
|
||
| Yellow Yellow |
|
||
| |
|
||
| |
|
||
| (F) (G) (H) |
|
||
| Blue Yellow Blue |
|
||
| |
|
||
|| ||
|
||
P1 || || P2
|
||
------------------------------
|
||
|
||
Balls are dropped into the holes depending on which side of the
|
||
board they come out on, that player plays next. (It is deterministic
|
||
which side of the board they will come out on, as will be seen in a
|
||
minute).
|
||
When a ball falls into a hole, it will strike the dot just
|
||
below it, changing its color from blue to yellow or yellow to blue
|
||
as appropriate. Depending on the resulting color, the ball will then
|
||
fall to either the right or the left and strike the next dot below it.
|
||
When it reaches the bottom dot, it will roll out of the box and it will
|
||
be the player's turn whose side it rolled out on.
|
||
|
||
In this version of think we use "/" and "\" to represent the two
|
||
states of the `dots.' This makes it easier to tell what the internal
|
||
state of the machine is. If you are unsure of what happens when a ball
|
||
is dropped, play around with the game before starting a game.
|
||
For example, note that when you start with state 11111111 and then
|
||
drop a ball into "A" what happens is that it hits node "A" and falls to the
|
||
right (complementing "A"). It then hits node "D" and falls to the right
|
||
(complementing it) and finally hits "G" falling to the right (complementing
|
||
it).
|
||
If the ball falls out to the left or the right of node "F", or to
|
||
the left of node "G", it will be player 1's turn. If it falls to the
|
||
right of node "G" or either side of node "H" it will be player 2's turn.
|
||
|
||
If you get stuck, ask a 6-year-old or a mathemetician to help you.
|
||
(Note that this box can be viewed as a finite state machine with 256 states,
|
||
only 128 of which are reachable from any given state (parity of the
|
||
initial situation is a factor)). Good luck!
|
||
|
||
|
||
|
||
(EVAL-WHEN (EVAL COMPILE)
|
||
(DO ((C (TYI) (TYI))
|
||
(L () (CONS C L)))
|
||
((= C 31.) (SETQ SHORT-RULES (MAKNAM (NREVERSE L))))))
|
||
[A,B,C] will drop a ball in the hole above corresponding location.
|
||
For scored games... <CR> starts. "Q" quits. <LF> restarts game.
|
||
Just for fun... "R" randomize board (conserving parity). <Alt>
|
||
complements a single switch (reading a switch name). "^S" stores
|
||
the current state for later recall. "^R" recalls a previously
|
||
stored state. The characters "/", "\", "-", and "+" initialize
|
||
the board in various interesting ways.
|
||
And finally... "H" gives full documentation, "^Q" quits program.
|
||
|
||
|
||
(DEFUN -*-SHORT-RULES-*- MACRO (()) `',SHORT-RULES)
|
||
|
||
(DEFUN -*-LONG-RULES-*- MACRO (()) `',LONG-RULES)
|
||
|
||
(SETQ SHORT-RULES (-*-SHORT-RULES-*-) LONG-RULES (-*-LONG-RULES-*-))
|
||
|
||
(DEFUN LAMBDA MACRO (X) (LIST 'FUNCTION X))
|
||
|
||
(NOINTERRUPT T)
|
||
|
||
(DECLARE (*FEXPR *DROP *INIT)
|
||
(SPECIAL OBJECT-LIST PARITY-LIST
|
||
TTY-SPEC-INFO \ // MODE REMEMBER
|
||
SHORT-RULES LONG-RULES))
|
||
|
||
(SETQ OBJECT-LIST '(A B C D E F G H))
|
||
(SETQ PARITY-LIST '(A B C F G H))
|
||
|
||
(DEFPROP A (F . D) POINTER)
|
||
(DEFPROP B (D . E) POINTER)
|
||
(DEFPROP C (E . H) POINTER)
|
||
(DEFPROP D (F . G) POINTER)
|
||
(DEFPROP E (G . H) POINTER)
|
||
|
||
;;; Display locations
|
||
|
||
(DEFPROP A (2 . 6.) WHERE)
|
||
(DEFPROP B (2 . 10.) WHERE)
|
||
(DEFPROP C (2 . 14.) WHERE)
|
||
(DEFPROP D (4 . 8.) WHERE)
|
||
(DEFPROP E (4 . 12.) WHERE)
|
||
(DEFPROP F (6 . 6.) WHERE)
|
||
(DEFPROP G (6 . 10.) WHERE)
|
||
(DEFPROP H (6 . 14.) WHERE)
|
||
|
||
;;; State
|
||
|
||
(DEFUN *INIT FEXPR (DIR)
|
||
(COND ((INIT (CAR DIR))
|
||
(TERPRI TYO)
|
||
(PRINC '|(Initialized)| TYO)
|
||
(WASH))))
|
||
|
||
(DEFUN INIT (DIR)
|
||
(COND ((GET 'GAME 'BEING-PLAYED)
|
||
(TERPRI TYO)
|
||
(PRINC '|(Game in progress. Can't quit now!)| TYO)
|
||
())
|
||
(T
|
||
(LET ((STATE (CASEQ DIR (+ '\) (- '//))))
|
||
(MAPC (LAMBDA (X) (PUTPROP X STATE 'STATE))
|
||
OBJECT-LIST)
|
||
T))))
|
||
|
||
(INIT '+)
|
||
|
||
(DEFUN INVERT (X) (CDR (ASSQ X '((// . \) (\ . //)))))
|
||
|
||
(DEFUN STATE (X) (GET X 'STATE))
|
||
|
||
(DEFUN *COMPLEMENT (X)
|
||
(LET ((STATE (INVERT (STATE X))))
|
||
(PUTPROP X STATE 'STATE)
|
||
STATE))
|
||
|
||
(DEFUN COMPLEMENT FEXPR (X) (*COMPLEMENT (CAR X)))
|
||
|
||
(DEFUN DISPLAY ()
|
||
(CURSORPOS 0. 0. TYO)
|
||
(CURSORPOS 'L TYO)
|
||
(COND (MODE
|
||
(PRINC '|Score is | TYO)
|
||
(PRINC // TYO)
|
||
(PRINC '| to | TYO)
|
||
(PRINC \ TYO)
|
||
(PRINC '|. | TYO)
|
||
(PRINC MODE TYO))
|
||
(T
|
||
(PRINC '|State= | TYO)
|
||
(LET ((BASE 2.))
|
||
(MAPCAR 'PRINC
|
||
(EXTEND
|
||
(MAPCAR (FUNCTION (LAMBDA (X) (- X 48.)))
|
||
(EXPLODEN (SGET))))))))
|
||
(MAPC 'DISPLAY-STATE OBJECT-LIST)
|
||
(CURSORPOS 'A TYO)
|
||
(TERPRI TYO)
|
||
(COND ((GET 'GAME 'BEING-PLAYED)
|
||
(COND ((EQ (GET 'GAME 'WHOSE-TURN) '//)
|
||
(PRINC '| <- You play next.| TYO))
|
||
(T
|
||
(PRINC '| You play next. ->| TYO))))))
|
||
|
||
|
||
(DEFUN DISPLAY-STATE (X)
|
||
(LET (((H . V) (GET X 'WHERE))
|
||
(STATE (STATE X)))
|
||
(CURSORPOS H V TYO)
|
||
(PRINC X)
|
||
(CURSORPOS 'D TYO)
|
||
(CURSORPOS 'B TYO)
|
||
(PRINC '| | TYO)
|
||
(CURSORPOS 'B TYO)
|
||
(PRINC (OR (GET X STATE) STATE) TYO)))
|
||
|
||
(DEFUN PROMPT ()
|
||
(GAME-END-CHECK)
|
||
(DISPLAY)
|
||
(TERPRI TYO)
|
||
(TERPRI TYO)
|
||
(TYI TYI))
|
||
|
||
(DEFUN WASH () (CURSORPOS 'E TYO))
|
||
|
||
(DEFUN EXECUTE ()
|
||
(UNWIND-PROTECT (PROGN (TTY-OFF) (EXECUTE1)) (TTY-ON)))
|
||
|
||
(SETQ DIAMOND-1 #01011010)
|
||
(SETQ DIAMOND-2 #10100101)
|
||
|
||
(DEFUN EXECUTE1 ()
|
||
(CURSORPOS 'C TYO)
|
||
(DO ((C (PROMPT) (PROMPT)))
|
||
((= C 17.) (PRINC '|Quit.| TYO) (QUIT) T)
|
||
(COND ((OR (= C 65.) (= C 97.)) (*DROP A))
|
||
((OR (= C 66.) (= C 98.)) (*DROP B))
|
||
((OR (= C 67.) (= C 99.)) (*DROP C))
|
||
((OR (= C 82.) (= C 114.)) (*RANDOMIZE))
|
||
((OR (= C 81.) (= C 113.))
|
||
(TERPRI TYO)
|
||
(COND ((GET 'GAME 'BEING-PLAYED)
|
||
(TYO 7. TYO)
|
||
(SETQ MODE '|(Game Halted)|)
|
||
(REMPROP 'GAME 'BEING-PLAYED)
|
||
(PRINC '|(Game Halted)| TYO))
|
||
(T
|
||
(PRINC '|(No game to halt?)| TYO)))
|
||
(WASH))
|
||
((= C 92.) (*INIT +))
|
||
((= C 47.) (*INIT -))
|
||
((= C 43.)
|
||
(TERPRI TYO)
|
||
(COND ((NOT (GET 'GAME 'BEING-PLAYED))
|
||
(SRESET DIAMOND-2)
|
||
(PRINC '|(Diamond 2)| TYO))
|
||
(T
|
||
(PRINC '|(Game in progress?)| TYO)))
|
||
(WASH))
|
||
((= C 45.)
|
||
(TERPRI TYO)
|
||
(COND ((NOT (GET 'GAME 'BEING-PLAYED))
|
||
(SRESET DIAMOND-1)
|
||
(PRINC '|(Diamond 1)| TYO))
|
||
(T
|
||
(PRINC '|(Game in progress?)| TYO)))
|
||
(WASH))
|
||
((= C 12.) (CURSORPOS 'C TYO))
|
||
((= C 13.) (GAME-BEGIN))
|
||
((= C 10.) (GAME-RESTART))
|
||
((OR (= C 32.) (= C 9.)))
|
||
((= C 19.) (SREMEMBER))
|
||
((= C 18.) (SRECALL))
|
||
((= C 27.) (ALTER))
|
||
((OR (= C 63.) (= C 2120.))
|
||
(SHORT-RULES))
|
||
((OR (= C 72.) (= C 104.))
|
||
(LONG-RULES))
|
||
(T
|
||
(TYO 7. TYO)
|
||
(TERPRI TYO)
|
||
(PRINC '|(Type "?" for help)| TYO)
|
||
(WASH)))))
|
||
|
||
(DEFUN *DROP FEXPR (X)
|
||
(SETQ X (CAR X))
|
||
(TERPRI TYO)
|
||
(PRINC `(|Drop| ,X) TYO)
|
||
(WASH)
|
||
(DROP X))
|
||
|
||
(DEFUN DROP (X)
|
||
(LET* ((STATE (STATE X))
|
||
(POINTER (GET X 'POINTER))
|
||
(NEXT (CASEQ STATE (// (CAR POINTER)) (\ (CDR POINTER)))))
|
||
(*COMPLEMENT X)
|
||
(COND (NEXT (DROP NEXT))
|
||
((EQ X 'F) (DEFPROP GAME // WHOSE-TURN))
|
||
((EQ X 'G) (PUTPROP 'GAME STATE 'WHOSE-TURN))
|
||
(T (DEFPROP GAME \ WHOSE-TURN)))))
|
||
|
||
(DEFUN INIT-TURN ()
|
||
(PUTPROP 'GAME (COND ((MAYBE) '//) (T '\)) 'WHOSE-TURN))
|
||
|
||
(DEFUN ALTER ()
|
||
(COND ((NOT (GET 'GAME 'BEING-PLAYED))
|
||
(CURSORPOS NIL 0. TYO)
|
||
(CURSORPOS 'L TYO)
|
||
(PRINC '|Complement: | TYO)
|
||
(LET ((C (TYI TYI)))
|
||
(SETQ C (ASCII (COND ((AND (> C 96.) (< C 123.))
|
||
(SETQ C (- C 32.)))
|
||
(T C))))
|
||
(TERPRI TYO)
|
||
(COND ((MEMQ C OBJECT-LIST)
|
||
(*COMPLEMENT C)
|
||
(PRINC `(,C |has been complemented|) TYO))
|
||
(T
|
||
(PRINC `(|No node | ,C |... Request ignored|) TYO)))
|
||
(WASH)))
|
||
(T
|
||
(TERPRI TYO)
|
||
(PRINC '|(Game in progress. Don't try to cheat!)| TYO)
|
||
(WASH))))
|
||
|
||
(DEFUN MAYBE () (ZEROP (RANDOM 2.)))
|
||
|
||
(DEFUN *RANDOMIZE ()
|
||
(COND ((GET 'GAME 'BEING-PLAYED)
|
||
(TERPRI TYO)
|
||
(PRINC '|(Can't Randomize. Game in progress)| TYO))
|
||
(T
|
||
(RANDOMIZE)
|
||
(PARITY-CHECK)
|
||
(TERPRI TYO)
|
||
(PRINC '|(Randomized)| TYO)))
|
||
(WASH))
|
||
|
||
(DEFUN RANDOMIZE ()
|
||
(MAPC (LAMBDA (X) (COND ((MAYBE) (*COMPLEMENT X))))
|
||
OBJECT-LIST))
|
||
|
||
(SETQ MODE () // 0. \ 0.)
|
||
|
||
(DEFUN GAME-END-CHECK ()
|
||
(COND ((GET 'GAME 'BEING-PLAYED)
|
||
(DO ((S (STATE (CAR OBJECT-LIST)))
|
||
(X (CDR OBJECT-LIST) (CDR X)))
|
||
((NULL X)
|
||
(TYO 7. TYO)
|
||
(SET S (1+ (EVAL S)))
|
||
(SETQ MODE '|(Game Over)|)
|
||
(REMPROP 'GAME 'BEING-PLAYED))
|
||
(COND ((NOT (EQ S (STATE (CAR X))))
|
||
(RETURN ())))))))
|
||
|
||
(DEFUN GAME-BEGIN ()
|
||
(COND ((GET 'GAME 'BEING-PLAYED)
|
||
(TERPRI TYO)
|
||
(PRINC '|(Game already going?)| TYO))
|
||
(T
|
||
(SETQ MODE '|(Game in Progress)|)
|
||
(INIT-TURN)
|
||
(PUTPROP 'GAME T 'BEING-PLAYED)
|
||
(COND ((ZEROP (RANDOM 2.))
|
||
(SRESET DIAMOND-1))
|
||
(T
|
||
(SRESET DIAMOND-2)))
|
||
(PRINC '|(Game started)| TYO)
|
||
(WASH))))
|
||
|
||
(DEFUN GAME-RESTART ()
|
||
(COND ((GET 'GAME 'BEING-PLAYED)
|
||
(TERPRI TYO)
|
||
(PRINC '|(Game already going?)| TYO))
|
||
(T
|
||
(SETQ MODE '|(Game in Progress)|)
|
||
(PUTPROP 'GAME T 'BEING-PLAYED)
|
||
(PRINC '|(Game started)| TYO)
|
||
(WASH))))
|
||
|
||
(DEFUN PARITY-CHECK ()
|
||
(LET ((P PARITY-LIST))
|
||
(DO ((X P (CDR X))
|
||
(I 0.))
|
||
((NULL X)
|
||
(COND ((ODDP (+ I)) (*COMPLEMENT (NTH (RANDOM 6.) P)))))
|
||
(COND ((EQ (STATE (CAR X)) '//) (SETQ I (1+ I)))))))
|
||
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;; TTY On/Off Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
;;; This section of code written by RWK.
|
||
|
||
;;; If this is the first time loading the file, save out info on tty
|
||
;;; initial specifications.
|
||
|
||
(COND ((NOT (BOUNDP 'TTY-SPEC-INFO))
|
||
(SETQ TTY-SPEC-INFO (SYSCALL 3. 'TTYGET TYI))))
|
||
|
||
;;; TTY-OFF
|
||
;;; Turns off automatic echo of input chars on the tty.
|
||
|
||
(DEFUN TTY-OFF ()
|
||
(SYSCALL 0 'TTYSET TYI
|
||
(BOOLE 1 (CAR TTY-SPEC-INFO) 3272356035.)
|
||
(BOOLE 1 (CADR TTY-SPEC-INFO) 3272356035.)))
|
||
|
||
;;; TTY-ON
|
||
;;; Re-enable automatic echo of input-chars on the tty.
|
||
|
||
(DEFUN TTY-ON ()
|
||
(SYSCALL 0 'TTYSET TYI
|
||
(CAR TTY-SPEC-INFO)
|
||
(CADR TTY-SPEC-INFO)))
|
||
|
||
|
||
(DEFUN SGET ()
|
||
(LET ((IBASE 2.))
|
||
(READLIST (APPEND (MAPCAR 'SGET1 OBJECT-LIST) '(32.)))))
|
||
|
||
(DEFUN SGET1 (X)
|
||
(COND ((EQ (STATE X) '//) '/0)
|
||
(T '/1)))
|
||
|
||
(DEFUN SRESET (X)
|
||
(LET ((BASE 2.))
|
||
(MAPC 'SRESET1
|
||
(EXTEND (MAPCAR (FUNCTION (LAMBDA (X) (- X 48.))) (EXPLODEN X)))
|
||
OBJECT-LIST)))
|
||
|
||
(DEFUN EXTEND (X)
|
||
(COND ((= (LENGTH X) (LENGTH OBJECT-LIST)) X)
|
||
(T (EXTEND (CONS 0. X)))))
|
||
|
||
(DEFUN SRESET1 (STATE OBJECT)
|
||
(PUTPROP OBJECT
|
||
(COND ((ZEROP STATE) '//)
|
||
(T '\))
|
||
'STATE))
|
||
|
||
(DEFUN SRECALL ()
|
||
(TERPRI TYO)
|
||
(COND ((NOT (GET 'GAME 'BEING-PLAYED))
|
||
(SRESET REMEMBER)
|
||
(PRINC '|(State Recalled)| TYO))
|
||
(T
|
||
(PRINC '|(Game in progress. Can't hack states.)| TYO)))
|
||
(WASH))
|
||
|
||
(DEFUN SREMEMBER ()
|
||
(TERPRI TYO)
|
||
(SETQ REMEMBER (SGET))
|
||
(PRINC '|(State Stored)| TYO)
|
||
(WASH))
|
||
|
||
|
||
(DEFUN SHORT-RULES ()
|
||
(PRINC SHORT-RULES TYO)
|
||
(WASH))
|
||
|
||
(DEFUN LONG-RULES ()
|
||
(CURSORPOS 'C TYO)
|
||
(*CATCH 'MORE-FLUSH
|
||
(PROGN
|
||
(DO ((I 1. (1+ I))
|
||
(END (FLATC LONG-RULES))
|
||
(C))
|
||
((> I END))
|
||
(SETQ C (GETCHARN LONG-RULES I))
|
||
(COND ((= C 12.)
|
||
(TERPRI TYO)
|
||
(CURSORPOS 'E TYO)
|
||
(CLEAR-INPUT TYI)
|
||
(PRINC '|--Type a Space to See More--| TYO)
|
||
(COND ((NOT (= (TYI TYI) 32.))
|
||
(*THROW 'MORE-FLUSH T)))
|
||
(CURSORPOS 0. 0. TYO))
|
||
((= C 13.)
|
||
(CURSORPOS 'L TYO)
|
||
(TYO C TYO))
|
||
(T
|
||
(TYO C TYO))))
|
||
(TERPRI TYO)
|
||
(PRINC '|--Pause--| TYO)
|
||
(CURSORPOS 'E TYO)
|
||
(TYI TYI)))
|
||
(CURSORPOS 'C TYO))
|
||
|
||
|
||
(DO ((I 0. (1+ I)))
|
||
((> I 127.))
|
||
(SSTATUS TTYINT I NIL))
|
||
(SSTATUS TOPLEVEL '(PROGN (CLEAR-INPUT TYI) (EXECUTE)))
|
||
(SETQ TTY-RETURN '(LAMBDA N (CURSORPOS 'C TYO)
|
||
(DISPLAY)
|
||
(TERPRI TYO)
|
||
(TERPRI TYO)))
|
||
|
||
(LET ((INIT-FILE (PROBEF `((DSK ,(STATUS HSNAME)) ,(STATUS USERID) THINK))))
|
||
(COND (INIT-FILE (LOAD INIT-FILE))))
|
||
|
||
(INIT '+)
|
||
|
||
(SETQ REMEMBER 0.)
|
||
|
||
(NOINTERRUPT NIL)
|
||
|