planetfall/misc.zil
historicalsource e85ca899aa Final Revision
2019-04-13 21:35:51 -04:00

483 lines
13 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

"MISC for PLANETFALL
(c) Copyright 1983 Infocom, Inc. All Rights Reserved."
"old MACROS file"
<SETG C-ENABLED? 0>
<SETG C-ENABLED 1>
<SETG C-DISABLED 0>
<DEFMAC VERB? ("TUPLE" ATMS "AUX" (O ()) (L ()))
<REPEAT ()
<COND (<EMPTY? .ATMS>
<RETURN!- <COND (<LENGTH? .O 1> <NTH .O 1>)
(ELSE <FORM OR !.O>)>>)>
<REPEAT ()
<COND (<EMPTY? .ATMS> <RETURN!->)>
<SET ATM <NTH .ATMS 1>>
<SET L
(<FORM GVAL <PARSE <STRING "V?" <SPNAME .ATM>>>>
!.L)>
<SET ATMS <REST .ATMS>>
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
<SET O (<FORM EQUAL? ',PRSA !.L> !.O)>
<SET L ()>>>
<DEFMAC RFATAL ()
'<PROG () <PUSH 2> <RSTACK>>>
<DEFMAC PROB ('BASE?)
<FORM NOT <FORM L? .BASE? '<RANDOM 100>>>>
<ROUTINE PICK-ONE (FROB)
<GET .FROB <RANDOM <GET .FROB 0>>>>
<DEFMAC ENABLE ('INT) <FORM PUT .INT ,C-ENABLED? 1>>
<DEFMAC DISABLE ('INT) <FORM PUT .INT ,C-ENABLED? 0>>
<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)>>
"old MAIN or VERMONT file"
<GLOBAL P-WON <>>
<CONSTANT M-FATAL 2>
<CONSTANT M-HANDLED 1>
<CONSTANT M-NOT-HANDLED <>>
<CONSTANT M-BEG 1>
<CONSTANT M-END 6>
<CONSTANT M-OBJECT <>>
<CONSTANT M-ENTER 2>
<CONSTANT M-LOOK 3>
<CONSTANT M-FLASH 4>
<CONSTANT M-OBJDESC 5>
<ROUTINE GO ()
<PUTB ,P-LEXV 0 59>
;"put interrupts on clock chain"
<ENABLE <QUEUE I-BLATHER -1>>
<ENABLE <QUEUE I-AMBASSADOR -1>>
<ENABLE <QUEUE I-RANDOM-INTERRUPTS 1>>
<ENABLE <QUEUE I-SLEEP-WARNINGS 3600>>
<ENABLE <QUEUE I-HUNGER-WARNINGS 2000>>
<ENABLE <QUEUE I-SICKNESS-WARNINGS 1000>>
;"set up and go"
<SETG SPOUT-PLACED ,GROUND>
;"following COND avoids random-before-first-read message in ZIP20"
<COND (<EQUAL? <GETB 0 56> 0>
<SETG INTERNAL-MOVES <+ 4450 <RANDOM 180>>>)
(T
<SETG INTERNAL-MOVES 4540>)>
<SETG MOVES ,INTERNAL-MOVES>
<SETG LIT T>
<SETG WINNER ,ADVENTURER>
<SETG HERE ,DECK-NINE>
<SETG P-IT-LOC ,DECK-NINE>
<SETG P-IT-OBJECT ,POD-DOOR>
<COND (<NOT <FSET? ,HERE ,TOUCHBIT>>
<V-VERSION>
<CRLF>
<TELL
"Another routine day of drudgery aboard the Stellar Patrol Ship Feinstein.
This morning's assignment for a certain lowly Ensign Seventh Class: scrubbing
the filthy metal deck at the port end of Level Nine. With your Patrol-issue
self-contained multi-purpose all-weather scrub brush you shine the floor with
a diligence born of the knowledge that at any moment dreaded Ensign First
Class Blather, the bane of your shipboard existence, could appear." CR CR>)>
<V-LOOK>
<MAIN-LOOP>
<AGAIN>>
<ROUTINE I-RANDOM-INTERRUPTS ()
<ENABLE <QUEUE I-BLOWUP-FEINSTEIN <+ <RANDOM 90> 240>>>
<COMM-SETUP> ;"sets up comm system and laser values"
<SETG NUMBER-NEEDED <RANDOM 1000>>>
<ROUTINE MAIN-LOOP ("AUX" ICNT OCNT NUM CNT OBJ TBL V PTBL OBJ1 TMP)
<REPEAT ()
<SETG C-ELAPSED ,C-ELAPSED-DEFAULT>
<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 (<==? ,PRSA ,V?WALK> <SET V <PERFORM ,PRSA ,PRSO>>)
(<0? .NUM>
<COND (<0? <BAND <GETB ,P-SYNTAX ,P-SBITS> ,P-SONUMS>>
<SET V <PERFORM ,PRSA>>
<SETG PRSO <>>)
(T
<TELL "There isn't anything to ">
<SET TMP <GET ,P-ITBL ,P-VERBN>>
<COND (<OR ,P-OFLAG ,P-MERGED>
<PRINTB <GET .TMP 0>>)
(T
<WORD-PRINT <GETB .TMP 2>
<GETB .TMP 3>>)>
<TELL "!" CR>
<SET V <>>)>)
(T
<SET TMP 0>
<SET ICNT <>>
<REPEAT ()
<COND (<G? <SET CNT <+ .CNT 1>> .NUM>
<COND (<G? .TMP 0>
<TELL "The ">
<COND (<NOT <EQUAL? .TMP .NUM>>
<TELL "other ">)>
<TELL "object">
<COND (<NOT <EQUAL? .TMP 1>>
<TELL "s">)>
<TELL " that you mentioned ">
<COND (<NOT <EQUAL? .TMP 1>>
<TELL "are">)
(T <TELL "is">)>
<TELL "n't here." CR>)
(<NOT .ICNT>
<TELL "There's nothing there." CR>)>
<RETURN>)
(T
<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 (<EQUAL? .OBJ1
,NOT-HERE-OBJECT>
<SET TMP
<+ .TMP 1>>
<AGAIN>)
(<AND <VERB? TAKE>
,PRSI
<EQUAL? <GET <GET ,P-ITBL
,P-NC1>
0>
,W?ALL>
<NOT <IN? ,PRSO ,PRSI>>>
<AGAIN>)
(<AND <EQUAL? ,P-GETFLAGS
,P-ALL>
<VERB? TAKE>
<NOT <EQUAL?
<LOC .OBJ1>
,WINNER
,HERE>>>
<AGAIN>)
(T
<COND (<EQUAL? .OBJ1 ,IT>
<PRINTD ,P-IT-OBJECT>)
(T <PRINTD .OBJ1>)>
<TELL ": ">)>)>
<SET ICNT 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 (<NOT <==? ,PRSA ,V?AGAIN>>
<SETG L-PRSA ,PRSA>
<SETG L-PRSO ,PRSO>
<SETG L-PRSI ,PRSI>)>
<COND (<NOT <EQUAL? <GET <INT I-POD-TRIP> ,C-ENABLED?> 0>>
<SETG C-ELAPSED 54>)
(<G? ,SHUTTLE-VELOCITY 0>
<SETG C-ELAPSED </ 600 ,SHUTTLE-VELOCITY>>)
(<OR <VERB? TELL>
<TIMELESS-VERB? ,PRSA>>
<SETG C-ELAPSED 0>)
(<AND <VERB? AGAIN>
<TIMELESS-VERB? ,L-PRSA>>
<SETG C-ELAPSED 0>)>
<SETG INTERNAL-MOVES <+ ,INTERNAL-MOVES ,C-ELAPSED>>
<COND (<==? .V ,M-FATAL>
<SETG P-CONT <>>)>)
(T
<SETG P-CONT <>>)>
<COND (<NOT <IN? ,CHRONOMETER ,ADVENTURER>>
<SETG MOVES 0>)
(<FSET? ,CHRONOMETER ,MUNGEDBIT>
<SETG MOVES ,MUNGED-TIME>)
(T
<SETG MOVES ,INTERNAL-MOVES>)>
<COND (,P-WON
<COND (<NOT <EQUAL? ,C-ELAPSED 0>>
<SET V <CLOCKER>>)>)>>>
<ROUTINE TIMELESS-VERB? (VRB)
<COND (<OR <EQUAL? .VRB ,V?BRIEF ,V?SUPER-BRIEF ,V?VERBOSE>
<EQUAL? .VRB ,V?SAVE ,V?RESTORE ,V?SCORE>
<EQUAL? .VRB ,V?SCRIPT ,V?UNSCRIPT ,V?TIME>
<EQUAL? .VRB ,V?QUIT ,V?RESTART ,V?VERSION>
<EQUAL? .VRB ,V?$RANDOM ,V?$RECORD ,V?$UNRECORD>
<EQUAL? .VRB ,V?$COMMAND>>
<RTRUE>)
(T
<RFALSE>)>>
<GLOBAL L-PRSA <>>
<GLOBAL L-PRSO <>>
<GLOBAL L-PRSI <>>
%<COND (<GASSIGNED? PREDGEN>
'<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" V OA OO OI)
<SET OA ,PRSA>
<SET OO ,PRSO>
<SET OI ,PRSI>
<COND (<EQUAL? ,IT .I .O>
;<AND <EQUAL? ,IT .I .O>
<OR <NOT <EQUAL? ,P-IT-LOC ,HERE>>
<EQUAL? <LOC ,P-IT-OBJECT> <>>>>
<TELL "I don't see what you are referring to." CR>
<SETG P-IT-OBJECT <>>
<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 P-IT-LOC ,HERE>)>
<SETG PRSI .I>
<COND (<AND <EQUAL? ,NOT-HERE-OBJECT ,PRSO ,PRSI>
<SET V <APPLY ,NOT-HERE-OBJECT-F>>>
<SETG P-WON <>> ;"to keep clock from running"
.V)
(<AND <SET O ,PRSO> <SET I ,PRSI> <NULL-F>>
<TELL "[in case last clause changed PRSx]">)
(<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 PDEBUG <>>
<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" V OA OO OI)
<COND (,PDEBUG
<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 (<EQUAL? ,IT .I .O>
;<AND <EQUAL? ,IT .I .O>
<OR <NOT <EQUAL? ,P-IT-LOC ,HERE>>
<EQUAL? <LOC ,P-IT-OBJECT> <>>>>
<TELL "I don't see what you are referring to." CR>
<SETG P-IT-OBJECT <>>
<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 P-IT-LOC ,HERE>)>
<SETG PRSI .I>
<COND (<SET V <D-APPLY "Actor"
<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>>
<LOC .O>
<SET V <D-APPLY "Container"
<GETP <LOC .O> ,P?CONTFCN>>>>
.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)>
<COND (<NOT <==? .V ,M-FATAL>>
;<COND (<==? <LOC ,WINNER> ,PRSO>
<SETG PRSO <>>)>
<SET V <D-APPLY "Room (M-END)"
<GETP <LOC ,WINNER> ,P?ACTION> ,M-END>>)>
<SETG PRSA .OA>
<SETG PRSO .OO>
<SETG PRSI .OI>
.V>
<DEFINE D-APPLY (STR FCN "OPTIONAL" FOO "AUX" RES)
<COND (<NOT .FCN> <>)
(T
<COND (,PDEBUG
<COND (<NOT .STR>
<TELL CR " Default ->" CR>)
(T <TELL CR " " .STR " -> ">)>)>
<SET RES
<COND (<ASSIGNED? FOO>
<APPLY .FCN .FOO>)
(T <APPLY .FCN>)>>
<COND (<AND ,PDEBUG .STR>
<COND (<==? .RES 2>
<TELL "Fatal" CR>)
(<NOT .RES>
<TELL "Not handled">)
(T <TELL "Handled" CR>)>)>
.RES)>>
>)>
<ROUTINE META-LOC (OBJ)
<REPEAT ()
<COND (<NOT .OBJ> <RFALSE>)
(<IN? .OBJ ,GLOBAL-OBJECTS>
<RETURN ,GLOBAL-OBJECTS>)>
<COND (<IN? .OBJ ,ROOMS>
<RETURN .OBJ>)
(ELSE
<SET OBJ <LOC .OBJ>>)>>>
"old CLOCK file"
<CONSTANT C-TABLELEN 240>
<GLOBAL C-TABLE %<COND (<GASSIGNED? PREDGEN>
'<ITABLE NONE 120>)
(T
'<ITABLE NONE 240>)>>
<GLOBAL C-DEMONS 300>
<GLOBAL C-INTS 240>
<GLOBAL C-ELAPSED 7>
<CONSTANT C-ELAPSED-DEFAULT 7>
<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 <>>
;<GLOBAL ELAPSED-MOVES 0>
<ROUTINE CLOCKER ("AUX" C E TICK (FLG <>))
;<SETG ELAPSED-MOVES <+ ,ELAPSED-MOVES 1>>
;<COND (,DEBUG-ON
<TELL "[Elapsed time: " N ,C-ELAPSED "]" CR>)>
;<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> <RETURN .FLG>)
(<NOT <0? <GET .C ,C-ENABLED?>>>
<SET TICK <GET .C ,C-TICK>>
<COND (<0? .TICK>)
(<==? .TICK -1>
<COND (<APPLY <GET .C ,C-RTN>>
<SET FLG T>)>)
(T
<PUT .C ,C-TICK <SET TICK <- .TICK ,C-ELAPSED>>>
<COND (<NOT <G? .TICK 1>>
<PUT .C ,C-TICK 0>
<COND (<APPLY <GET .C ,C-RTN>>
<SET FLG T>)>)>)>)>
<SET C <REST .C ,C-INTLEN>>>>
<ROUTINE NULL-F ("OPTIONAL" A1 A2)
<RFALSE>>