2019-04-14 08:53:40 +03:00
|
|
|
|
"MISC for
|
|
|
|
|
The Lurking Horror
|
|
|
|
|
(c) Copyright 1986 Infocom, Inc. All Rights Reserved."
|
|
|
|
|
|
|
|
|
|
<DEFINE DEBUG-CODE ('X "OPTIONAL" ('Y T))
|
|
|
|
|
<COND (,ZDEBUGGING? .X)(ELSE .Y)>>
|
|
|
|
|
|
|
|
|
|
;"tell macro and friends"
|
|
|
|
|
|
|
|
|
|
<TELL-TOKENS (CRLF CR) <CRLF>
|
|
|
|
|
(NUM N) * <PRINTN .X>
|
|
|
|
|
(CHAR CHR C) * <PRINTC .X>
|
|
|
|
|
S *:STRING <PRINT .X>
|
|
|
|
|
D ,PRSO <DPRINT-PRSO>
|
|
|
|
|
D ,PRSI <DPRINT-PRSI>
|
|
|
|
|
D * <DPRINT .X>
|
|
|
|
|
CD ,PRSO <CDPRINT-PRSO>
|
|
|
|
|
CD ,PRSI <CDPRINT-PRSI>
|
|
|
|
|
CD * <CDPRINT .X>
|
|
|
|
|
THE ,PRSO <THE-PRINT-PRSO>
|
|
|
|
|
THE ,PRSI <THE-PRINT-PRSI>
|
|
|
|
|
THE * <THE-PRINT .X>
|
|
|
|
|
CTHE ,PRSO <CTHE-PRINT-PRSO>
|
|
|
|
|
CTHE ,PRSI <CTHE-PRINT-PRSI>
|
|
|
|
|
CTHE * <CTHE-PRINT .X>
|
|
|
|
|
(A AN) ,PRSO <PRINTA-PRSO>
|
|
|
|
|
(A AN) ,PRSI <PRINTA-PRSI>
|
|
|
|
|
(A AN) * <PRINTA .X>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE CTHE-PRINT-PRSO ()
|
|
|
|
|
<THE-PRINT ,PRSO T>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE CTHE-PRINT-PRSI ()
|
|
|
|
|
<THE-PRINT ,PRSI T>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE CTHE-PRINT (O)
|
|
|
|
|
<THE-PRINT .O T>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE THE-PRINT-PRSO ()
|
|
|
|
|
<THE-PRINT ,PRSO>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE THE-PRINT-PRSI ()
|
|
|
|
|
<THE-PRINT ,PRSI>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE THE-PRINT (O "OPTIONAL" (CAP? <>))
|
|
|
|
|
<DPRINT .O .CAP? <NOT <FSET? .O ,NOTHEBIT>>>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE PRINTA-PRSO ()
|
|
|
|
|
<PRINTA ,PRSO>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE PRINTA-PRSI ()
|
|
|
|
|
<PRINTA ,PRSI>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE PRINTA (O)
|
|
|
|
|
<COND (<FSET? .O ,THE> <PRINTI "the ">)
|
|
|
|
|
(<NOT <FSET? .O ,NOABIT>>
|
|
|
|
|
<COND (<FSET? .O ,AN> <PRINTI "an ">)
|
|
|
|
|
(ELSE <PRINTI "a ">)>)>
|
|
|
|
|
<IPRINT .O>>
|
|
|
|
|
|
|
|
|
|
;<ROUTINE CDPRINT-PRSO ()
|
|
|
|
|
<DPRINT ,PRSO T>>
|
|
|
|
|
|
|
|
|
|
;<ROUTINE CDPRINT-PRSI ()
|
|
|
|
|
<DPRINT ,PRSI T>>
|
|
|
|
|
|
|
|
|
|
;<ROUTINE CDPRINT (O)
|
|
|
|
|
<DPRINT .O T>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE DPRINT (O "OPTIONAL" (CAP? <>) (THE? <>) "AUX" S)
|
|
|
|
|
<COND (<OR .THE? <FSET? .O ,THE>>
|
|
|
|
|
<COND (.CAP? <PRINTI "The ">)
|
|
|
|
|
(T <PRINTI "the ">)>)>
|
|
|
|
|
<IPRINT .O>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE IPRINT (O)
|
|
|
|
|
<COND (<AND <EQUAL? .O ,PSEUDO-OBJECT>
|
|
|
|
|
<NOT ,P-MERGED>
|
|
|
|
|
<EQUAL? .O ,PRSO ,PRSI>>
|
|
|
|
|
<THING-PRINT ,PSEUDO-PRSO ;"<EQUAL? .O ,PRSO>">)
|
|
|
|
|
(<EQUAL? .O ,INTNAME>
|
|
|
|
|
<PRINTB ,P-NAME>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<PRINTD .O>)>>
|
|
|
|
|
|
|
|
|
|
<COND (<GASSIGNED? ZILCH>
|
|
|
|
|
<DEFINE PE (F I)
|
|
|
|
|
<COND (<TYPE? .I LIST>
|
|
|
|
|
<FORM .F !.I>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<FORM .F .I>)>>
|
|
|
|
|
|
|
|
|
|
<DEFMAC P? ('V "OPT" ('O '*) ('I '*) ('W '*) "AUX" (L ()))
|
|
|
|
|
<COND (<N==? .I '*>
|
|
|
|
|
<SET L (<PE PRSI? .I> !.L)>)>
|
|
|
|
|
<COND (<N==? .O '*>
|
|
|
|
|
<SET L (<PE PRSO? .O> !.L)>)>
|
|
|
|
|
<COND (<N==? .V '*>
|
|
|
|
|
<SET L (<PE VERB? .V> !.L)>)>
|
|
|
|
|
<COND (<N==? .W '*>
|
|
|
|
|
<SET L (<PE WINNER? .W> !.L)>)>
|
|
|
|
|
<COND (<EMPTY? <REST .L>>
|
|
|
|
|
<1 .L>)
|
|
|
|
|
(ELSE <FORM AND !.L>)>>
|
|
|
|
|
|
|
|
|
|
<DEFMAC VERB? ("ARGS" ATMS)
|
|
|
|
|
<MULTIFROB ',PRSA .ATMS>>
|
|
|
|
|
|
|
|
|
|
<DEFMAC CONTEXT? ("ARGS" ATMS)
|
|
|
|
|
<MULTIFROB '.RARG .ATMS>>
|
|
|
|
|
|
|
|
|
|
<SETG RARG? ,CONTEXT?>
|
|
|
|
|
|
|
|
|
|
<DEFMAC WINNER? ("ARGS" ATMS)
|
|
|
|
|
<MULTIFROB ',WINNER .ATMS>>
|
|
|
|
|
|
|
|
|
|
<DEFMAC PRSO? ("ARGS" ATMS)
|
|
|
|
|
<MULTIFROB ',PRSO .ATMS>>
|
|
|
|
|
|
|
|
|
|
<DEFMAC PRSI? ("ARGS" ATMS)
|
|
|
|
|
<MULTIFROB ',PRSI .ATMS>>
|
|
|
|
|
|
|
|
|
|
<DEFMAC HERE? ("ARGS" ATMS)
|
|
|
|
|
<MULTIFROB ',HERE .ATMS>>
|
|
|
|
|
|
|
|
|
|
<SETG ROOM? ,HERE?>
|
|
|
|
|
|
|
|
|
|
<DEFINE MULTIFROB (X ATMS "AUX" (OO (OR)) (O .OO) (L ()) ATM SP)
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<COND (<EMPTY? .ATMS>
|
|
|
|
|
<RETURN!- <COND (<LENGTH? .OO 1> <ERROR .X>)
|
|
|
|
|
(<LENGTH? .OO 2> <NTH .OO 2>)
|
|
|
|
|
(ELSE <CHTYPE .OO FORM>)>>)>
|
|
|
|
|
<REST
|
|
|
|
|
<PUTREST
|
|
|
|
|
.O
|
|
|
|
|
<SET O
|
|
|
|
|
(<REPEAT
|
|
|
|
|
((LL <FORM EQUAL? .X>)
|
|
|
|
|
(L <REST .LL>))
|
|
|
|
|
<COND (<OR <EMPTY? .ATMS>
|
|
|
|
|
<==? <LENGTH <REST .LL 2>> 3>>
|
|
|
|
|
<RETURN!- .LL>)>
|
|
|
|
|
<SET ATM <NTH .ATMS 1>>
|
|
|
|
|
<PUTREST
|
|
|
|
|
.L
|
|
|
|
|
<SET L
|
|
|
|
|
(<COND
|
|
|
|
|
(<TYPE? .ATM ATOM>
|
|
|
|
|
<SET SP <SPNAME .ATM>>
|
|
|
|
|
<MAKE-GVAL
|
|
|
|
|
<COND (<==? .X ',PRSA>
|
|
|
|
|
<PARSE <STRING "V?" .SP>>)
|
|
|
|
|
(<==? .X '.RARG>
|
|
|
|
|
<COND (<AND <G? <LENGTH .SP> 2>
|
|
|
|
|
<==? <1 .SP> !\M>
|
|
|
|
|
<==? <2 .SP> !\->>
|
|
|
|
|
.ATM)
|
|
|
|
|
(ELSE
|
|
|
|
|
<PARSE
|
|
|
|
|
<STRING "M-" .SP>>)>)
|
|
|
|
|
(ELSE .ATM)>>)
|
|
|
|
|
(ELSE .ATM)>)>>
|
|
|
|
|
<SET ATMS <REST .ATMS>>>)>>>>>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<DEFINE P? (V "OPT" (O '*) (I '*) (W '*) "AUX" (L <>))
|
|
|
|
|
<AND <OR <==? .W '*> <WINNER? .W>>
|
|
|
|
|
<OR <==? .V '*> <VERB? .V>>
|
|
|
|
|
<OR <==? .O '*> <PRSO? .O>>
|
|
|
|
|
<OR <==? .I '*> <PRSI? .I>>>>
|
|
|
|
|
|
|
|
|
|
<DEFINE VERB? ("TUPLE" ATMS)
|
|
|
|
|
<MAPF <>
|
|
|
|
|
<FUNCTION (A "AUX" ATM)
|
|
|
|
|
<COND (<TYPE? .A ATOM>
|
|
|
|
|
<COND (<SET ATM
|
|
|
|
|
<LOOKUP <STRING "V?" <SPNAME .A>>
|
|
|
|
|
<MOBLIST INITIAL>>>
|
|
|
|
|
<COND (<EQUAL? ,PRSA ,.ATM>
|
|
|
|
|
<MAPLEAVE T>)>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<ERROR NOT-A-VERB? .A>)>)
|
|
|
|
|
(<EQUAL? ,PRSA .A>
|
|
|
|
|
<MAPLEAVE T>)>>
|
|
|
|
|
.ATMS>>
|
|
|
|
|
<DEFINE CONTEXT? ("TUPLE" ATMS)
|
|
|
|
|
<MAPF <>
|
|
|
|
|
<FUNCTION (A "AUX" ATM)
|
|
|
|
|
<COND (<TYPE? .A ATOM>
|
|
|
|
|
<COND (<AND <G? <LENGTH <SET ATM <SPNAME .A>>> 2>
|
|
|
|
|
<==? <1 .ATM> !\M>
|
|
|
|
|
<==? <2 .ATM> !\->>
|
|
|
|
|
<COND (<EQUAL? .RARG ,.ATM>
|
|
|
|
|
<MAPLEAVE T>)>)
|
|
|
|
|
(<SET ATM
|
|
|
|
|
<LOOKUP <STRING "M-" <SPNAME .A>>
|
|
|
|
|
<MOBLIST INITIAL>>>
|
|
|
|
|
<COND (<EQUAL? .RARG ,.ATM>
|
|
|
|
|
<MAPLEAVE T>)>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<ERROR NOT-A-CONTEXT? .A>)>)
|
|
|
|
|
(<EQUAL? .RARG .A>
|
|
|
|
|
<MAPLEAVE T>)>>
|
|
|
|
|
.ATMS>>
|
|
|
|
|
<SETG RARG? ,CONTEXT?>
|
|
|
|
|
<DEFINE WINNER? ("TUPLE" ATMS)
|
|
|
|
|
<MULTIFROB ,WINNER .ATMS>>
|
|
|
|
|
<DEFINE PRSO? ("TUPLE" ATMS)
|
|
|
|
|
<MULTIFROB ,PRSO .ATMS>>
|
|
|
|
|
<DEFINE PRSI? ("TUPLE" ATMS)
|
|
|
|
|
<MULTIFROB ,PRSI .ATMS>>
|
|
|
|
|
<DEFINE HERE? ("TUPLE" ATMS)
|
|
|
|
|
<MULTIFROB HERE .ATMS>>
|
|
|
|
|
<SETG ROOM? ,HERE?>
|
|
|
|
|
<DEFINE MULTIFROB (X ATMS)
|
|
|
|
|
<MAPF <>
|
|
|
|
|
<FUNCTION (A)
|
|
|
|
|
<COND (<TYPE? .A ATOM> <SET A ,.A>)>
|
|
|
|
|
<COND (<EQUAL? .X .A>
|
|
|
|
|
<MAPLEAVE T>)>>
|
|
|
|
|
.ATMS>>)>
|
|
|
|
|
|
|
|
|
|
<COND (<GASSIGNED? ZILCH>
|
|
|
|
|
<DEFMAC BSET ('OBJ "ARGS" BITS)
|
|
|
|
|
<MULTIBITS FSET .OBJ .BITS>>
|
|
|
|
|
|
|
|
|
|
<DEFMAC BCLEAR ('OBJ "ARGS" BITS)
|
|
|
|
|
<MULTIBITS FCLEAR .OBJ .BITS>>
|
|
|
|
|
|
|
|
|
|
<DEFMAC BSET? ('OBJ "ARGS" BITS)
|
|
|
|
|
<MULTIBITS FSET? .OBJ .BITS>>
|
|
|
|
|
|
|
|
|
|
<DEFINE MULTIBITS (X OBJ ATMS
|
|
|
|
|
"AUX" (OT <COND (<==? .X FSET?> <FORM OR>)
|
|
|
|
|
(ELSE <FORM PROG ()>)>)
|
|
|
|
|
(OO <COND (<LENGTH? .OT 1> .OT)
|
|
|
|
|
(ELSE <REST .OT>)>)
|
|
|
|
|
(O .OO)
|
|
|
|
|
ATM)
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<COND (<EMPTY? .ATMS>
|
|
|
|
|
<RETURN!- .OT>)>
|
|
|
|
|
<SET ATM <NTH .ATMS 1>>
|
|
|
|
|
<SET ATMS <REST .ATMS>>
|
|
|
|
|
<PUTREST .O
|
|
|
|
|
<SET O
|
|
|
|
|
(<FORM .X
|
|
|
|
|
.OBJ
|
|
|
|
|
<COND (<TYPE? .ATM FORM> .ATM)
|
|
|
|
|
(ELSE <MAKE-GVAL .ATM>)>>)>>>>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<DEFINE BSET (OBJ "TUPLE" BITS)
|
|
|
|
|
<MULTIBITS ,FSET .OBJ .BITS>>
|
|
|
|
|
|
|
|
|
|
<DEFINE BCLEAR (OBJ "TUPLE" BITS)
|
|
|
|
|
<MULTIBITS ,FCLEAR .OBJ .BITS>>
|
|
|
|
|
|
|
|
|
|
<DEFINE BSET? (OBJ "TUPLE" BITS)
|
|
|
|
|
<MAPF <>
|
|
|
|
|
<FUNCTION (A)
|
|
|
|
|
<COND (<FSET? .OBJ ,.A> <MAPLEAVE T>)>>
|
|
|
|
|
.BITS>>
|
|
|
|
|
|
|
|
|
|
<DEFINE MULTIBITS (X OBJ ATMS)
|
|
|
|
|
<MAPF <>
|
|
|
|
|
<FUNCTION (A)
|
|
|
|
|
<APPLY!- .X .OBJ ,.A>>
|
|
|
|
|
.ATMS>>)>
|
|
|
|
|
|
|
|
|
|
<DEFMAC RFATAL ()
|
|
|
|
|
'<RETURN ,M-FATAL>>
|
|
|
|
|
|
|
|
|
|
<COND (<GASSIGNED? ZILCH>
|
|
|
|
|
<DEFMAC PROB ('BASE?)
|
|
|
|
|
<FORM NOT <FORM L? .BASE? '<RANDOM 100>>>>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<DEFINE PROB (BASE?)
|
|
|
|
|
<NOT <L? .BASE? <RANDOM 100>>>>)>
|
|
|
|
|
|
|
|
|
|
<ROUTINE PICK-ONE (FROB
|
|
|
|
|
"AUX" (L <GET .FROB 0>) (CNT <GET .FROB 1>) RND MSG RFROB)
|
|
|
|
|
<SET L <- .L 1>>
|
|
|
|
|
<SET FROB <REST .FROB 2>>
|
|
|
|
|
<SET RFROB <REST .FROB <* .CNT 2>>>
|
|
|
|
|
<SET RND <RANDOM <- .L .CNT>>>
|
|
|
|
|
<SET MSG <GET .RFROB .RND>>
|
|
|
|
|
<PUT .RFROB .RND <GET .RFROB 1>>
|
|
|
|
|
<PUT .RFROB 1 .MSG>
|
|
|
|
|
<SET CNT <+ .CNT 1>>
|
|
|
|
|
<COND (<==? .CNT .L> <SET CNT 0>)>
|
|
|
|
|
<PUT .FROB 0 .CNT>
|
|
|
|
|
.MSG>
|
|
|
|
|
|
|
|
|
|
<ROUTINE RANDOM-ELEMENT (FROB)
|
|
|
|
|
<GET .FROB <RANDOM <GET .FROB 0>>>>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;"former MAIN.ZIL stuff"
|
|
|
|
|
|
|
|
|
|
<GLOBAL P-WON <>>
|
|
|
|
|
|
|
|
|
|
<CONSTANT M-FATAL 2>
|
|
|
|
|
|
|
|
|
|
<CONSTANT M-BEG 1>
|
|
|
|
|
<CONSTANT M-END 2>
|
|
|
|
|
<CONSTANT M-ENTER 3>
|
|
|
|
|
<CONSTANT M-LEAVE 4>
|
|
|
|
|
<CONSTANT M-LOOK 5>
|
|
|
|
|
<CONSTANT M-FLASH 6>
|
|
|
|
|
<CONSTANT M-OBJDESC 7>
|
|
|
|
|
<CONSTANT M-CONTAINER 8>
|
|
|
|
|
|
|
|
|
|
<ROUTINE GO ()
|
|
|
|
|
<PUT-GLOBAL ,TOMB 0 0>
|
|
|
|
|
<PUT-GLOBAL ,TOMB 1 0>
|
|
|
|
|
;"put interrupts on clock chain"
|
|
|
|
|
<SETG CLOCK-HAND <REST ,C-TABLE ,C-TABLELEN>>
|
|
|
|
|
<QUEUE I-URCHIN 10>
|
|
|
|
|
<QUEUE I-TIRED 200>
|
|
|
|
|
;"set up and go"
|
|
|
|
|
<SETG P-HIM-OBJECT ,HACKER>
|
|
|
|
|
<SETG P-IT-OBJECT ,PC>
|
|
|
|
|
<SETG WINNER ,PLAYER>
|
|
|
|
|
<SETG HERE ,TERMINAL-ROOM>
|
|
|
|
|
<SETG LIT <LIT? ,HERE>>
|
|
|
|
|
<USL>
|
|
|
|
|
<TELL
|
|
|
|
|
"You've waited until the last minute again. This time it's the end of
|
|
|
|
|
the term, so all the TechNet terminals in the dorm are occupied.
|
|
|
|
|
So, off you go to the old Comp Center. Too bad it's the worst storm of
|
|
|
|
|
the winter (Murphy's Law, right?), and you practically froze to death
|
|
|
|
|
slogging over here from the dorm. Not to mention jumping at every
|
|
|
|
|
shadow, what with all the recent disappearances. Time to find a free
|
|
|
|
|
machine, get to work, and write that twenty page paper." CR CR>
|
|
|
|
|
<V-VERSION>
|
|
|
|
|
<CRLF>
|
|
|
|
|
<V-LOOK>
|
|
|
|
|
<MAIN-LOOP>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE MAIN-LOOP ("AUX" TRASH)
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<SET TRASH <MAIN-LOOP-1>>>>
|
|
|
|
|
|
|
|
|
|
<GLOBAL WAS-IT? <>>
|
|
|
|
|
<GLOBAL WAS-HIM? <>>
|
|
|
|
|
|
|
|
|
|
<GLOBAL PERFORM-DEPTH 0> ;"number recursive calls to perform"
|
|
|
|
|
|
|
|
|
|
<ROUTINE MAIN-LOOP-1 ("AUX" ICNT OCNT NUM (CNT 0) (OBJ <>) TBL
|
|
|
|
|
(V <>) (PTBL T) OBJ1 TMP ONUM)
|
|
|
|
|
<COND (<SETG P-WON <PARSER>>
|
|
|
|
|
<SET ICNT <GET ,P-PRSI ,P-MATCHLEN>>
|
|
|
|
|
<SET OCNT <GET ,P-PRSO ,P-MATCHLEN>>
|
|
|
|
|
<SETG WAS-IT? <OBJECT-SUBSTITUTE ,IT ,P-IT-OBJECT>>
|
|
|
|
|
<SETG WAS-HIM? <OBJECT-SUBSTITUTE ,HIM ,P-HIM-OBJECT>>
|
|
|
|
|
<SET ONUM <BAND <GETB ,P-SYNTAX ,P-SBITS> ,P-SONUMS>>
|
|
|
|
|
<SET NUM
|
|
|
|
|
<COND (<OR <ZERO? .OCNT>
|
|
|
|
|
<AND <ZERO? .ICNT>
|
|
|
|
|
<EQUAL? .ONUM 2>>>
|
|
|
|
|
0)
|
|
|
|
|
(<G? .OCNT 1>
|
|
|
|
|
<SET TBL ,P-PRSO>
|
|
|
|
|
<COND (<ZERO? .ICNT> <SET OBJ <>>)
|
|
|
|
|
(T <SET OBJ <GET ,P-PRSI 1>>)>
|
|
|
|
|
.OCNT)
|
|
|
|
|
(<G? .ICNT 1>
|
|
|
|
|
<SET PTBL <>>
|
|
|
|
|
<SET TBL ,P-PRSI>
|
|
|
|
|
<SET OBJ <GET ,P-PRSO 1>>
|
|
|
|
|
.ICNT)
|
|
|
|
|
(T 1)>>
|
|
|
|
|
<COND (<AND <NOT .OBJ> <1? .ICNT>>
|
|
|
|
|
<SET OBJ <GET ,P-PRSI 1>>)>
|
|
|
|
|
<SETG PERFORM-DEPTH 0>
|
|
|
|
|
<COND (<EQUAL? ,PRSA ,V?WALK> <SET V <PERFORM-PRSA ,PRSO>>)
|
|
|
|
|
(<ZERO? .NUM>
|
|
|
|
|
<COND (<ZERO? .ONUM>
|
|
|
|
|
<SET V <PERFORM-PRSA>>
|
|
|
|
|
<SETG PRSO <>>)
|
|
|
|
|
(<NOT ,LIT>
|
|
|
|
|
<TELL ,TOO-DARK>
|
|
|
|
|
<END-QUOTE>)
|
|
|
|
|
(T
|
|
|
|
|
<TELL "There isn't anything to ">
|
|
|
|
|
<SET TMP <GET ,P-ITBL ,P-VERBN>>
|
|
|
|
|
<COND (<VERB? TELL>
|
|
|
|
|
<TELL "talk to">)
|
|
|
|
|
(<OR ,P-OFLAG ,P-MERGED>
|
|
|
|
|
<PRINTB <GET .TMP 0>>)
|
|
|
|
|
(T
|
|
|
|
|
<WORD-PRINT <GETB .TMP 2>
|
|
|
|
|
<GETB .TMP 3>>)>
|
|
|
|
|
<TELL "!" CR>
|
|
|
|
|
<SET V <>>
|
|
|
|
|
<END-QUOTE>)>)
|
|
|
|
|
(T
|
|
|
|
|
<SETG P-NOT-HERE 0>
|
|
|
|
|
<SETG P-MULT <>>
|
|
|
|
|
<COND (<G? .NUM 1> <SETG P-MULT 1>)>
|
|
|
|
|
<SET TMP <>>
|
|
|
|
|
<SET CNT 0>
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<COND (<G? <SET CNT <+ .CNT 1>> .NUM>
|
|
|
|
|
<COND (<G? ,P-NOT-HERE 0>
|
|
|
|
|
<TELL "The ">
|
|
|
|
|
<COND (<NOT <EQUAL? ,P-NOT-HERE .NUM>>
|
|
|
|
|
<TELL "other ">)>
|
|
|
|
|
<TELL "object">
|
|
|
|
|
<COND (<NOT <EQUAL? ,P-NOT-HERE 1>>
|
|
|
|
|
<TELL "s">)>
|
|
|
|
|
<TELL " that you mentioned ">
|
|
|
|
|
<COND (<NOT <EQUAL? ,P-NOT-HERE 1>>
|
|
|
|
|
<TELL "are">)
|
|
|
|
|
(T <TELL "is">)>
|
|
|
|
|
<TELL "n't here." CR>)
|
|
|
|
|
(<NOT .TMP>
|
|
|
|
|
<TELL ,REFERRING CR>)>
|
|
|
|
|
<RETURN>)
|
|
|
|
|
|
|
|
|
|
(T ;"REFORMATTED AREA"
|
|
|
|
|
<COND (.PTBL <SET OBJ1 <GET ,P-PRSO .CNT>>)
|
|
|
|
|
(T <SET OBJ1 <GET ,P-PRSI .CNT>>)>
|
|
|
|
|
<SETG PRSO <COND (.PTBL .OBJ1) (T .OBJ)>>
|
|
|
|
|
<SETG PRSI <COND (.PTBL .OBJ) (T .OBJ1)>>
|
|
|
|
|
<COND (<OR <G? .NUM 1>
|
|
|
|
|
<EQUAL? <GET <GET ,P-ITBL ,P-NC1> 0> ,W?ALL>>
|
|
|
|
|
<COND (<MULTIPLE-EXCEPTION? .OBJ1> <AGAIN>)
|
|
|
|
|
(<VERB? COMPARE-MANY>)
|
|
|
|
|
(T
|
|
|
|
|
<COND (<EQUAL? .OBJ1 ,IT>
|
|
|
|
|
<TELL D ,P-IT-OBJECT>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<TELL D .OBJ1>)>
|
|
|
|
|
<TELL ": ">)>)>
|
|
|
|
|
<SET TMP T>
|
|
|
|
|
<SETG PSEUDO-PRSO <COND (<PRSO? ,PSEUDO-OBJECT>)>>
|
|
|
|
|
<SET V <PERFORM-PRSA ,PRSO ,PRSI>>
|
|
|
|
|
<COND (<EQUAL? .V ,M-FATAL> <RETURN>)>
|
|
|
|
|
<COND (,P-MULT <SETG P-MULT <+ ,P-MULT 1>>)>) ;"END REFORMATTING"
|
|
|
|
|
|
|
|
|
|
>>)>
|
|
|
|
|
<COND (<NOT <EQUAL? .V ,M-FATAL>>
|
|
|
|
|
<COND (<GAME-VERB?> T)
|
|
|
|
|
(<LOC ,WINNER>
|
|
|
|
|
<SET V
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<D-APPLY "End"
|
|
|
|
|
<GETP <LOC ,WINNER> ,P?ACTION>
|
|
|
|
|
,M-END>
|
|
|
|
|
<APPLY <GETP <LOC ,WINNER> ,P?ACTION>
|
|
|
|
|
,M-END>>>)>)>
|
|
|
|
|
<COND (<EQUAL? .V ,M-FATAL>
|
|
|
|
|
<SETG P-CONT <>>)>)
|
|
|
|
|
(T
|
|
|
|
|
<SETG P-CONT <>>)>
|
|
|
|
|
<COND (,P-WON
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<COND (<VERB? $DEBUG>
|
|
|
|
|
<AGAIN>)>>
|
|
|
|
|
<COND (<GAME-VERB?> T)
|
|
|
|
|
(T
|
|
|
|
|
<SET V <CLOCKER>>)>
|
|
|
|
|
<SETG PRSA <>>
|
|
|
|
|
<SETG PRSO <>>
|
|
|
|
|
<SETG PRSI <>>)>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE OBJECT-SUBSTITUTE (OBJ VAR "AUX" (TMP <>) (CNT 0) ICNT OCNT)
|
|
|
|
|
<COND (<AND .VAR <ACCESSIBLE? .VAR>>
|
|
|
|
|
<SET ICNT <GET ,P-PRSI ,P-MATCHLEN>>
|
|
|
|
|
<SET OCNT <GET ,P-PRSO ,P-MATCHLEN>>
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<COND (<G? <SET CNT <+ .CNT 1>> .ICNT>
|
|
|
|
|
<RETURN>)
|
|
|
|
|
(T
|
|
|
|
|
<COND (<EQUAL? <GET ,P-PRSI .CNT> .OBJ>
|
|
|
|
|
<PUT ,P-PRSI .CNT .VAR>
|
|
|
|
|
<SET TMP T>
|
|
|
|
|
<RETURN>)>)>>
|
|
|
|
|
<SET CNT 0>
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<COND (<G? <SET CNT <+ .CNT 1>> .OCNT>
|
|
|
|
|
<RETURN>)
|
|
|
|
|
(T
|
|
|
|
|
<COND (<EQUAL? <GET ,P-PRSO .CNT> .OBJ>
|
|
|
|
|
<PUT ,P-PRSO .CNT .VAR>
|
|
|
|
|
<SET TMP T>
|
|
|
|
|
<RETURN>)>)>>
|
|
|
|
|
.TMP)>>
|
|
|
|
|
|
|
|
|
|
<GLOBAL PSEUDO-PRSO <>> ;"T IF ORIGINAL PRSO WAS PSEUDO-OBJECT"
|
|
|
|
|
|
|
|
|
|
<ROUTINE GAME-VERB? ()
|
|
|
|
|
<COND (<AND <VERB? TELL> ,P-CONT> <RTRUE>)
|
|
|
|
|
(<AND <VERB? HELP>
|
|
|
|
|
<NOT ,PRSO>
|
|
|
|
|
<NOT <IN? ,PC ,HERE>>>
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<VERB? QUIT VERSION BRIEF SUPER-BRIEF VERBOSE
|
|
|
|
|
$VERIFY RESTART SAVE RESTORE SCRIPT UNSCRIPT
|
2019-04-14 08:54:38 +03:00
|
|
|
|
$SOUND $RANDOM $COMMAND $RECORD $UNRECORD SCORE
|
2019-04-14 08:53:40 +03:00
|
|
|
|
TIME>
|
|
|
|
|
<RTRUE>)>>
|
|
|
|
|
|
|
|
|
|
"MULTIPLE-EXCEPTION? -- return true if an object found by all should not
|
|
|
|
|
be included when the crunch comes."
|
|
|
|
|
|
|
|
|
|
<ROUTINE MULTIPLE-EXCEPTION? (OBJ1 "AUX" (L <LOC .OBJ1>))
|
|
|
|
|
<COND (<EQUAL? .OBJ1 ,NOT-HERE-OBJECT>
|
|
|
|
|
<SETG P-NOT-HERE <+ ,P-NOT-HERE 1>>
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<AND <VERB? TAKE>
|
|
|
|
|
,PRSI
|
|
|
|
|
<NOT <IN? ,PRSO ,PRSI>>>
|
|
|
|
|
;"TAKE X FROM Y and x not in y"
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<NOT <ACCESSIBLE? .OBJ1>>
|
|
|
|
|
;"can't get at object"
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<EQUAL? ,P-GETFLAGS ,P-ALL>
|
|
|
|
|
;"cases for ALL"
|
|
|
|
|
<COND (<AND ,PRSI
|
|
|
|
|
<PRSO? ,PRSI>>
|
|
|
|
|
;"VERB ALL and prso = prsi"
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<AND <VERB? TAKE> <NOT ,PRSI>>
|
|
|
|
|
<COND (<OR <AND <NOT <EQUAL? .L ,WINNER ,HERE ,PRSI>>
|
|
|
|
|
<NOT <EQUAL? .L <LOC ,WINNER>>>
|
|
|
|
|
<NOT <FSET? .L ,SURFACEBIT>>
|
|
|
|
|
<NOT <FSET? .L ,SEARCHBIT>>>
|
|
|
|
|
<AND <NOT <FSET? .OBJ1 ,TAKEBIT>>
|
|
|
|
|
<NOT <FSET? .OBJ1 ,TRYTAKEBIT>>>>
|
|
|
|
|
;"TAKE ALL and object not accessible or takeable"
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<OR <FSET? .L ,PERSON>
|
|
|
|
|
<FSET? <LOC .L> ,PERSON>>
|
|
|
|
|
;"TAKE ALL held by a person (use TAKE ALL FROM)"
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<HELD? ,PRSO>
|
|
|
|
|
;"TAKE ALL and one object has others in it"
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<AND <PRSO? DOME-LADDER>
|
|
|
|
|
<OR ,LADDER-TOP? ,LADDER-BOTTOM?>>
|
|
|
|
|
;"TAKE ALL and ladder set up"
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<AND <PRSO? CHAIN CHAIN-1 CHAIN-2>
|
|
|
|
|
<OR ,CHAIN-HOOKED? ,CHAIN-LOOPED?>
|
|
|
|
|
<NOT <EQUAL? .L
|
|
|
|
|
,ELEVATOR-PIT ,CS-BASEMENT>>>
|
|
|
|
|
;"TAKE ALL and chain looped or hooked"
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<AND <PRSO? PADLOCK>
|
|
|
|
|
,PADLOCK-ON?>
|
|
|
|
|
;"TAKE ALL and padlock locked"
|
|
|
|
|
<RTRUE>)>)
|
|
|
|
|
(<VERB? DROP GIVE>
|
|
|
|
|
<COND (<NOT <IN? .OBJ1 ,WINNER>>
|
|
|
|
|
;"GIVE/DROP ALL and object not held"
|
|
|
|
|
<RTRUE>)
|
|
|
|
|
(<FSET? .OBJ1 ,WEARBIT>
|
|
|
|
|
;"GIVE/DROP ALL and object worn"
|
|
|
|
|
<RTRUE>)>)
|
|
|
|
|
(<AND <VERB? PUT>
|
|
|
|
|
<NOT <IN? ,PRSO ,WINNER>>
|
|
|
|
|
<HELD? ,PRSO ,PRSI>>
|
|
|
|
|
;"PUT ALL IN X and object already in x"
|
|
|
|
|
<RTRUE>)>)>>
|
|
|
|
|
|
|
|
|
|
;<ROUTINE SAVE-INPUT (TBL "AUX" (OFFS 0) CNT TMP)
|
|
|
|
|
<SET CNT <+ <GETB ,P-LEXV <SET TMP <* 4 ,P-INPUT-WORDS>>>
|
|
|
|
|
<GETB ,P-LEXV <+ .TMP 1>>>>
|
|
|
|
|
<COND (<EQUAL? .CNT 0> ;"failed"
|
|
|
|
|
<RFALSE>)>
|
|
|
|
|
<SET CNT <- .CNT 1>>
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<COND (<EQUAL? .OFFS .CNT>
|
|
|
|
|
<PUTB .TBL .OFFS 0>
|
|
|
|
|
<RETURN>)
|
|
|
|
|
(T
|
|
|
|
|
<PUTB .TBL .OFFS <GETB ,P-INBUF <+ .OFFS 1>>>)>
|
|
|
|
|
<SET OFFS <+ .OFFS 1>>>
|
|
|
|
|
<RTRUE>>
|
|
|
|
|
|
|
|
|
|
;<ROUTINE RESTORE-INPUT (TBL "AUX" CHR)
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<COND (<EQUAL? <SET CHR <GETB .TBL 0>> 0>
|
|
|
|
|
<RETURN>)
|
|
|
|
|
(T
|
|
|
|
|
<PRINTC .CHR>
|
|
|
|
|
<SET TBL <REST .TBL>>)>>>
|
|
|
|
|
|
|
|
|
|
<GLOBAL P-MULT <>>
|
|
|
|
|
|
|
|
|
|
<GLOBAL P-NOT-HERE 0>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<GLOBAL WHAT-DO-YOU-WANT-TO "What do you want to ">
|
|
|
|
|
|
|
|
|
|
<ROUTINE FAKE-ORPHAN ("AUX" TMP)
|
|
|
|
|
<ORPHAN ,P-SYNTAX <>>
|
|
|
|
|
<TELL ,WHAT-DO-YOU-WANT-TO>
|
|
|
|
|
<SET TMP <GET ,P-OTBL ,P-VERBN>>
|
|
|
|
|
<COND (<EQUAL? .TMP 0>
|
|
|
|
|
<TELL "tell">)
|
|
|
|
|
(<ZERO? <GETB ,P-VTBL 2>>
|
|
|
|
|
<PRINTB <GET .TMP 0>>)
|
|
|
|
|
(T
|
|
|
|
|
<WORD-PRINT <GETB .TMP 2> <GETB .TMP 3>>
|
|
|
|
|
<PUTB ,P-VTBL 2 0>)>
|
|
|
|
|
<SETG P-OFLAG T>
|
|
|
|
|
<SETG P-WON <>>
|
|
|
|
|
<PREP-PRINT
|
|
|
|
|
<GETB ,P-SYNTAX ,P-SPREP1>>
|
|
|
|
|
<TELL "?" CR>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" (V <>) OA OO OI CNT)
|
|
|
|
|
<SETG PERFORM-DEPTH <+ ,PERFORM-DEPTH 1>>
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<COND (,ZDEBUG
|
|
|
|
|
<TELL "[Perform: ">
|
|
|
|
|
%<COND (<GASSIGNED? ZILCH> '<TELL N .A>)
|
|
|
|
|
(T '<PRINT <SPNAME <NTH ,ACTIONS <+ <* .A 2> 1>>>>)>
|
|
|
|
|
<COND (.O
|
|
|
|
|
<COND (<AND <EQUAL? .A ,V?WALK>
|
|
|
|
|
,P-WALK-DIR>
|
|
|
|
|
<TELL "/" N .O>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<TELL "/" D .O>)>)>
|
|
|
|
|
<COND (.I <TELL "/" D .I>)>
|
|
|
|
|
<TELL "]" CR>)>>
|
|
|
|
|
<SET OA ,PRSA>
|
|
|
|
|
<SET OO ,PRSO>
|
|
|
|
|
<SET OI ,PRSI>
|
|
|
|
|
<SETG PRSA .A>
|
|
|
|
|
<COND (<EQUAL? ,IT .I .O>
|
|
|
|
|
<COND (<NOT .I>
|
|
|
|
|
<FAKE-ORPHAN>)
|
|
|
|
|
(T
|
|
|
|
|
<TELL ,REFERRING CR>)>
|
|
|
|
|
<RFATAL>)>
|
|
|
|
|
<COND (<AND .I
|
|
|
|
|
<NOT <VERB? WALK>>
|
|
|
|
|
<NOT <EQUAL? .I ,NOT-HERE-OBJECT>>>
|
|
|
|
|
<THIS-IS-IT .I>)>
|
|
|
|
|
<COND (<AND .O
|
|
|
|
|
<NOT <VERB? WALK>>
|
|
|
|
|
<NOT <EQUAL? .O ,NOT-HERE-OBJECT>>>
|
|
|
|
|
<THIS-IS-IT .O>)>
|
|
|
|
|
<SETG PRSO .O>
|
|
|
|
|
<SETG PRSI .I>
|
|
|
|
|
<COND (<AND <NOT <EQUAL? .A ,V?WALK>>
|
|
|
|
|
<EQUAL? ,NOT-HERE-OBJECT ,PRSO ,PRSI>
|
|
|
|
|
<SET V
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<D-APPLY "Not Here" ,NOT-HERE-OBJECT-F>
|
|
|
|
|
<APPLY ,NOT-HERE-OBJECT-F>>>>
|
|
|
|
|
;<SETG P-WON <>>)
|
|
|
|
|
(T
|
|
|
|
|
<SET O ,PRSO>
|
|
|
|
|
<SET I ,PRSI>
|
|
|
|
|
<COND (<AND <NOT <VERB? TELL-ABOUT SGIVE SSHOW SRUB SPUT-ON>>
|
|
|
|
|
<SET V
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<DD-APPLY "Actor" ,WINNER
|
|
|
|
|
<GETP ,WINNER ,P?ACTION>>
|
|
|
|
|
<APPLY <GETP ,WINNER ,P?ACTION>>>>>)
|
|
|
|
|
(<AND <LOC ,WINNER>
|
|
|
|
|
<NOT <EQUAL? <LOC ,WINNER> ,HERE>>
|
|
|
|
|
<SET V
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<D-APPLY "Begin"
|
|
|
|
|
<GETP <LOC ,WINNER> ,P?ACTION>
|
|
|
|
|
,M-BEG>
|
|
|
|
|
<APPLY <GETP <LOC ,WINNER> ,P?ACTION>
|
|
|
|
|
,M-BEG>>>>)
|
|
|
|
|
(<SET V
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<D-APPLY "Begin"
|
|
|
|
|
<GETP ,HERE ,P?ACTION>
|
|
|
|
|
,M-BEG>
|
|
|
|
|
<APPLY <GETP ,HERE ,P?ACTION>
|
|
|
|
|
,M-BEG>>>)
|
|
|
|
|
(<SET V
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<D-APPLY "Preaction"
|
|
|
|
|
<GET ,PREACTIONS .A>>
|
|
|
|
|
<APPLY <GET ,PREACTIONS .A>>>>)
|
|
|
|
|
(<AND .I
|
|
|
|
|
<SET V
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<D-APPLY "PRSI" <GETP .I ,P?ACTION>>
|
|
|
|
|
<APPLY <GETP .I ,P?ACTION>>>>>)
|
|
|
|
|
(<AND .O
|
|
|
|
|
<NOT <EQUAL? .A ,V?WALK>>
|
|
|
|
|
<LOC .O>
|
|
|
|
|
<GETP <LOC .O> ,P?CONTFCN>
|
|
|
|
|
<SET V
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<D-APPLY "Container"
|
|
|
|
|
<GETP <LOC .O> ,P?CONTFCN>
|
|
|
|
|
,M-CONTAINER>
|
|
|
|
|
<APPLY <GETP <LOC .O> ,P?CONTFCN>
|
|
|
|
|
,M-CONTAINER>>>>)
|
|
|
|
|
(<AND .O
|
|
|
|
|
<NOT <EQUAL? .A ,V?WALK>>
|
|
|
|
|
<SET V
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<D-APPLY "PRSO"
|
|
|
|
|
<GETP .O ,P?ACTION>>
|
|
|
|
|
<APPLY <GETP .O ,P?ACTION>>>>>)
|
|
|
|
|
(<SET V
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<D-APPLY <>
|
|
|
|
|
<GET ,ACTIONS .A>>
|
|
|
|
|
<APPLY <GET ,ACTIONS .A>>>>)>)>
|
|
|
|
|
<SETG PRSA .OA>
|
|
|
|
|
<SETG PRSO .OO>
|
|
|
|
|
<SETG PRSI .OI>
|
|
|
|
|
.V>
|
|
|
|
|
|
|
|
|
|
%<COND (,ZDEBUGGING?
|
|
|
|
|
<COND (<GASSIGNED? ZILCH>
|
|
|
|
|
<ROUTINE II-APPLY (STR FCN)
|
|
|
|
|
<COND (,ZDEBUG
|
|
|
|
|
<TELL "[I- " N <* .FCN 2> " ">)>
|
|
|
|
|
<D-APPLY .STR .FCN>>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<ROUTINE II-APPLY (STR FCN)
|
|
|
|
|
<D-APPLY <COND (<TYPE? .FCN ATOM> <SPNAME .FCN>)
|
|
|
|
|
(ELSE .STR)>
|
|
|
|
|
.FCN>>)>)>
|
|
|
|
|
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<ROUTINE DD-APPLY (STR OBJ FCN)
|
|
|
|
|
<COND (,ZDEBUG <TELL "[" D .OBJ "=]">)>
|
|
|
|
|
<D-APPLY .STR .FCN>>>
|
|
|
|
|
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<ROUTINE D-APPLY (STR FCN "OPTIONAL" (FOO <>) "AUX" RES)
|
|
|
|
|
<COND (<NOT .FCN> <>)
|
|
|
|
|
(T
|
|
|
|
|
<COND (,ZDEBUG
|
|
|
|
|
<COND (<NOT .STR>
|
|
|
|
|
<TELL "[Action:]" CR>)
|
|
|
|
|
(T <TELL "[" .STR ": ">)>)>
|
|
|
|
|
<SET RES
|
|
|
|
|
<COND (.FOO <APPLY .FCN .FOO>)
|
|
|
|
|
(T <APPLY .FCN>)>>
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<COND (<AND ,ZDEBUG .STR>
|
|
|
|
|
<COND (<EQUAL? .RES ,M-FATAL>
|
|
|
|
|
<TELL "Fatal]" CR>)
|
|
|
|
|
(<NOT .RES>
|
|
|
|
|
<TELL "Not handled]" CR>)
|
|
|
|
|
(T <TELL "Handled]" CR>)>)>>
|
|
|
|
|
.RES)>>>
|
|
|
|
|
|
|
|
|
|
;"former CLOCK.ZIL stuff"
|
|
|
|
|
|
|
|
|
|
<GLOBAL CLOCK-WAIT <>>
|
|
|
|
|
|
|
|
|
|
<GLOBAL C-TABLE <ITABLE 13 <> <>>>
|
|
|
|
|
|
|
|
|
|
<CONSTANT C-INTLEN 4> ;"length of an interrupt entry in bytes"
|
|
|
|
|
<CONSTANT C-RTN 0> ;"word offset of routine name"
|
|
|
|
|
<CONSTANT C-TICK 1> ;"word offset of count"
|
|
|
|
|
|
|
|
|
|
<CONSTANT C-TABLELEN 52> ;"length of interrupt table in bytes"
|
|
|
|
|
<GLOBAL C-INTS 52> ;"start of queued interrupts in bytes"
|
|
|
|
|
%<DEBUG-CODE <GLOBAL C-MAXINTS 52>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE DEQUEUE (RTN "AUX" TIM)
|
|
|
|
|
<COND (<SET RTN <QUEUED? .RTN>>
|
|
|
|
|
<SET TIM <GET .RTN ,C-TICK>>
|
|
|
|
|
<PUT .RTN ,C-RTN 0>
|
|
|
|
|
.TIM)>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE QUEUED? (RTN "AUX" C E)
|
|
|
|
|
<SET E <REST ,C-TABLE ,C-TABLELEN>>
|
|
|
|
|
<SET C <REST ,C-TABLE ,C-INTS>>
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<COND (<EQUAL? .C .E> <RFALSE>)
|
|
|
|
|
(<EQUAL? <GET .C ,C-RTN> .RTN>
|
|
|
|
|
<COND (<ZERO? <GET .C ,C-TICK>>
|
|
|
|
|
<RFALSE>)
|
|
|
|
|
(T <RETURN .C>)>)>
|
|
|
|
|
<SET C <REST .C ,C-INTLEN>>>>
|
|
|
|
|
|
|
|
|
|
"this version of QUEUE automatically enables as well"
|
|
|
|
|
|
|
|
|
|
"QUEUE routine when fresh?:t means only queue if not currently queued"
|
|
|
|
|
|
|
|
|
|
<ROUTINE QUEUE (RTN TICK "OPT" (I? <>) "AUX" C E (INT <>))
|
|
|
|
|
<SET E <REST ,C-TABLE ,C-TABLELEN>>
|
|
|
|
|
<SET C <REST ,C-TABLE ,C-INTS>>
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<COND (<EQUAL? .C .E>
|
|
|
|
|
<COND (.INT
|
|
|
|
|
<SET C .INT>)
|
|
|
|
|
(ELSE
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<COND (<L? ,C-INTS ,C-INTLEN>
|
|
|
|
|
<TELL
|
|
|
|
|
"[**Too many interrupts!**]" CR>)>>
|
|
|
|
|
<SETG C-INTS <- ,C-INTS ,C-INTLEN>>
|
|
|
|
|
%<DEBUG-CODE
|
|
|
|
|
<COND (<L? ,C-INTS ,C-MAXINTS>
|
|
|
|
|
<SETG C-MAXINTS ,C-INTS>)>>
|
|
|
|
|
<SET INT <REST ,C-TABLE ,C-INTS>>)>
|
|
|
|
|
<PUT .INT ,C-RTN .RTN>
|
|
|
|
|
<RETURN>)
|
|
|
|
|
(<EQUAL? <GET .C ,C-RTN> .RTN>
|
|
|
|
|
<COND (.I? <RFALSE>)
|
|
|
|
|
(ELSE
|
|
|
|
|
<SET INT .C>
|
|
|
|
|
<RETURN>)>)
|
|
|
|
|
(<ZERO? <GET .C ,C-RTN>>
|
|
|
|
|
<SET INT .C>)>
|
|
|
|
|
<SET C <REST .C ,C-INTLEN>>>
|
|
|
|
|
<COND (%<COND (<GASSIGNED? ZILCH>
|
|
|
|
|
'<G? .INT ,CLOCK-HAND>)
|
|
|
|
|
(ELSE
|
|
|
|
|
'<L=? <LENGTH .INT> <LENGTH ,CLOCK-HAND>>)>
|
|
|
|
|
<SET TICK <- <+ .TICK 3>>>)>
|
|
|
|
|
<PUT .INT ,C-TICK .TICK>
|
|
|
|
|
.INT>
|
|
|
|
|
|
|
|
|
|
<GLOBAL CLOCK-HAND <>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE CLOCKER ("AUX" E TICK RTN (FLG <>) (Q? <>) OWINNER)
|
|
|
|
|
<COND (,CLOCK-WAIT <SETG CLOCK-WAIT <>> <RFALSE>)>
|
|
|
|
|
<SETG CLOCK-HAND <REST ,C-TABLE ,C-INTS>>
|
|
|
|
|
<SET E <REST ,C-TABLE ,C-TABLELEN>>
|
|
|
|
|
<SET OWINNER ,WINNER>
|
|
|
|
|
<SETG WINNER ,PLAYER>
|
|
|
|
|
<REPEAT ()
|
|
|
|
|
<COND (<EQUAL? ,CLOCK-HAND .E>
|
|
|
|
|
<SETG CLOCK-HAND .E>
|
|
|
|
|
<SETG MOVES <+ ,MOVES 1>>
|
|
|
|
|
<SETG WINNER .OWINNER>
|
|
|
|
|
<RETURN .FLG>)
|
|
|
|
|
(<NOT <ZERO? <GET ,CLOCK-HAND ,C-RTN>>>
|
|
|
|
|
<SET TICK <GET ,CLOCK-HAND ,C-TICK>>
|
|
|
|
|
<COND (<L? .TICK -1>
|
|
|
|
|
<PUT ,CLOCK-HAND ,C-TICK <- <- .TICK> 3>>
|
|
|
|
|
<SET Q? ,CLOCK-HAND>)
|
|
|
|
|
(<NOT <ZERO? .TICK>>
|
|
|
|
|
<COND (<G? .TICK 0>
|
|
|
|
|
<SET TICK <- .TICK 1>>
|
|
|
|
|
<PUT ,CLOCK-HAND ,C-TICK .TICK>)>
|
|
|
|
|
<COND (<NOT <ZERO? .TICK>>
|
|
|
|
|
<SET Q? ,CLOCK-HAND>)>
|
|
|
|
|
<COND (<NOT <G? .TICK 0>>
|
|
|
|
|
<SET RTN
|
|
|
|
|
%<COND (<GASSIGNED? ZILCH>
|
|
|
|
|
'<GET ,CLOCK-HAND ,C-RTN>)
|
|
|
|
|
(ELSE
|
|
|
|
|
'<NTH ,CLOCK-HAND
|
|
|
|
|
<+ <* ,C-RTN 2>
|
|
|
|
|
1>>)>>
|
|
|
|
|
<COND (<ZERO? .TICK>
|
|
|
|
|
<PUT ,CLOCK-HAND ,C-RTN 0>)>
|
|
|
|
|
<COND (%<COND
|
|
|
|
|
(,ZDEBUGGING?
|
|
|
|
|
'<II-APPLY "Int" .RTN>)
|
|
|
|
|
(ELSE
|
|
|
|
|
'<APPLY .RTN>)>
|
|
|
|
|
<SET FLG T>)>
|
|
|
|
|
<COND (<AND <NOT .Q?>
|
|
|
|
|
<NOT
|
|
|
|
|
<ZERO?
|
|
|
|
|
<GET ,CLOCK-HAND
|
|
|
|
|
,C-RTN>>>>
|
|
|
|
|
<SET Q? T>)>)>)>)>
|
|
|
|
|
<SETG CLOCK-HAND <REST ,CLOCK-HAND ,C-INTLEN>>
|
|
|
|
|
<COND (<NOT .Q?>
|
|
|
|
|
<SETG C-INTS <+ ,C-INTS ,C-INTLEN>>)>>>
|
|
|
|
|
|
|
|
|
|
<DEFINE PSEUDO ("TUPLE" V)
|
|
|
|
|
<MAPF ,PLTABLE
|
|
|
|
|
<FUNCTION (OBJ)
|
|
|
|
|
<COND (<N==? <LENGTH .OBJ> 3>
|
|
|
|
|
<ERROR BAD-THING .OBJ>)>
|
|
|
|
|
<MAPRET <COND (<NTH .OBJ 1>
|
|
|
|
|
<VOC <SPNAME <NTH .OBJ 1>> ADJECTIVE>)>
|
|
|
|
|
<COND (<NTH .OBJ 2>
|
|
|
|
|
<VOC <SPNAME <NTH .OBJ 2>> NOUN>)>
|
|
|
|
|
;<3 .OBJ>>>
|
|
|
|
|
.V>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE PERFORM-PRSA ("OPT" (O <>) (I <>))
|
|
|
|
|
<PERFORM ,PRSA .O .I>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE NEW-VERB (V)
|
|
|
|
|
<PERFORM .V ,PRSO ,PRSI>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE SWAP-VERB (V)
|
|
|
|
|
<PERFORM .V ,PRSI ,PRSO>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE NEW-PRSO (O)
|
|
|
|
|
<PERFORM-PRSA .O ,PRSI>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE NEW-PRSI (I)
|
|
|
|
|
<PERFORM-PRSA ,PRSO .I>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE NEW-WINNER-PRSO (A "OPT" (O <>) (I <>) "AUX" OW)
|
|
|
|
|
<SET OW ,WINNER>
|
|
|
|
|
<SETG WINNER ,PRSO>
|
|
|
|
|
<PERFORM .A .O .I>
|
|
|
|
|
<SETG WINNER .OW>>
|
|
|
|
|
|
|
|
|
|
<ROUTINE REDIRECT (FROM TO "AUX" O I)
|
|
|
|
|
<SET O <COND (<PRSO? .FROM> .TO) (ELSE ,PRSO)>>
|
|
|
|
|
<SET I <COND (<PRSI? .FROM> .TO) (ELSE ,PRSI)>>
|
|
|
|
|
<PERFORM-PRSA .O .I>
|
|
|
|
|
<RTRUE>>
|