510 lines
13 KiB
Plaintext
510 lines
13 KiB
Plaintext
"MISC for
|
||
Mini-Zork '87
|
||
(c) Copyright 1987 Infocom, Inc. All Rights Reserved"
|
||
|
||
<SETG C-ENABLED? 0>
|
||
<SETG C-ENABLED 1>
|
||
<SETG C-DISABLED 0>
|
||
|
||
<DEFMAC TELL ("ARGS" A)
|
||
<FORM PROG ()
|
||
!<MAPF ,LIST
|
||
<FUNCTION ("AUX" E P O)
|
||
<COND (<EMPTY? .A> <MAPSTOP>)
|
||
(<SET E <NTH .A 1>>
|
||
<SET A <REST .A>>)>
|
||
<COND (<TYPE? .E ATOM>
|
||
<COND (<OR <=? <SET P <SPNAME .E>>
|
||
"CRLF">
|
||
<=? .P "CR">>
|
||
<MAPRET '<CRLF>>)
|
||
(<EMPTY? .A>
|
||
<ERROR INDICATOR-AT-END? .E>)
|
||
(ELSE
|
||
<SET O <NTH .A 1>>
|
||
<SET A <REST .A>>
|
||
<COND (<OR <=? <SET P <SPNAME .E>>
|
||
"DESC">
|
||
<=? .P "D">
|
||
<=? .P "OBJ">
|
||
<=? .P "O">>
|
||
<MAPRET <FORM PRINTD .O>>)
|
||
(<OR <=? .P "A">
|
||
<=? .P "AN">>
|
||
<MAPRET <FORM PRINTA .O>>)
|
||
(<OR <=? .P "NUM">
|
||
<=? .P "N">>
|
||
<MAPRET <FORM PRINTN .O>>)
|
||
(<OR <=? .P "CHAR">
|
||
<=? .P "CHR">
|
||
<=? .P "C">>
|
||
<MAPRET <FORM PRINTC .O>>)
|
||
(ELSE
|
||
<MAPRET
|
||
<FORM PRINT
|
||
<FORM GETP .O .E>>>)>)>)
|
||
(<TYPE? .E STRING ZSTRING>
|
||
<MAPRET <FORM PRINTI .E>>)
|
||
(<TYPE? .E FORM LVAL GVAL>
|
||
<MAPRET <FORM PRINT .E>>)
|
||
(ELSE <ERROR UNKNOWN-TYPE .E>)>>>>>
|
||
|
||
;<ROUTINE PRINTA (O)
|
||
<TELL "a " D .O>>
|
||
|
||
<DEFMAC VERB? ("ARGS" ATMS)
|
||
<MULTIFROB PRSA .ATMS>>
|
||
|
||
<DEFMAC PRSO? ("ARGS" ATMS)
|
||
<MULTIFROB PRSO .ATMS>>
|
||
|
||
<DEFMAC PRSI? ("ARGS" ATMS)
|
||
<MULTIFROB PRSI .ATMS>>
|
||
|
||
<DEFMAC ROOM? ("ARGS" ATMS)
|
||
<MULTIFROB HERE .ATMS>>
|
||
|
||
<DEFINE MULTIFROB (X ATMS "AUX" (OO (OR)) (O .OO) (L ()) ATM)
|
||
<REPEAT ()
|
||
<COND (<EMPTY? .ATMS>
|
||
<RETURN!- <COND (<LENGTH? .OO 1> <ERROR .X>)
|
||
(<LENGTH? .OO 2> <NTH .OO 2>)
|
||
(ELSE <CHTYPE .OO FORM>)>>)>
|
||
<REPEAT ()
|
||
<COND (<EMPTY? .ATMS> <RETURN!->)>
|
||
<SET ATM <NTH .ATMS 1>>
|
||
<SET L
|
||
(<COND (<TYPE? .ATM ATOM>
|
||
<FORM GVAL
|
||
<COND (<==? .X PRSA>
|
||
<PARSE
|
||
<STRING "V?"
|
||
<SPNAME .ATM>>>)
|
||
(ELSE .ATM)>>)
|
||
(ELSE .ATM)>
|
||
!.L)>
|
||
<SET ATMS <REST .ATMS>>
|
||
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
|
||
<SET O <REST <PUTREST .O (<FORM EQUAL? <FORM GVAL .X> !.L>)>>>
|
||
<SET L ()>>>
|
||
|
||
<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" (O ()) ATM)
|
||
<REPEAT ()
|
||
<COND (<EMPTY? .ATMS>
|
||
<RETURN!- <COND (<LENGTH? .O 1> <NTH .O 1>)
|
||
(<==? .X FSET?> <FORM OR !.O>)
|
||
(ELSE <FORM PROG () !.O>)>>)>
|
||
<SET ATM <NTH .ATMS 1>>
|
||
<SET ATMS <REST .ATMS>>
|
||
<SET O
|
||
(<FORM .X
|
||
.OBJ
|
||
<COND (<TYPE? .ATM FORM> .ATM)
|
||
(ELSE <FORM GVAL .ATM>)>>
|
||
!.O)>>>
|
||
|
||
<DEFMAC RFATAL ()
|
||
'<PROG () <PUSH 2> <RSTACK>>>
|
||
|
||
<DEFMAC PROB ('BASE? "OPTIONAL" 'LOSER?)
|
||
<COND (<ASSIGNED? LOSER?> <FORM ZPROB .BASE?>)
|
||
(ELSE <FORM G? .BASE? '<RANDOM 100>>)>>
|
||
|
||
<ROUTINE ZPROB
|
||
(BASE)
|
||
<COND (,LUCKY <G? .BASE <RANDOM 100>>)
|
||
(ELSE <G? .BASE <RANDOM 300>>)>>
|
||
|
||
<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>
|
||
|
||
<DEFMAC ENABLE ('INT) <FORM PUT .INT ,C-ENABLED? 1>>
|
||
|
||
<DEFMAC DISABLE ('INT) <FORM PUT .INT ,C-ENABLED? 0>>
|
||
|
||
<DEFMAC FLAMING? ('OBJ)
|
||
<FORM AND <FORM FSET? .OBJ ',FLAMEBIT>
|
||
<FORM FSET? .OBJ ',ONBIT>>>
|
||
|
||
<DEFMAC OPENABLE? ('OBJ)
|
||
<FORM OR <FORM FSET? .OBJ ',DOORBIT>
|
||
<FORM FSET? .OBJ ',CONTBIT>>>
|
||
|
||
<DEFMAC ABS ('NUM)
|
||
<FORM COND (<FORM L? .NUM 0> <FORM - 0 .NUM>)
|
||
(T .NUM)>>
|
||
\
|
||
; "taa 11/7/87 Macro to return number of objects needed by syntax
|
||
in compact format"
|
||
<DEFMAC P-SONUMS ('SYN)
|
||
<FORM / <FORM GETB .SYN ',P-SPREP1> 64>>
|
||
|
||
\
|
||
;"former MAIN stuff"
|
||
|
||
<CONSTANT SERIAL 0>
|
||
|
||
<GLOBAL P-WON <>>
|
||
|
||
<CONSTANT M-FATAL 2>
|
||
<CONSTANT M-HANDLED 1>
|
||
<CONSTANT M-NOT-HANDLED <>>
|
||
<CONSTANT M-OBJECT <>>
|
||
|
||
<CONSTANT M-BEG 1>
|
||
<CONSTANT M-ENTER 2>
|
||
<CONSTANT M-LOOK 3>
|
||
<CONSTANT M-OBJDESC 5>
|
||
<CONSTANT M-END 6>
|
||
|
||
<ROUTINE GO ()
|
||
<ENABLE <QUEUE I-THIEF -1>>
|
||
<QUEUE I-CANDLES 40>
|
||
<QUEUE I-LANTERN 150>
|
||
<SETG HERE ,WEST-OF-HOUSE>
|
||
<SETG P-IT-OBJECT ,MAILBOX>
|
||
<SETG LIT T>
|
||
<SETG WINNER ,ADVENTURER>
|
||
<MOVE ,WINNER ,HERE>
|
||
<V-VERSION>
|
||
<CRLF>
|
||
<V-LOOK>
|
||
<MAIN-LOOP>
|
||
<AGAIN>>
|
||
|
||
<ROUTINE MAIN-LOOP ("AUX" TRASH)
|
||
<REPEAT ()
|
||
<SET TRASH <MAIN-LOOP-1>>>>
|
||
|
||
<ROUTINE MAIN-LOOP-1 ("AUX" ICNT OCNT NUM CNT OBJ TBL V PTBL OBJ1 TMP O I)
|
||
<SET CNT 0>
|
||
<SET OBJ <>>
|
||
<SET PTBL T>
|
||
<COND (<SETG P-WON <PARSER>>
|
||
<SET ICNT <GET ,P-PRSI ,P-MATCHLEN>>
|
||
<SET OCNT <GET ,P-PRSO ,P-MATCHLEN>>
|
||
<COND (<AND ,P-IT-OBJECT <ACCESSIBLE? ,P-IT-OBJECT>>
|
||
<SET TMP <>>
|
||
<REPEAT ()
|
||
<COND (<G? <SET CNT <+ .CNT 1>> .ICNT>
|
||
<RETURN>)
|
||
(T
|
||
<COND (<EQUAL? <GET ,P-PRSI .CNT> ,IT>
|
||
<PUT ,P-PRSI .CNT ,P-IT-OBJECT>
|
||
<SET TMP T>
|
||
<RETURN>)>)>>
|
||
<COND (<NOT .TMP>
|
||
<SET CNT 0>
|
||
<REPEAT ()
|
||
<COND (<G? <SET CNT <+ .CNT 1>> .OCNT>
|
||
<RETURN>)
|
||
(T
|
||
<COND (<EQUAL? <GET ,P-PRSO .CNT> ,IT>
|
||
<PUT ,P-PRSO .CNT ,P-IT-OBJECT>
|
||
<RETURN>)>)>>)>
|
||
<SET CNT 0>)>
|
||
<SET NUM
|
||
<COND (<0? .OCNT> .OCNT)
|
||
(<G? .OCNT 1>
|
||
<SET TBL ,P-PRSO>
|
||
<COND (<0? .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>>)>
|
||
<COND (<AND <==? ,PRSA ,V?WALK>
|
||
<NOT <ZERO? ,P-WALK-DIR>>>
|
||
<SET V <PERFORM ,PRSA ,PRSO>>)
|
||
(<0? .NUM>
|
||
<COND (<0? <P-SONUMS ,P-SYNTAX>
|
||
;<BAND <GETB ,P-SYNTAX ,P-SBITS> ,P-SONUMS>>
|
||
<SET V <PERFORM ,PRSA>>
|
||
<SETG PRSO <>>)
|
||
(<NOT ,LIT>
|
||
<TELL ,TOO-DARK>)
|
||
(T
|
||
<TELL ,REFERRING>
|
||
<SET V <>>)>)
|
||
(T
|
||
<SETG P-NOT-HERE 0>
|
||
<SETG P-MULT <>>
|
||
<COND (<G? .NUM 1> <SETG P-MULT T>)>
|
||
<SET TMP <>>
|
||
<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
|
||
,THERES-NOTHING "here you can take." CR>)>
|
||
<RETURN>)
|
||
(T
|
||
<COND (.PTBL <SET OBJ1 <GET ,P-PRSO .CNT>>)
|
||
(T <SET OBJ1 <GET ,P-PRSI .CNT>>)>
|
||
<SET O <COND (.PTBL .OBJ1) (T .OBJ)>>
|
||
<SET I <COND (.PTBL .OBJ) (T .OBJ1)>>
|
||
|
||
;"multiple exceptions"
|
||
<COND (<OR <G? .NUM 1>
|
||
<EQUAL? <GET <GET ,P-ITBL ,P-NC1> 0> ,W?ALL>>
|
||
<SET V <LOC ,WINNER>>
|
||
<COND (<EQUAL? .O ,NOT-HERE-OBJECT>
|
||
<SETG P-NOT-HERE <+ ,P-NOT-HERE 1>>
|
||
<AGAIN>)
|
||
(<AND <VERB? TAKE>
|
||
.I
|
||
<EQUAL? <GET <GET ,P-ITBL ,P-NC1> 0> ,W?ALL>
|
||
<NOT <IN? .O .I>>>
|
||
<AGAIN>)
|
||
(<AND <EQUAL? ,P-GETFLAGS ,P-ALL>
|
||
<VERB? TAKE>
|
||
<OR <AND <NOT <EQUAL? <LOC .O> ,WINNER ,HERE .V>>
|
||
<NOT <EQUAL? <LOC .O> .I>>
|
||
<NOT <FSET? <LOC .O> ,SURFACEBIT>>>
|
||
<NOT <OR <FSET? .O ,TAKEBIT>
|
||
<FSET? .O ,TRYTAKEBIT>>>>>
|
||
<AGAIN>)
|
||
(ELSE
|
||
<COND (<EQUAL? .OBJ1 ,IT>
|
||
<PRINTD ,P-IT-OBJECT>)
|
||
(T <PRINTD .OBJ1>)>
|
||
<TELL ": ">)>)>
|
||
;"end multiple exceptions"
|
||
<SETG PRSO .O>
|
||
<SETG PRSI .I>
|
||
<SET TMP T>
|
||
<SET V <PERFORM ,PRSA ,PRSO ,PRSI>>
|
||
<COND (<==? .V ,M-FATAL> <RETURN>)>)>>)>
|
||
<COND (<NOT <==? .V ,M-FATAL>>
|
||
;<COND (<==? <LOC ,WINNER> ,PRSO>
|
||
<SETG PRSO <>>)>
|
||
<SET V <APPLY <GETP <LOC ,WINNER> ,P?ACTION> ,M-END>>)>
|
||
;<COND (<VERB? ;AGAIN ;"WALK -- why was this here?"
|
||
SAVE RESTORE ;SCORE ;VERSION ;WAIT> T)
|
||
(T
|
||
<SETG L-PRSA ,PRSA>
|
||
<SETG L-PRSO ,PRSO>
|
||
<SETG L-PRSI ,PRSI>)>
|
||
<COND (<==? .V ,M-FATAL> <SETG P-CONT <>>)>)
|
||
(T
|
||
<SETG P-CONT <>>)>
|
||
<COND (,P-WON
|
||
<COND (<VERB? TELL BRIEF SUPER-BRIEF VERBOSE SAVE VERSION
|
||
QUIT RESTART SCORE SCRIPT UNSCRIPT RESTORE> T)
|
||
(T <SET V <CLOCKER>>)>)>>
|
||
|
||
<GLOBAL P-MULT <>>
|
||
|
||
<GLOBAL P-NOT-HERE 0>
|
||
\
|
||
%<COND (<GASSIGNED? PREDGEN>
|
||
|
||
'<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" V OA OO OI)
|
||
;<COND (,DEBUG
|
||
<TELL "[Perform: ">
|
||
%<COND (<GASSIGNED? PREDGEN> '<TELL N .A>)
|
||
(T '<PRINC <NTH ,ACTIONS <+ <* .A 2> 1>>>)>
|
||
<COND (<AND .O <NOT <==? .A ,V?WALK>>>
|
||
<TELL "/" D .O>)>
|
||
<COND (.I <TELL "/" D .I>)>
|
||
<TELL "]" CR>)>
|
||
<SET OA ,PRSA>
|
||
<SET OO ,PRSO>
|
||
<SET OI ,PRSI>
|
||
<COND (<AND <EQUAL? ,IT .I .O>
|
||
<NOT <ACCESSIBLE? ,P-IT-OBJECT>>>
|
||
<TELL ,REFERRING>
|
||
<RFATAL>)>
|
||
<COND (<==? .O ,IT> <SET O ,P-IT-OBJECT>)>
|
||
<COND (<==? .I ,IT> <SET I ,P-IT-OBJECT>)>
|
||
<SETG PRSA .A>
|
||
<SETG PRSO .O>
|
||
<COND (<AND ,PRSO <NOT <EQUAL? ,PRSI ,IT>> <NOT <VERB? WALK>>>
|
||
<SETG P-IT-OBJECT ,PRSO>)>
|
||
<SETG PRSI .I>
|
||
<COND (<AND <EQUAL? ,NOT-HERE-OBJECT ,PRSO ,PRSI>
|
||
<SET V <NOT-HERE-OBJECT-F>>> .V)
|
||
(T
|
||
<SET O ,PRSO>
|
||
<SET I ,PRSI>
|
||
<COND
|
||
(<SET V <APPLY <GETP ,WINNER ,P?ACTION>>> .V)
|
||
(<SET V <APPLY <GETP <LOC ,WINNER> ,P?ACTION> ,M-BEG>> .V)
|
||
(<SET V <APPLY <GET ,PREACTIONS .A>>> .V)
|
||
(<AND .I <SET V <APPLY <GETP .I ,P?ACTION>>>> .V)
|
||
(<AND .O
|
||
<NOT <==? .A ,V?WALK>>
|
||
<SET V <APPLY <GETP .O ,P?ACTION>>>>
|
||
.V)
|
||
(<SET V <APPLY <GET ,ACTIONS .A>>> .V)>)>
|
||
<SETG PRSA .OA>
|
||
<SETG PRSO .OO>
|
||
<SETG PRSI .OI>
|
||
.V>)
|
||
(T
|
||
|
||
'<PROG ()
|
||
|
||
<SETG DEBUG <>>
|
||
|
||
<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" V OA OO OI)
|
||
<COND (,DEBUG
|
||
<TELL "** PERFORM: PRSA = ">
|
||
<PRINC <NTH ,ACTIONS <+ <* .A 2> 1>>>
|
||
<COND (<AND .O <NOT <==? .A ,V?WALK>>>
|
||
<TELL " | PRSO = " D .O>)>
|
||
<COND (.I <TELL " | PRSI = " D .I>)>)>
|
||
<SET OA ,PRSA>
|
||
<SET OO ,PRSO>
|
||
<SET OI ,PRSI>
|
||
<COND (<AND <EQUAL? ,IT .I .O>
|
||
<OR <NOT ,P-IT-OBJECT>
|
||
<NOT <ACCESSIBLE? ,P-IT-OBJECT>>>>
|
||
<TELL ,REFERRING>
|
||
<RFATAL>)>
|
||
<COND (<==? .O ,IT> <SET O ,P-IT-OBJECT>)>
|
||
<COND (<==? .I ,IT> <SET I ,P-IT-OBJECT>)>
|
||
<SETG PRSA .A>
|
||
<SETG PRSO .O>
|
||
<COND (<AND ,PRSO <NOT <VERB? WALK>>>
|
||
<SETG P-IT-OBJECT ,PRSO>)>
|
||
<SETG PRSI .I>
|
||
<COND (<AND <EQUAL? ,NOT-HERE-OBJECT ,PRSO ,PRSI>
|
||
<SET V <D-APPLY "Not Here" ,NOT-HERE-OBJECT-F>>> .V)
|
||
(T
|
||
<SET O ,PRSO>
|
||
<SET I ,PRSI>
|
||
<COND (<SET V <DD-APPLY "Actor" ,WINNER
|
||
<GETP ,WINNER ,P?ACTION>>> .V)
|
||
(<SET V <D-APPLY "Room (M-BEG)"
|
||
<GETP <LOC ,WINNER> ,P?ACTION>
|
||
,M-BEG>> .V)
|
||
(<SET V <D-APPLY "Preaction"
|
||
<GET ,PREACTIONS .A>>> .V)
|
||
(<AND .I <SET V <D-APPLY "PRSI"
|
||
<GETP .I ,P?ACTION>>>> .V)
|
||
(<AND .O
|
||
<NOT <==? .A ,V?WALK>>
|
||
<SET V <D-APPLY "PRSO"
|
||
<GETP .O ,P?ACTION>>>>
|
||
.V)
|
||
(<SET V <D-APPLY <>
|
||
<GET ,ACTIONS .A>>> .V)>)>
|
||
<SETG PRSA .OA>
|
||
<SETG PRSO .OO>
|
||
<SETG PRSI .OI>
|
||
.V>
|
||
|
||
<DEFINE D-APPLY (STR FCN "OPTIONAL" FOO "AUX" RES)
|
||
<COND (<NOT .FCN> <>)
|
||
(T
|
||
<COND (,DEBUG
|
||
<COND (<NOT .STR>
|
||
<TELL CR " Default ->" CR>)
|
||
(T <TELL CR " " .STR " -> ">)>)>
|
||
<SET RES
|
||
<COND (<ASSIGNED? FOO>
|
||
<APPLY .FCN .FOO>)
|
||
(T <APPLY .FCN>)>>
|
||
<COND (<AND ,DEBUG .STR>
|
||
<COND (<==? .RES 2>
|
||
<TELL "Fatal" CR>)
|
||
(<NOT .RES>
|
||
<TELL "Not handled">)
|
||
(T <TELL "Handled" CR>)>)>
|
||
.RES)>>
|
||
|
||
<ROUTINE DD-APPLY (STR OBJ FCN "OPTIONAL" (FOO <>))
|
||
<COND (,DEBUG <TELL "[" D .OBJ "=]">)>
|
||
<D-APPLY .STR .FCN .FOO>>
|
||
>)>
|
||
\
|
||
;"former CLOCKER stuff"
|
||
|
||
<CONSTANT C-TABLELEN 180>
|
||
|
||
<GLOBAL C-TABLE <ITABLE NONE 180>>
|
||
|
||
<GLOBAL C-DEMONS 180>
|
||
|
||
<GLOBAL C-INTS 180>
|
||
|
||
<CONSTANT C-INTLEN 6>
|
||
|
||
<CONSTANT C-ENABLED? 0>
|
||
|
||
<CONSTANT C-TICK 1>
|
||
|
||
<CONSTANT C-RTN 2>
|
||
|
||
<ROUTINE QUEUE (RTN TICK "AUX" CINT)
|
||
<PUT <SET CINT <INT .RTN>> ,C-TICK .TICK>
|
||
.CINT>
|
||
|
||
<ROUTINE INT (RTN "OPTIONAL" (DEMON <>) E C INT)
|
||
<SET E <REST ,C-TABLE ,C-TABLELEN>>
|
||
<SET C <REST ,C-TABLE ,C-INTS>>
|
||
<REPEAT ()
|
||
<COND (<==? .C .E>
|
||
<SETG C-INTS <- ,C-INTS ,C-INTLEN>>
|
||
<AND .DEMON <SETG C-DEMONS <- ,C-DEMONS ,C-INTLEN>>>
|
||
<SET INT <REST ,C-TABLE ,C-INTS>>
|
||
<PUT .INT ,C-RTN .RTN>
|
||
<RETURN .INT>)
|
||
(<EQUAL? <GET .C ,C-RTN> .RTN> <RETURN .C>)>
|
||
<SET C <REST .C ,C-INTLEN>>>>
|
||
|
||
<GLOBAL CLOCK-WAIT <>>
|
||
|
||
<ROUTINE CLOCKER ("AUX" C E TICK (FLG <>))
|
||
<COND (,CLOCK-WAIT <SETG CLOCK-WAIT <>> <RFALSE>)>
|
||
<SET C <REST ,C-TABLE <COND (,P-WON ,C-INTS) (T ,C-DEMONS)>>>
|
||
<SET E <REST ,C-TABLE ,C-TABLELEN>>
|
||
<REPEAT ()
|
||
<COND (<==? .C .E>
|
||
<SETG MOVES <+ ,MOVES 1>>
|
||
<RETURN .FLG>)
|
||
(<NOT <0? <GET .C ,C-ENABLED?>>>
|
||
<SET TICK <GET .C ,C-TICK>>
|
||
<COND (<0? .TICK>)
|
||
(T
|
||
<PUT .C ,C-TICK <- .TICK 1>>
|
||
<COND (<AND <NOT <G? .TICK 1>>
|
||
<APPLY <GET .C ,C-RTN>>>
|
||
<SET FLG T>)>)>)>
|
||
<SET C <REST .C ,C-INTLEN>>>> |