historicalsource/checkpoint
1
0
Fork 0
mirror of https://github.com/historicalsource/checkpoint synced 2024-05-30 22:58:13 +03:00
Code Issues Releases Wiki Activity
checkpoint/parser.true
historicalsource 8ae301e53b Final Revision
2019-04-13 22:12:44 -04:00

2149 lines
63 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.

"PARSER for CHECKPOINT
Copyright (C) 1985 Infocom, Inc. All rights reserved."
"Parser global variable convention: All parser globals will
begin with 'P-'. Local variables are not restricted in any
way."
<SETG SIBREAKS ".,\"!?">
"<GLOBAL ALWAYS-LIT <>>
<GLOBAL GWIM-DISABLE <>>"
<GLOBAL PRSA 0>
<GLOBAL PRSI 0>
<GLOBAL PRSO 0>
<GLOBAL P-TABLE 0>
<GLOBAL P-ONEOBJ 0>
<GLOBAL P-SYNTAX 0>
<GLOBAL P-LEN 0>
<GLOBAL P-DIR 0>
<GLOBAL HERE 0>
<GLOBAL LAST-PLAYER-LOC 0>
<GLOBAL WINNER 0>
<GLOBAL P-LEXV <ITABLE BYTE 120>>
"INBUF - Input buffer for READ"
<GLOBAL P-INBUF <ITABLE BYTE 100>>
"Parse-cont variable"
<GLOBAL P-CONT <>>
<GLOBAL P-IT-OBJECT <>>
<GLOBAL P-HER-OBJECT <>>
<GLOBAL P-HIM-OBJECT <>>
<GLOBAL P-THEM-OBJECT <>>
"Orphan flag"
<GLOBAL P-OFLAG <>>
<GLOBAL P-MERGED <>>
<GLOBAL P-ACLAUSE <>>
<GLOBAL P-ANAM <>>
<GLOBAL P-AADJ <>>
"Parser variables and temporaries"
"<CONSTANT P-PHRLEN 3>
<CONSTANT P-ORPHLEN 7>
<CONSTANT P-RTLEN 3>"
"Byte offset to # of entries in LEXV"
<CONSTANT P-LEXWORDS 1>
"Word offset to start of LEXV entries"
<CONSTANT P-LEXSTART 1>
"Number of words per LEXV entry"
<CONSTANT P-LEXELEN 2>
<CONSTANT P-WORDLEN 4>
"Offset to parts of speech byte"
<CONSTANT P-PSOFF 4>
"Offset to first part of speech"
<CONSTANT P-P1OFF 5>
"First part of speech bit mask in PSOFF byte"
<CONSTANT P-P1BITS 3>
<CONSTANT P-ITBLLEN 9>
<GLOBAL P-ITBL <TABLE 0 0 0 0 0 0 0 0 0 0>>
<GLOBAL P-OTBL <TABLE 0 0 0 0 0 0 0 0 0 0>>
<GLOBAL P-VTBL <TABLE 0 0 0 0>>
<GLOBAL P-OVTBL <TABLE 0 0 0 0>>
<GLOBAL P-NCN 0>
<CONSTANT P-VERB 0>
<CONSTANT P-VERBN 1>
<CONSTANT P-PREP1 2>
<CONSTANT P-PREP1N 3>
<CONSTANT P-PREP2 4>
"<CONSTANT P-PREP2N 5>"
<CONSTANT P-NC1 6>
<CONSTANT P-NC1L 7>
<CONSTANT P-NC2 8>
<CONSTANT P-NC2L 9>
<GLOBAL QUOTE-FLAG <>>
<GLOBAL P-ADVERB <>>
"<GLOBAL P-WHAT-IGNORED <>>"
<GLOBAL P-WON <>>
<CONSTANT M-FATAL 2>
"<CONSTANT M-HANDLED 1>
<CONSTANT M-NOT-HANDLED <>>"
<CONSTANT M-BEG 1>
<CONSTANT M-ENTER 2>
<CONSTANT M-LOOK 3>
<CONSTANT M-FLASH 4>
<CONSTANT M-OBJDESC 5>
<CONSTANT M-END 6>
<CONSTANT M-CONT 7>
<CONSTANT M-WINNER 8>
<GLOBAL L-PRSA <>>
<GLOBAL L-PRSO <>>
<GLOBAL L-PRSI <>>
<GLOBAL L-WINNER <>>
<ROUTINE MAIN-LOOP ("AUX" ICNT OCNT NUM CNT OBJ TBL V PTBL OBJ1 TMP X)
;#DECL((CNT OCNT ICNT NUM) FIX (V) <OR 'T FIX FALSE> (OBJ)<OR FALSE OBJECT>
(OBJ1) OBJECT (TBL) TABLE (PTBL) <OR FALSE ATOM>)
<REPEAT ()
<SET CNT 0>
<SET OBJ <>>
<SET PTBL T>
<COND (<NOT <==? ,QCONTEXT-ROOM ,HERE>>
<SETG QCONTEXT <>>)>
<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 (<EQUAL? ,PRSA ,V?WALK ,V?FACE>
<SET V <PERFORM ,PRSA ,PRSO>>)
(<0? .NUM>
<COND (<0? <BAND <GETB ,P-SYNTAX ,P-SBITS> ,P-SONUMS>>
<SET V <PERFORM ,PRSA>>
<SETG PRSO <>>)
(<NOT ,LIT>
<SETG QUOTE-FLAG <>>
<SETG P-CONT <>>
<TOO-DARK>)
(T
<SETG QUOTE-FLAG <>>
<SETG P-CONT <>>
<TELL "(There isn't anything to ">
<SET TMP <GET ,P-ITBL ,P-VERBN>>
<COND (<VERB? TELL>
<TELL "talk to">)
(<OR ,P-MERGED ,P-OFLAG>
<PRINTB <GET .TMP 0>>)
(T
<SET V <WORD-PRINT <GETB .TMP 2>
<GETB .TMP 3>>>)>
<TELL "!)" CR>
<SET V <>>)>)
;(<AND .PTBL <G? .NUM 1> <VERB? COMPARE>>
<SET V <PERFORM ,PRSA ,OBJECT-PAIR>>)
(T
<SET X 0>
;"<SETG P-MULT <>>
<COND (<G? .NUM 1> <SETG P-MULT T>)>"
<SET TMP 0>
<REPEAT ()
<COND (<G? <SET CNT <+ .CNT 1>> .NUM>
<COND (<G? .X 0>
<TELL "The ">
<COND (<NOT <EQUAL? .X .NUM>>
<TELL "other ">)>
<TELL "object">
<COND (<NOT <EQUAL? .X 1>>
<TELL "s">)>
<TELL " that you mentioned ">
<COND (<NOT <EQUAL? .X 1>>
<TELL "are">)
(T <TELL "is">)>
<TELL "n't here." CR>)
(<NOT .TMP>
<MORE-SPECIFIC ;REFERRING>)>
<RETURN>)
(T
<COND (.PTBL <SET OBJ1 <GET ,P-PRSO .CNT>>)
(T <SET OBJ1 <GET ,P-PRSI .CNT>>)>
<COND (<OR <G? .NUM 1>
<EQUAL? <GET <GET ,P-ITBL ,P-NC1> 0>
,W?ALL>>
<COND (<==? .OBJ1 ,NOT-HERE-OBJECT>
<SET X <+ .X 1>>
<AGAIN>)
(<AND <EQUAL? ,P-GETFLAGS ,P-ALL>
<VERB? TAKE>
<OR <AND <NOT <EQUAL?<LOC .OBJ1>
,WINNER
,HERE>>
<NOT <FSET? <LOC .OBJ1>
,SURFACEBIT>>>
<NOT <OR <FSET? .OBJ1
,TAKEBIT>
<FSET? .OBJ1
,TRYTAKEBIT>>>>>
<AGAIN>)
(<AND <EQUAL? ,P-GETFLAGS ,P-ALL>
<VERB? DROP>
<NOT <IN? .OBJ1 ,WINNER>>
<NOT <IN? ,P-IT-OBJECT,WINNER>>>
<AGAIN>)
(<NOT <ACCESSIBLE? .OBJ1>>
<AGAIN>)
(<==? .OBJ1 ,PLAYER> <AGAIN>)
;(<FSET? .OBJ1 ,DUPLICATE> <AGAIN>)
(T
<COND (<EQUAL? .OBJ1 ,IT>
<PRINTD ,P-IT-OBJECT>)
(T <PRINTD .OBJ1>)>
<TELL ": ">)>)>
<SET TMP T>
<SET V <QCONTEXT-CHECK <COND (.PTBL .OBJ1)
(T .OBJ)>>>
<SETG PRSO <COND (.PTBL .OBJ1) (T .OBJ)>>
<SETG PRSI <COND (.PTBL .OBJ) (T .OBJ1)>>
<SET V <PERFORM ,PRSA ,PRSO ,PRSI>>
<COND (<==? .V ,M-FATAL> <RETURN>)>)>>)>
<COND (<GAME-VERB?> T)
(<VERB? AGAIN> T)
(,P-OFLAG 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 (<AND <NOT <VERB? SAVE RESTORE>>
<GAME-VERB?>> T)
(<AND <VERB? AGAIN>
<NOT <EQUAL? ,L-PRSA ,V?SAVE ,V?RESTORE>>
<GAME-VERB? ,L-PRSA>>
T)
(T
<SET V <CLOCKER>>)>)>>>
<ROUTINE GAME-VERB? ("OPTIONAL" (V <>))
<COND (<NOT .V> <SET V ,PRSA>)>
<COND (<EQUAL? .V ,V?$ANSWER ,V?$GOAL ,V?$VERIFY> <RTRUE>)
(<EQUAL? .V ,V?$AGAIN ,V?$CUSTOMS ,V?$STATION> <RTRUE>)
(<EQUAL? .V ,V?$FCLEAR ,V?$FSET ,V?$QFSET> <RTRUE>)
(<EQUAL? .V ,V?$WHERE ,V?BRIEF ,V?DEBUG> <RTRUE>)
(<EQUAL? .V ,V?QUIT ,V?RESTART ,V?RESTORE> <RTRUE>)
(<EQUAL? .V ,V?SAVE ,V?SCRIPT ,V?SUPER-BRIEF> <RTRUE>)
(<EQUAL? .V ,V?TELL ,V?TIME ,V?UNSCRIPT> <RTRUE>)
(<EQUAL? .V ,V?VERBOSE ,V?VERSION ,V?$FACE> <RTRUE>)>>
<ROUTINE QCONTEXT-CHECK (PRSO "AUX" OTHER (WHO <>) (N 0))
<COND (<OR <VERB? ;FIND HELP WHAT>
<AND <VERB? SHOW TELL-ABOUT>
<==? .PRSO ,PLAYER>>> ;"? more?"
<SET OTHER <FIRST? ,HERE>>
<REPEAT ()
<COND (<NOT .OTHER> <RETURN>)
(<AND <FSET? .OTHER ,PERSONBIT>
<NOT <FSET? .OTHER ,INVISIBLE>>
<NOT <==? .OTHER ,PLAYER>>>
<SET N <+ 1 .N>>
<SET WHO .OTHER>)>
<SET OTHER <NEXT? .OTHER>>>
<COND (<AND <==? 1 .N> <NOT ,QCONTEXT>>
<SAID-TO .WHO>)>
<COND (<AND <QCONTEXT-GOOD?>
<==? ,WINNER ,PLAYER>> ;"? more?"
<SETG L-WINNER ,WINNER>
<SETG WINNER ,QCONTEXT>
<TELL "(said to " D ,QCONTEXT ")" CR>)>)>>
<ROUTINE QCONTEXT-GOOD? ()
<COND (<AND <NOT <ZERO? ,QCONTEXT>>
<FSET? ,QCONTEXT ,PERSONBIT>
<NOT <FSET? ,QCONTEXT ,INVISIBLE>>
<==? ,HERE ,QCONTEXT-ROOM>
<==? ,HERE <META-LOC ,QCONTEXT>>>
<RTRUE>)>>
<ROUTINE SAID-TO (WHO)
<SETG QCONTEXT .WHO>
<SETG QCONTEXT-ROOM <LOC .WHO>>>
<ROUTINE THIS-IS-IT (OBJ)
<COND (<EQUAL? .OBJ <> ,NOT-HERE-OBJECT>
<RTRUE>)>
<COND (<AND <VERB? WALK FACE> <==? .OBJ ,PRSO>>
<RTRUE>)>
<COND (<NOT <FSET? .OBJ ,PERSONBIT>>
<COND (<NOT <EQUAL? .OBJ ,GLOBAL-HERE ,INTDIR>>
<SETG P-IT-OBJECT .OBJ>)>)
(<EQUAL? .OBJ ,PLAYER>
<RTRUE>)
(<FSET? .OBJ ,FEMALE>
<SETG P-HER-OBJECT .OBJ>)
(<ZMEMQ .OBJ ,COUPLE-TABLE>
<SETG P-THEM-OBJECT .OBJ>)
(T
<SETG P-HIM-OBJECT .OBJ>)>
<RTRUE>>
<ROUTINE FAKE-ORPHAN ("AUX" TMP)
<ORPHAN ,P-SYNTAX <>>
<TELL "(Be specific: what thing do you want to ">
<SET TMP <GET ,P-OTBL ,P-VERBN>>
<COND (<==? .TMP 0> <TELL "tell">)
(<0? <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 <>>
<TELL "?)" CR>>
<GLOBAL NOW-PRSI <>>
<ROUTINE TELL-D-LOC (OBJ)
<TELL D .OBJ>
<COND (<IN? .OBJ ,GLOBAL-OBJECTS> <TELL "(gl)">)
(<IN? .OBJ ,LOCAL-GLOBALS> <TELL "(lg)">)
(<IN? .OBJ ,ROOMS> <TELL "(rm)">)>
<COND (<EQUAL? .OBJ ,TURN ,INTNUM>
<TELL "(">
<COND (,P-DOLLAR-FLAG
<PRINTC ,CURRENCY-SYMBOL>
<TELL N ,P-AMOUNT ")">)
(T <TELL N ,P-NUMBER ")">)>)>>
<ROUTINE FIX-HIM-HER (HEM-OBJECT "AUX" C P)
<SET C <GETP .HEM-OBJECT ,P?CHARACTER>>
<COND (<NOT <ACCESSIBLE? .HEM-OBJECT>>
<COND (,DEBUG <TELL "[" D .HEM-OBJECT ":NA]" CR>)>
<SET P <GET ,GLOBAL-CHARACTER-TABLE .C>>
<RETURN <AND .C
<NOT <==? .P <GET ,CHARACTER-TABLE .C>>>
.P>>)>
<COND (<IN? .HEM-OBJECT ,GLOBAL-OBJECTS>
<SET P <GET ,CHARACTER-TABLE .C>>)
(T <SET P .HEM-OBJECT>)>
<COND (<EQUAL? ,HERE <LOC .P>>
<COND (,DEBUG <TELL "[" D .HEM-OBJECT ":LO]" CR>)>
<RETURN .P>)>>
<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" V OA OO OI)
;#DECL((A) FIX (O) <OR FALSE OBJECT FIX> (I) <OR FALSE OBJECT> (V)ANY)
<COND (,DEBUG
<TELL "[Perform: ">
%<COND (<GASSIGNED? PREDGEN> '<TELL N .A>)
(T '<PRINC <NTH ,ACTIONS <+ <* .A 2> 1>>>)>
<COND (.O
<TELL "/">
<COND (<EQUAL? .A ,V?WALK ,V?FACE> <TELL N .O>)
(T <TELL-D-LOC .O>)>)>
<COND (.I
<TELL "/">
<TELL-D-LOC .I>)>
<TELL "]" CR>)>
<SET OA ,PRSA>
<SET OO ,PRSO>
<SET OI ,PRSI>
<SETG PRSA .A>
<COND (<NOT <EQUAL? .A ,V?WALK ,V?FACE>>
<COND (<AND <EQUAL? ,IT .I .O>
<NOT <ACCESSIBLE? ,P-IT-OBJECT>>>
<COND (<NOT .I> <FAKE-ORPHAN>)
(T <NOT-HERE ,P-IT-OBJECT>)>
<RFATAL>)>
<COND (<EQUAL? ,THEM .I .O>
<COND (<SET V <FIX-HIM-HER ,P-THEM-OBJECT>>
<COND (,DEBUG <TELL "[them=" D .V "]" CR>)>
<COND (<==? ,THEM .O> <SET O .V>)>
<COND (<==? ,THEM .I> <SET I .V>)>)
(T
<COND (<NOT .I> <FAKE-ORPHAN>)
(T <NOT-HERE ,P-THEM-OBJECT>)>
<RFATAL>)>)>
<COND (<EQUAL? ,HER .I .O>
<COND (<SET V <FIX-HIM-HER ,P-HER-OBJECT>>
<COND (,DEBUG <TELL "[her=" D .V "]" CR>)>
<COND (<==? ,HER .O> <SET O .V>)>
<COND (<==? ,HER .I> <SET I .V>)>)
(T
<COND (<NOT .I> <FAKE-ORPHAN>)
(T <NOT-HERE ,P-HER-OBJECT>)>
<RFATAL>)>)>
<COND (<EQUAL? ,HIM .I .O>
<COND (<SET V <FIX-HIM-HER ,P-HIM-OBJECT>>
<COND (,DEBUG <TELL "[him=" D .V "]" CR>)>
<COND (<==? ,HIM .O> <SET O .V>)>
<COND (<==? ,HIM .I> <SET I .V>)>)
(T
<COND (<NOT .I> <FAKE-ORPHAN>)
(T <NOT-HERE ,P-HIM-OBJECT>)>
<RFATAL>)>)>
<COND (<==? .O ,IT>
<SET O ,P-IT-OBJECT>
<COND (,DEBUG <TELL "[it=" D .O "]" CR>)>)
;"(<==? .O ,THEM><SET O ,P-THEM-OBJECT>)
(<==? .O ,HER> <SET O ,P-HER-OBJECT>)
(<==? .O ,HIM> <SET O ,P-HIM-OBJECT>)">
<COND (<==? .I ,IT>
<SET I ,P-IT-OBJECT>
<COND (,DEBUG <TELL "[it=" D .O "]" CR>)>)
;"(<==? .I ,THEM><SET I ,P-THEM-OBJECT>)
(<==? .I ,HER> <SET I ,P-HER-OBJECT>)
(<==? .I ,HIM> <SET I ,P-HIM-OBJECT>)">)>
<SETG PRSI .I>
<SETG PRSO .O>
<COND (<AND <NOT <EQUAL? .A ,V?WALK ,V?FACE>>
<EQUAL? ,NOT-HERE-OBJECT ,PRSO ,PRSI>
<SET V <D-APPLY "Not Here" ,NOT-HERE-OBJECT-F>>>
<SETG P-WON <>>
.V)
(<AND <SET V <THIS-IS-IT ,PRSI>>
<SET V <THIS-IS-IT ,PRSO>>
<SET O ,PRSO>
<SET I ,PRSI>
<SET V <NULL-F>>>
T) ;"[in case last clause changed PRSx]"
(<AND ,DEBUG
<PRINTC %<ASCII !\[>>
<PRINTD ,WINNER> ;"extra output for next (...)"
<PRINTI "=]">
<SET V <NULL-F>>>
T)
(<SET V <D-APPLY "Actor"
;,WINNER
<GETP ,WINNER ,P?ACTION>
,M-WINNER>> .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
<SETG NOW-PRSI T>
<SET V <D-APPLY "PRSI" <GETP .I ,P?ACTION>>>>
.V)
(<AND <NOT <SETG NOW-PRSI <>>>
.O
<NOT <EQUAL? .A ,V?WALK ,V?FACE>>
<LOC .O>
<SET V <GETP <LOC .O> ,P?CONTFCN>>
<SET V <APPLY .V ,M-CONT>>
;<SET V <DD-APPLY "Container" <LOC .O>
<GETP <LOC .O> ,P?CONTFCN>>>>
.V)
(<AND .O
<NOT <EQUAL? .A ,V?WALK ,V?FACE>>
<SET V <D-APPLY "PRSO"
<GETP .O ,P?ACTION>>>>
.V)
(<SET V <D-APPLY <>
<GET ,ACTIONS .A>>> .V)>
<COND (<NOT <==? .V ,M-FATAL>>
<COND (<OR <VERB? SAVE RESTORE> <NOT <GAME-VERB?>>>
<SET V <D-APPLY "Room (M-END)"
<GETP <LOC ,WINNER> ,P?ACTION> ,M-END>>)>)>
<SETG PRSA .OA>
<SETG PRSO .OO>
<SETG PRSI .OI>
.V>
;<ROUTINE DD-APPLY (STR OBJ FCN)
<COND (,DEBUG
<PRINTC %<ASCII !\[>>
<TELL D .OBJ "=]">)>
<D-APPLY .STR .FCN>>
<ROUTINE D-APPLY (STR FCN "OPTIONAL" (FOO <>) "AUX" RES)
<COND (<NOT .FCN> <>)
(T
<COND (,DEBUG
<COND (<NOT .STR>
<TELL "[Action:]" CR>)
(T
<PRINTC %<ASCII !\[>>
<TELL .STR ": ">)>)>
<COND (<=? .STR "Container">
<SET FOO ,M-CONT>)>
<SET RES
<COND (.FOO <APPLY .FCN .FOO>)
(T <APPLY .FCN>)>>
<COND (<AND ,DEBUG .STR>
<COND (<==? .RES ,M-FATAL>
<TELL "Fatal]" CR>)
(<NOT .RES>
<TELL "Not handled]" CR>)
(T <TELL "Handled]" CR>)>)>
.RES)>>
" Grovel down the input finding the verb, prepositions, and noun clauses.
If the input is <direction> or <walk> <direction>, fall out immediately
setting PRSA to ,V?WALK and PRSO to <direction>. Otherwise, perform
all required orphaning, syntax checking, and noun clause lookup."
<GLOBAL P-PROMPT 2>
<ROUTINE I-PROMPT-1 () <SETG P-PROMPT 1> <RFALSE>>
<ROUTINE I-PROMPT-2 ()
<COND (,P-PROMPT
<SETG P-PROMPT <>>
<TELL CR
"(Are you tired of seeing \"What next?\" Well, you won't see it
any more.)" CR>
<COND (<VERB? ;WAIT WAIT-FOR WAIT-UNTIL> <CRLF>)>
<DISABLE <INT I-PROMPT-2>>
<RFALSE>)>>
<ROUTINE BUZZER-WORD? (WORD)
<COND (<QUESTION-WORD? .WORD> <RTRUE>)
( <NUMBER-WORD? .WORD> <RTRUE>)
( <NAUGHTY-WORD? .WORD> <RTRUE>)
(<OR <EQUAL? .WORD ,W?NW ,W?NORTHW ,W?NE>
<EQUAL? .WORD ,W?SW ,W?SOUTHW ,W?NORTHE>
<EQUAL? .WORD ,W?SE ,W?SOUTHE>>
<TELL "(Sorry, but this story has no \"">
<PRINTB .WORD>
<TELL "\" directions.)" CR>)
;(<EQUAL? .WORD ,W?ALL>
<TELL "(Sorry, but in this story you can't use the word \"">
<PRINTB .WORD>
<TELL "\".)" CR>)>>
<BUZZ AM ANY ARE CAN COULD DID DO HAS HAVE HE\'S HOW
IS IT\'S I\'LL I\'M I\'VE LET\'S SHALL SHE\'S SHOULD
THAT\'S THEY\'RE WAS WERE WE\'RE
WHAT WHAT\'S WHEN WHEN\'S WHERE ;WHERE\'S WHICH WHO WHO\'S WHY
WILL WON\'T WOULD YOU\'RE>
<GLOBAL QUESTION-WORD-COUNT 0>
<ROUTINE QUESTION-WORD? (WORD)
<COND (<EQUAL? .WORD ,W?WHERE ;",W?THERE ,W?SEEN">
<TELL
"(To locate something, use the command: FIND " D ,SOMETHING ".)" CR>)
(<OR <EQUAL? .WORD ,W?WHAT ,W?WHAT\'S>
<EQUAL? .WORD ,W?WHO ,W?WHO\'S>>
<TELL
"(To ask about something, use the command: TELL ME ABOUT " D ,SOMETHING ".)"
CR>)
(<OR <EQUAL? .WORD ,W?THAT\'S ,W?IT\'S>
<EQUAL? .WORD ,W?WHY ,W?HOW ,W?WHEN>
<EQUAL? .WORD ,W?IS ,W?DID ,W?ARE>
<EQUAL? .WORD ,W?DO ,W?HAVE ,W?ANY>
<EQUAL? .WORD ,W?AM ,W?I\'M ,W?WE\'RE>
<EQUAL? .WORD ,W?WILL ,W?WAS ,W?WERE>
<EQUAL? .WORD ,W?I\'LL ,W?CAN ,W?WHICH>
<EQUAL? .WORD ,W?I\'VE ,W?WON\'T ,W?HAS>
<EQUAL? .WORD ,W?YOU\'RE ,W?HE\'S ,W?SHE\'S>
<EQUAL? .WORD ,W?SHOULD ,W?WOULD ,W?WHEN\'S>
<EQUAL? .WORD ,W?THEY\'RE ,W?COULD ,W?SHALL>>
<TELL "(Please use commands">
<INC QUESTION-WORD-COUNT>
<COND (<G? ,QUESTION-WORD-COUNT 9>
<SETG QUESTION-WORD-COUNT 0>
<TELL
"! Your commands tell the computer what you want to do in the story. You
can give commands to other people in the story, too. Here are examples
of commands:|
TURN ON THE LAMP|
LOOK UNDER THE RUG|
MADAME, GIVE THE BOOK TO HIM|
CONDUCTOR, HELP ME|
Now you can try again.)" CR>)
(T <TELL ", not statements or questions.)" CR>)>
<RTRUE>)>>
<BUZZ ZERO ONE TWO THREE FOUR FIVE SIX SEVEN EIGHT NINE TEN
ELEVEN TWELVE THIRTE FOURTE FIFTEE SIXTEE SEVENT EIGHTE NINETE TWENTY
THIRTY FORTY ;FORTY- FIFTY ;FIFTY- SIXTY ;SIXTY- EIGHTY NINETY HUNDRE
THOUSA MILLIO BILLIO>
<ROUTINE NUMBER-WORD? (WRD)
<COND (<OR <EQUAL? .WRD ,W?ZERO>
<EQUAL? .WRD ,W?TWO ,W?THREE ,W?FOUR>
<EQUAL? .WRD ,W?FIVE ,W?SIX ,W?SEVEN>
<EQUAL? .WRD ,W?EIGHT ,W?NINE ,W?TEN>
<EQUAL? .WRD ,W?ELEVEN ,W?TWELVE ,W?THIRTE>
<EQUAL? .WRD ,W?FOURTE ,W?FIFTEE ,W?SIXTEE>
<EQUAL? .WRD ,W?SEVENT ,W?EIGHTE ,W?NINETE>
<EQUAL? .WRD ,W?TWENTY ,W?THIRTY ,W?FORTY>
<EQUAL? .WRD ,W?FIFTY ,W?SIXTY ,W?EIGHTY>
<EQUAL? .WRD ,W?NINETY ,W?HUNDRE ,W?THOUSA>
<EQUAL? .WRD ,W?MILLIO ,W?BILLIO ,W?ONE>>
<TELL "(Use numerals for numbers, for example \"10.\")" CR>
<RTRUE>)>>
<BUZZ BASTARD CHOMP CURSE CURSES CUSS DAMN DARN FUCK FUDGE HELL
PISS SCREW SHIT SUCK>
<ROUTINE NAUGHTY-WORD? (WORD)
<COND (<OR <EQUAL? .WORD ,W?CURSE ,W?CURSES ,W?CUSS>
<EQUAL? .WORD ,W?DAMN ,W?SHIT ,W?FUCK>
<EQUAL? .WORD ,W?CHOMP ,W?DARN ,W?HELL>
<EQUAL? .WORD ,W?FUDGE ,W?PISS ,W?SUCK>
<EQUAL? .WORD ,W?BASTARD ,W?SCREW>>
<PRINTC %<ASCII !\(>>
<TELL <PICK-ONE-NEW ,OFFENDED>>
<PRINTC %<ASCII !\)>>
<CRLF>)>>
<GLOBAL OFFENDED
<LTABLE 0
"You ought to be ashamed of yourself!"
"Hey, save that talk for the locker room!"
"Step outside and say that!"
"And so's your old man!">>
<ROUTINE PARSER ("AUX" (PTR ,P-LEXSTART) WRD (VAL 0) (VERB <>)
LEN (DIR <>) (NW 0) (LW 0) NUM SCNT (CNT -1) OWINNER)
<REPEAT ()
<COND (<G? <SET CNT <+ .CNT 1>> ,P-ITBLLEN> <RETURN>)
(T <PUT ,P-ITBL .CNT 0>)>>
<SETG P-NUMBER -1>
<SETG P-NAM <>>
<SETG P-ADJ <>>
<SETG P-ADVERB <>>
<SETG P-MERGED <>>
;<SETG P-WHAT-IGNORED <>>
<PUT ,P-PRSO ,P-MATCHLEN 0>
<PUT ,P-PRSI ,P-MATCHLEN 0>
<PUT ,P-BUTS ,P-MATCHLEN 0>
<SET OWINNER ,WINNER>
<COND (<AND <NOT ,QUOTE-FLAG> <N==? ,WINNER ,PLAYER>>
<SETG L-WINNER ,WINNER>
<SETG WINNER ,PLAYER>
<COND (T ;<NOT <FSET? <LOC ,WINNER> ,VEHBIT>>
<SETG LAST-PLAYER-LOC ,HERE>
<SETG HERE <LOC ,WINNER>>)>
<SETG LIT <LIT? ,HERE>>)>
<COND (<NOT <ZERO? ,P-CONT>>
<SET PTR ,P-CONT>
<SETG P-CONT <>>
<COND (<AND <NOT ,SUPER-BRIEF> <==? ,PLAYER ,WINNER>>
<CRLF>)>
;<COND (<NOT <VERB? ASK TELL SAY>> <CRLF>)>)
(T
<SETG L-WINNER ,WINNER>
<SETG WINNER ,PLAYER>
<SETG QUOTE-FLAG <>>
<COND (T ;<NOT <FSET? <LOC ,WINNER> ,VEHBIT>>
<SETG LAST-PLAYER-LOC ,HERE>
<SETG HERE <LOC ,WINNER>>)>
<SETG LIT <LIT? ,HERE>>
<COND (<NOT ,SUPER-BRIEF> <CRLF>)>
;<SET SCNT ,P-SPACE>
;<REPEAT ()
<COND (<L? <SET SCNT <- .SCNT 1>> 0> <RETURN>)
(T <CRLF>)>>
<COND (<AND ,P-PROMPT <NOT ,P-OFLAG>>
<COND (<EQUAL? ,P-PROMPT 2>
<TELL "Okay, what do you want to do now?">)
(T <TELL "What next?">)>
<CRLF>)>
<PUTB ,P-LEXV 0 59>
<TELL ">">
<READ ,P-INBUF ,P-LEXV>)>
<SETG P-LEN <GETB ,P-LEXV ,P-LEXWORDS>>
<COND (<AND <==? ,W?QUOTE <GET ,P-LEXV .PTR>>
<QCONTEXT-GOOD?>> ;"Is quote first input token?"
<SET PTR <+ .PTR ,P-LEXELEN>> ;"If so, ignore it."
<SETG P-LEN <- ,P-LEN 1>>)>
<COND (<==? ,W?THEN <GET ,P-LEXV .PTR>> ;"Is THEN first input word?"
<SET PTR <+ .PTR ,P-LEXELEN>> ;"If so, ignore it."
<SETG P-LEN <- ,P-LEN 1>>)>
<COND (<AND <L? 1 ,P-LEN>
<==? ,W?GO <GET ,P-LEXV .PTR>> ;"Is GO first input word?"
<SET NW <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>>
<WT? .NW ,PS?VERB ,P1?VERB> ;" followed by verb?">
<SET PTR <+ .PTR ,P-LEXELEN>> ;"If so, ignore it."
<SETG P-LEN <- ,P-LEN 1>>)>
<COND (<0? ,P-LEN> <TELL "I beg your pardon?" CR> <RFALSE>)>
<SET LEN ,P-LEN>
<SETG P-DIR <>>
<SETG P-NCN 0>
<SETG P-GETFLAGS 0>
;"3/25/83: Next statement added."
<PUT ,P-ITBL ,P-VERBN 0>
<REPEAT ()
<COND (<L? <SETG P-LEN <- ,P-LEN 1>> 0>
<SETG QUOTE-FLAG <>>
<RETURN>)
(<BUZZER-WORD? <SET WRD <GET ,P-LEXV .PTR>>>
<RFALSE>)
(<OR .WRD
<SET WRD <NUMBER? .PTR>>
;<SET WRD <NAME? .PTR>>>
<COND (<AND <==? .WRD ,W?TO>
<EQUAL? .VERB ,ACT?TELL ,ACT?ASK>>
<SET VERB ,ACT?TELL>
<SET WRD ,W?QUOTE>)
(<AND <==? .WRD ,W?THEN>
<NOT .VERB>
<NOT ,QUOTE-FLAG> ;"Last NOT added 7/3">
<PUT ,P-ITBL ,P-VERB ,ACT?TELL>
<PUT ,P-ITBL ,P-VERBN 0>
<SET WRD ,W?QUOTE>)>
<COND ;(<AND <EQUAL? .WRD ,W?PERIOD>
<EQUAL? .LW ,W?MRS ,W?MR>>
<SET LW 0>)
(<OR <EQUAL? .WRD ,W?THEN ,W?PERIOD>
<EQUAL? .WRD ,W?QUOTE>>
<COND (<EQUAL? .WRD ,W?QUOTE>
<COND (,QUOTE-FLAG
<SETG QUOTE-FLAG <>>)
(T <SETG QUOTE-FLAG T>)>)>
<OR <0? ,P-LEN>
<SETG P-CONT <+ .PTR ,P-LEXELEN>>>
<PUTB ,P-LEXV ,P-LEXWORDS ,P-LEN>
<RETURN>)
(<AND <SET VAL
<WT? .WRD
,PS?DIRECTION
,P1?DIRECTION>>
<EQUAL? .VERB <> ,ACT?WALK ,ACT?FACE>
<OR <==? .LEN 1>
<AND <==? .LEN 2>
<EQUAL? .VERB ,ACT?WALK ,ACT?FACE>>
<AND <EQUAL? <SET NW
<GET ,P-LEXV
<+ .PTR ,P-LEXELEN>>>
,W?THEN
,W?PERIOD
,W?QUOTE>
<G? .LEN 1 ;2>>
;<AND <EQUAL? .NW ,W?PERIOD>
<G? .LEN 1>>
<AND ,QUOTE-FLAG
<==? .LEN 2>
<EQUAL? .NW ,W?QUOTE>>
<AND <G? .LEN 2>
<EQUAL? .NW ,W?COMMA ,W?AND>>>>
<SET DIR .VAL>
<COND (<EQUAL? .NW ,W?COMMA ,W?AND>
<PUT ,P-LEXV
<+ .PTR ,P-LEXELEN>
,W?THEN>)>
<COND (<NOT <G? .LEN 2>>
<SETG QUOTE-FLAG <>>
<RETURN>)>)
(<AND <SET VAL <WT? .WRD ,PS?VERB ,P1?VERB>>
<OR <NOT .VERB>
;<EQUAL? .VERB ,ACT?NAME>>>
;<COND (<EQUAL? .VERB ,ACT?NAME>
<SETG P-WHAT-IGNORED T>)>
<SET VERB .VAL>
<PUT ,P-ITBL ,P-VERB .VAL>
<PUT ,P-ITBL ,P-VERBN ,P-VTBL>
<PUT ,P-VTBL 0 .WRD>
<PUTB ,P-VTBL 2 <GETB ,P-LEXV
<SET NUM
<+ <* .PTR 2> 2>>>>
<PUTB ,P-VTBL 3 <GETB ,P-LEXV <+ .NUM 1>>>)
(<OR <SET VAL <WT? .WRD ,PS?PREPOSITION 0>>
<AND <OR <EQUAL? .WRD ,W?ONE ,W?A>
<EQUAL? .WRD ,W?BOTH ,W?ALL>
<WT? .WRD ,PS?ADJECTIVE>
<WT? .WRD ,PS?OBJECT>>
<SET VAL 0>>>
<COND (<AND <G? ,P-LEN 0>
<==? <GET ,P-LEXV
<+ .PTR ,P-LEXELEN>>
,W?OF>
<NOT <EQUAL? .VERB
,ACT?MAKE ,ACT?TAKE>>
<0? .VAL>
<NOT <EQUAL? .WRD ,W?ONE ,W?A>>
<NOT <EQUAL? .WRD ,W?ALL ,W?BOTH>>>)
(<AND <NOT <0? .VAL>>
<OR <0? ,P-LEN>
<EQUAL? <GET ,P-LEXV <+ .PTR 2>>
,W?THEN ,W?PERIOD>>>
<COND (<L? ,P-NCN 2>
<PUT ,P-ITBL ,P-PREP1 .VAL>
<PUT ,P-ITBL ,P-PREP1N .WRD>)>)
(<==? ,P-NCN 2>
<TELL
"(I found too many nouns in that sentence!)" CR>
<RFALSE>)
(T
<SETG P-NCN <+ ,P-NCN 1>>
<OR <SET PTR <CLAUSE .PTR .VAL .WRD>>
<RFALSE>>
<COND (<L? .PTR 0>
<SETG QUOTE-FLAG <>>
<RETURN>)>)>)
(<==? .WRD ,W?CLOSELY>
<SETG P-ADVERB ,W?CAREFULLY>)
(<OR <EQUAL? .WRD
,W?CAREFULLY ,W?QUIETLY ,W?PRIVATELY>
<EQUAL? .WRD
,W?SLOWLY ,W?QUICKLY ,W?BRIEFLY>>
<SETG P-ADVERB .WRD>)
(<WT? .WRD ,PS?BUZZ-WORD>)
(<AND <EQUAL? .VERB ,ACT?TELL>
<WT? .WRD ,PS?VERB ,P1?VERB>>
<TELL
"(Please consult your manual for the correct way to talk to characters.)" CR>
<RFALSE>)
(T
<CANT-USE .PTR>
<RFALSE>)>)
(T
<UNKNOWN-WORD .PTR>
<RFALSE>)>
<SET LW .WRD>
<SET PTR <+ .PTR ,P-LEXELEN>>>
<COND (.DIR
<COND (<EQUAL? .VERB ,ACT?FACE>
<SETG PRSA ,V?FACE>)
(T
<SETG PRSA ,V?WALK>)>
<SETG P-WALK-DIR .DIR>
<SETG PRSO .DIR>
<SETG P-OFLAG <>>
<RETURN T>)>
<SETG P-WALK-DIR <>>
<COND (<AND ,P-OFLAG
<ORPHAN-MERGE>>
<SETG WINNER .OWINNER>)>
<COND (<==? <GET ,P-ITBL ,P-VERB> 0>
<PUT ,P-ITBL ,P-VERB ,ACT?$CALL>)>
<COND (<AND <SYNTAX-CHECK> <SNARF-OBJECTS> <MANY-CHECK> <TAKE-CHECK>>
T)>>
<GLOBAL P-WALK-DIR <>>
"Check whether word pointed at by PTR is the correct part of speech.
The second argument is the part of speech (,PS?<part of speech>). The
3rd argument (,P1?<part of speech>), if given, causes the value
for that part of speech to be returned."
<ROUTINE WT? (PTR BIT "OPTIONAL" (B1 5) "AUX" (OFFS ,P-P1OFF) TYP)
<COND (<BTST <SET TYP <GETB .PTR ,P-PSOFF>> .BIT>
<COND (<G? .B1 4> <RTRUE>)
(T
<SET TYP <BAND .TYP ,P-P1BITS>>
<COND (<NOT <==? .TYP .B1>> <SET OFFS <+ .OFFS 1>>)>
<GETB .PTR .OFFS>)>)>>
"Scan through a noun phrase, leaving a pointer to its starting location:"
<ROUTINE CLAUSE (PTR VAL WRD "AUX" OFF NUM (ANDFLG <>) (FIRST?? T) NW (LW 0))
;#DECL ((PTR VAL OFF NUM) FIX (WRD NW) <OR FALSE FIX TABLE>
(ANDFLG FIRST??) <OR ATOM FALSE>)
<SET OFF <* <- ,P-NCN 1> 2>>
<COND (<NOT <==? .VAL 0>>
<PUT ,P-ITBL <SET NUM <+ ,P-PREP1 .OFF>> .VAL>
<PUT ,P-ITBL <+ .NUM 1> .WRD>
<SET PTR <+ .PTR ,P-LEXELEN>>)
(T <SETG P-LEN <+ ,P-LEN 1>>)>
<COND (<0? ,P-LEN> <SETG P-NCN <- ,P-NCN 1>> <RETURN -1>)>
<PUT ,P-ITBL <SET NUM <+ ,P-NC1 .OFF>> <REST ,P-LEXV <* .PTR 2>>>
<COND (<EQUAL? <GET ,P-LEXV .PTR> ,W?THE ,W?A ,W?AN>
<PUT ,P-ITBL .NUM <REST <GET ,P-ITBL .NUM> 4>>)>
<REPEAT ()
<COND (<L? <SETG P-LEN <- ,P-LEN 1>> 0>
<PUT ,P-ITBL <+ .NUM 1> <REST ,P-LEXV <* .PTR 2>>>
<RETURN -1>)>
<COND (<BUZZER-WORD? <SET WRD <GET ,P-LEXV .PTR>>>
<RFALSE>)
(<OR .WRD
<SET WRD <NUMBER? .PTR>>
;<SET WRD <NAME? .PTR>>>
<COND (<0? ,P-LEN> <SET NW 0>)
(T <SET NW <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>>)>
<COND (<AND <==? .WRD ,W?OF>
<EQUAL? <GET ,P-ITBL ,P-VERB>
,ACT?MAKE ,ACT?TAKE>>
<PUT ,P-LEXV .PTR ,W?WITH>
<SET WRD ,W?WITH>)>
<COND ;(<AND <EQUAL? .WRD ,W?PERIOD>
<EQUAL? .LW ,W?MRS ,W?MR>>
<SET LW 0>)
(<EQUAL? .WRD ,W?AND ,W?COMMA> <SET ANDFLG T>)
(<EQUAL? .WRD ,W?ALL ,W?BOTH ,W?ONE>
<COND (<==? .NW ,W?OF>
<SETG P-LEN <- ,P-LEN 1>>
<SET PTR <+ .PTR ,P-LEXELEN>>)>)
(<OR <EQUAL? .WRD ,W?THEN ,W?PERIOD>
<AND <WT? .WRD ,PS?PREPOSITION>
<GET ,P-ITBL ,P-VERB>
<NOT .FIRST??>>>
<SETG P-LEN <+ ,P-LEN 1>>
<PUT ,P-ITBL
<+ .NUM 1>
<REST ,P-LEXV <* .PTR 2>>>
<RETURN <- .PTR ,P-LEXELEN>>)
;"3/16/83: This clause used to be later."
(<AND .ANDFLG
<OR ;"3/25/83: next statement added."
<EQUAL? <GET ,P-ITBL ,P-VERBN> 0>
;"10/26/84: next stmt changed"
<VERB-DIR-ONLY? .WRD>>>
<SET PTR <- .PTR 4>>
<PUT ,P-LEXV <+ .PTR 2> ,W?THEN>
<SETG P-LEN <+ ,P-LEN 2>>)
(<WT? .WRD ,PS?OBJECT>
<COND (<AND <G? ,P-LEN 0>
<EQUAL? .NW ,W?OF>
<NOT <EQUAL? .WRD ,W?ALL ,W?ONE>>>
T)
(<AND <WT? .WRD
,PS?ADJECTIVE
,P1?ADJECTIVE>
<NOT <==? .NW 0>>
<WT? .NW ,PS?OBJECT>>)
(<AND <NOT .ANDFLG>
<NOT <EQUAL? .NW ,W?BUT ,W?EXCEPT>>
<NOT <EQUAL? .NW ,W?AND ,W?COMMA>>>
<PUT ,P-ITBL
<+ .NUM 1>
<REST ,P-LEXV <* <+ .PTR 2> 2>>>
<RETURN .PTR>)
(T <SET ANDFLG <>>)>)
(<AND <OR ,P-MERGED
,P-OFLAG
<NOT <EQUAL? <GET ,P-ITBL ,P-VERB> 0>>>
<OR <WT? .WRD ,PS?ADJECTIVE>
<WT? .WRD ,PS?BUZZ-WORD>>>)
(<AND .ANDFLG
<EQUAL? <GET ,P-ITBL ,P-VERB> 0>>
<SET PTR <- .PTR 4>>
<PUT ,P-LEXV <+ .PTR 2> ,W?THEN>
<SETG P-LEN <+ ,P-LEN 2>>)
(<WT? .WRD ,PS?PREPOSITION> T)
(T
<CANT-USE .PTR>
<RFALSE>)>)
(T <UNKNOWN-WORD .PTR> <RFALSE>)>
<SET LW .WRD>
<SET FIRST?? <>>
<SET PTR <+ .PTR ,P-LEXELEN>>>>
<ROUTINE VERB-DIR-ONLY? (WRD)
<AND <NOT <WT? .WRD ,PS?OBJECT>>
<NOT <WT? .WRD ,PS?ADJECTIVE>>
<OR <WT? .WRD ,PS?DIRECTION>
<WT? .WRD ,PS?VERB>>>>
<ROUTINE NUMBER? (PTR "AUX" CNT BPTR CHR (SUM 0) (TIM <>) (DOLLAR <>))
<SET CNT <GETB <REST ,P-LEXV <* .PTR 2>> 2>>
<SET BPTR <GETB <REST ,P-LEXV <* .PTR 2>> 3>>
;<SETG P-DOLLAR-FLAG <>>
<REPEAT ()
<COND (<L? <SET CNT <- .CNT 1>> 0> <RETURN>)
(T
<SET CHR <GETB ,P-INBUF .BPTR>>
<COND (<==? .CHR %<ASCII !\:>>
<SET TIM .SUM>
<SET SUM 0>)
(<G? .SUM 9999> <RFALSE>)
(<EQUAL? .CHR ,CURRENCY-SYMBOL>
<SET DOLLAR T>)
(<OR <G? .CHR %<ASCII !\9>>
<L? .CHR %<ASCII !\0>>>
<RFALSE>)
(T
<SET SUM <+ <* .SUM 10>
<- .CHR %<ASCII !\0>>>>)>
<SET BPTR <+ .BPTR 1>>)>>
<PUT ,P-LEXV .PTR ,W?NUMBER>
<COND (<G? .SUM 9999> <RFALSE>)
(.TIM
<COND ;"(<L? .TIM 8> <SET TIM <+ .TIM 12>>)"
(<G? .TIM 23> <RFALSE>)
;"(<G? .TIM 19> T)
(<G? .TIM 12> <RFALSE>)
(<G? .TIM 7> T)
(T <SET TIM <+ 12 .TIM>>)">
<SET SUM <+ .SUM <* .TIM 60>>>)>
<SETG P-DOLLAR-FLAG .DOLLAR>
<COND (<AND .DOLLAR <G? .SUM 0>>
<SETG P-AMOUNT .SUM>
,W?MONEY
;<FSET ,INTNUM ,VOWELBIT>
;<PUTP ,INTNUM ,P?SDESC "amount of money">)
(T
<SETG P-NUMBER .SUM>
<SETG P-DOLLAR-FLAG <>>
,W?NUMBER
;<FCLEAR ,INTNUM ,VOWELBIT>
;<PUTP ,INTNUM ,P?SDESC "number">)>>
<GLOBAL P-NUMBER -1>
<GLOBAL P-AMOUNT 0>
<GLOBAL P-DOLLAR-FLAG <>>
<CONSTANT CURRENCY-SYMBOL %<ASCII !\*>>
<GLOBAL P-DIRECTION 0>
"New ORPHAN-MERGE for TRAP Retrofix 6/21/84"
<ROUTINE ORPHAN-MERGE ("AUX" (CNT -1) TEMP VERB BEG END (ADJ <>) WRD)
<SETG P-OFLAG <>>
<COND (<WT? <SET WRD <GET <GET ,P-ITBL ,P-VERBN> 0>>
,PS?ADJECTIVE ,P1?ADJECTIVE>
<SET ADJ T>)
;"Following clause is retrofix #30, which handles case where one-word
response is both noun and verb. -JW 8/20/84"
(<AND <WT? .WRD ,PS?OBJECT ,P1?OBJECT>
<EQUAL? ,P-NCN 0>>
<PUT ,P-ITBL ,P-VERB 0>
<PUT ,P-ITBL ,P-VERBN 0>
<PUT ,P-ITBL ,P-NC1 <REST ,P-LEXV 2>>
<PUT ,P-ITBL ,P-NC1L <REST ,P-LEXV 6>>
<SETG P-NCN 1>)>
<COND (<AND <NOT <0? <SET VERB <GET ,P-ITBL ,P-VERB>>>>
<NOT .ADJ>
<NOT <==? .VERB <GET ,P-OTBL ,P-VERB>>>>
<RFALSE>)
(<==? ,P-NCN 2> <RFALSE>)
(<AND ,P-CONT
<==? .VERB ,ACT?TELL>>
<RFALSE>)
(<==? <GET ,P-OTBL ,P-NC1> 1>
<COND (<OR <==? <SET TEMP <GET ,P-ITBL ,P-PREP1>>
<GET ,P-OTBL ,P-PREP1>>
<0? .TEMP>>
<COND (.ADJ
<PUT ,P-OTBL ,P-NC1 <REST ,P-LEXV 2>>)
(T
<PUT ,P-OTBL ,P-NC1 <GET ,P-ITBL ,P-NC1>>)>
<COND (<EQUAL? <GET ,P-ITBL ,P-NC1L> 0>
<PUT ,P-ITBL ,P-NC1L <REST ,P-LEXV 6>>)>
<PUT ,P-OTBL ,P-NC1L <GET ,P-ITBL ,P-NC1L>>)
(T <RFALSE>)>)
(<==? <GET ,P-OTBL ,P-NC2> 1>
<COND (<OR <==? <SET TEMP <GET ,P-ITBL ,P-PREP1>>
<GET ,P-OTBL ,P-PREP2>>
<0? .TEMP>>
<COND (.ADJ
<PUT ,P-ITBL ,P-NC1 <REST ,P-LEXV 2>>)>
<PUT ,P-OTBL ,P-NC2 <GET ,P-ITBL ,P-NC1>>
<COND (<EQUAL? <GET ,P-ITBL ,P-NC1L> 0>
<PUT ,P-ITBL ,P-NC1L <REST ,P-LEXV 6>>)>
<PUT ,P-OTBL ,P-NC2L <GET ,P-ITBL ,P-NC1L>>
<SETG P-NCN 2>)
(T <RFALSE>)>)
(,P-ACLAUSE
<COND (<AND <NOT <==? ,P-NCN 1>> <NOT .ADJ>>
<SETG P-ACLAUSE <>>
<RFALSE>)
(T
<SET BEG <GET ,P-ITBL ,P-NC1>>
<COND (.ADJ <SET BEG <REST ,P-LEXV 2>> <SET ADJ <>>)>
<SET END <GET ,P-ITBL ,P-NC1L>>
<REPEAT ()
<SET WRD <GET .BEG 0>>
<COND (<==? .BEG .END>
<COND (.ADJ <ACLAUSE-WIN .ADJ> <RETURN>)
(T <SETG P-ACLAUSE <>> <RFALSE>)>)
(<AND <NOT .ADJ>
<OR <BTST <GETB .WRD ,P-PSOFF>
,PS?ADJECTIVE>
<EQUAL? .WRD ,W?ALL ,W?ONE>>>
<SET ADJ .WRD>)
(<==? .WRD ,W?ONE>
<ACLAUSE-WIN .ADJ>
<RETURN>)
(<BTST <GETB .WRD ,P-PSOFF> ,PS?OBJECT>
<COND (<EQUAL? .WRD ,P-ANAM>
<ACLAUSE-WIN .ADJ>)
(T
<NCLAUSE-WIN>)>
<RETURN>)>
<SET BEG <REST .BEG ,P-WORDLEN>>
<COND (<EQUAL? .END 0>
<SET END .BEG>
<SETG P-NCN 1>
<PUT ,P-ITBL ,P-NC1 <BACK .BEG 4>>
<PUT ,P-ITBL ,P-NC1L .BEG>)>>)>)>
<PUT ,P-VTBL 0 <GET ,P-OVTBL 0>>
<PUTB ,P-VTBL 2 <GETB ,P-OVTBL 2>>
<PUTB ,P-VTBL 3 <GETB ,P-OVTBL 3>>
<PUT ,P-OTBL ,P-VERBN ,P-VTBL>
<PUTB ,P-VTBL 2 0>
<COND (<NOT <==? <GET ,P-OTBL ,P-NC2> 0>> <SETG P-NCN 2>)
(T <SETG P-NCN 1>)>
<REPEAT ()
<COND (<G? <SET CNT <+ .CNT 1>> ,P-ITBLLEN>
<SETG P-MERGED T>
<RTRUE>)
(T <PUT ,P-ITBL .CNT <GET ,P-OTBL .CNT>>)>>
T>
"New ACLAUSE-WIN for TRAP retrofix 6/21/84"
<ROUTINE ACLAUSE-WIN (ADJ)
<PUT ,P-ITBL ,P-VERB <GET ,P-OTBL ,P-VERB>>
<PUT ,P-CCTBL ,CC-SBPTR ,P-ACLAUSE>
<PUT ,P-CCTBL ,CC-SEPTR <+ ,P-ACLAUSE 1>>
<PUT ,P-CCTBL ,CC-DBPTR ,P-ACLAUSE>
<PUT ,P-CCTBL ,CC-DEPTR <+ ,P-ACLAUSE 1>>
<CLAUSE-COPY ,P-OTBL ,P-OTBL .ADJ>
<AND <NOT <==? <GET ,P-OTBL ,P-NC2> 0>> <SETG P-NCN 2>>
<SETG P-ACLAUSE <>>
<RTRUE>>
<ROUTINE NCLAUSE-WIN ()
<PUT ,P-CCTBL ,CC-SBPTR ,P-NC1>
<PUT ,P-CCTBL ,CC-SEPTR ,P-NC1L>
<PUT ,P-CCTBL ,CC-DBPTR ,P-ACLAUSE>
<PUT ,P-CCTBL ,CC-DEPTR <+ ,P-ACLAUSE 1>>
<CLAUSE-COPY ,P-ITBL ,P-OTBL>
<AND <NOT <==? <GET ,P-OTBL ,P-NC2> 0>> <SETG P-NCN 2>>
<SETG P-ACLAUSE <>>
<RTRUE>>
"Print undefined word in input.
PTR points to the unknown word in P-LEXV"
<ROUTINE WORD-PRINT (CNT BUF)
;<COND (<G? .CNT 6> <SET CNT 6>)>
<REPEAT ()
<COND (<DLESS? CNT 0> <RETURN>)
(ELSE
<PRINTC <GETB ,P-INBUF .BUF>>
<SET BUF <+ .BUF 1>>)>>>
<GLOBAL UNKNOWN-MSGS
<PLTABLE
<PTABLE "(I don't know the word \""
"\".)">
<PTABLE "(Sorry, but the word \""
"\" is not in the vocabulary that you can use.)">
<PTABLE "(You don't need to use the word \""
"\" to finish this story.)">
<PTABLE "(Sorry, but the program doesn't recognize the word \""
"\".)">>>
<ROUTINE UNKNOWN-WORD (PTR "AUX" BUF MSG)
<SET MSG <PICK-ONE ,UNKNOWN-MSGS>>
<COND (T ;<EQUAL? ,WINNER ,PLAYER>
<TELL <GET .MSG 0>>)
;(T <TELL "\"Please, I not know English word '">)>
<WORD-PRINT <GETB <REST ,P-LEXV <SET BUF <* .PTR 2>>> 2>
<GETB <REST ,P-LEXV .BUF> 3>>
<SETG QUOTE-FLAG <>>
<SETG P-OFLAG <>>
<COND (T ;<EQUAL? ,WINNER ,PLAYER>
<TELL <GET .MSG 1> CR>)
;(T <TELL "'.\"" CR>)>>
<ROUTINE CANT-USE (PTR "AUX" BUF)
;#DECL ((PTR BUF) FIX)
<SETG QUOTE-FLAG <>>
<SETG P-OFLAG <>>
<COND (T ;<EQUAL? ,WINNER ,PLAYER>
<TELL "(Sorry, but I don't understand the word \"">
<WORD-PRINT <GETB <REST ,P-LEXV <SET BUF <* .PTR 2>>> 2>
<GETB <REST ,P-LEXV .BUF> 3>>
<TELL "\" when you use it that way.)" CR>)
;(T <TELL "\"Please, to me simple English speak.\"" CR>)>>
" Perform syntax matching operations, using P-ITBL as the source of
the verb and adjectives for this input. Returns false if no
syntax matches, and does it's own orphaning. If return is true,
the syntax is saved in P-SYNTAX."
<GLOBAL P-SLOCBITS 0>
<CONSTANT P-SYNLEN 8>
<CONSTANT P-SBITS 0>
<CONSTANT P-SPREP1 1>
<CONSTANT P-SPREP2 2>
<CONSTANT P-SFWIM1 3>
<CONSTANT P-SFWIM2 4>
<CONSTANT P-SLOC1 5>
<CONSTANT P-SLOC2 6>
<CONSTANT P-SACTION 7>
<CONSTANT P-SONUMS 3>
<ROUTINE SYNTAX-CHECK ("AUX" SYN LEN NUM OBJ (DRIVE1 <>) (DRIVE2 <>)
PREP VERB)
;#DECL ((DRIVE1 DRIVE2) <OR FALSE <PRIMTYPE VECTOR>>
(SYN) <PRIMTYPE VECTOR> (LEN NUM VERB PREP) FIX
(OBJ) <OR FALSE OBJECT>)
<COND (<0? <SET VERB <GET ,P-ITBL ,P-VERB>>>
<MISSING-VERB>
<RFALSE>)>
<SET SYN <GET ,VERBS <- 255 .VERB>>>
<SET LEN <GETB .SYN 0>>
<SET SYN <REST .SYN>>
<REPEAT ()
<SET NUM <BAND <GETB .SYN ,P-SBITS> ,P-SONUMS>>
<COND (<G? ,P-NCN .NUM> T) ;"Added 4/27/83"
(<AND <NOT <L? .NUM 1>>
<0? ,P-NCN>
<OR <0? <SET PREP <GET ,P-ITBL ,P-PREP1>>>
<==? .PREP <GETB .SYN ,P-SPREP1>>>>
<SET DRIVE1 .SYN>)
(<==? <GETB .SYN ,P-SPREP1> <GET ,P-ITBL ,P-PREP1>>
<COND (<AND <==? .NUM 2> <==? ,P-NCN 1>>
<SET DRIVE2 .SYN>)
(<==? <GETB .SYN ,P-SPREP2>
<GET ,P-ITBL ,P-PREP2>>
<SYNTAX-FOUND .SYN>
<RTRUE>)>)>
<COND (<DLESS? LEN 1>
<COND (<OR .DRIVE1 .DRIVE2> <RETURN>)
(T
<DONT-UNDERSTAND>
<RFALSE>)>)
(T <SET SYN <REST .SYN ,P-SYNLEN>>)>>
<COND (<AND .DRIVE1
<SET OBJ
<GWIM <GETB .DRIVE1 ,P-SFWIM1>
<GETB .DRIVE1 ,P-SLOC1>
<GETB .DRIVE1 ,P-SPREP1>>>>
<PUT ,P-PRSO ,P-MATCHLEN 1>
<PUT ,P-PRSO 1 .OBJ>
<SYNTAX-FOUND .DRIVE1>)
(<AND .DRIVE2
<SET OBJ
<GWIM <GETB .DRIVE2 ,P-SFWIM2>
<GETB .DRIVE2 ,P-SLOC2>
<GETB .DRIVE2 ,P-SPREP2>>>>
<PUT ,P-PRSI ,P-MATCHLEN 1>
<PUT ,P-PRSI 1 .OBJ>
<SYNTAX-FOUND .DRIVE2>)
(<EQUAL? .VERB ,ACT?FIND ,ACT?NAME>
<TELL "(Sorry, but I can't answer that question.)" CR>
<RFALSE>)
(T
<COND (<EQUAL? ,WINNER ,PLAYER>
<ORPHAN .DRIVE1 .DRIVE2>
<TELL "(Wh"
<COND (<EQUAL? .VERB ,ACT?WALK ,ACT?FACE> "ere")
(T "at")>
" do you want to ">)
(T
<TELL
"(Your command was not complete. Next time, type wh"
<COND (<EQUAL? .VERB ,ACT?WALK ,ACT?FACE> "ere") (T "at")>
" you want" THE ,WINNER " to ">)>
<VERB-PRINT>
<COND (.DRIVE2
<CLAUSE-PRINT ,P-NC1 ,P-NC1L>)>
<PREP-PRINT <COND (.DRIVE1 <GETB .DRIVE1 ,P-SPREP1>)
(T <GETB .DRIVE2 ,P-SPREP2>)>>
<COND (<EQUAL? ,WINNER ,PLAYER>
<SETG P-OFLAG T>
<TELL "?)" CR>)
(T
<SETG P-OFLAG <>>
<TELL ".)" CR>)>
<RFALSE>)>>
<ROUTINE DONT-UNDERSTAND ()
<TELL
"(Sorry, but I don't understand. Please reword that or try something else.)"
CR>>
<ROUTINE VERB-PRINT ("AUX" TMP)
<SET TMP <GET ,P-ITBL ,P-VERBN>> ;"? ,P-OTBL?"
<COND (<==? .TMP 0> <TELL "tell">)
(<0? <GETB ,P-VTBL 2>>
<PRINTB <GET .TMP 0>>)
(T
<WORD-PRINT <GETB .TMP 2> <GETB .TMP 3>>
<PUTB ,P-VTBL 2 0>)>>
<ROUTINE ORPHAN (D1 D2 "AUX" (CNT -1))
;#DECL ((D1 D2) <OR FALSE <PRIMTYPE VECTOR>>)
<COND (<NOT ,P-MERGED>
<PUT ,P-OCLAUSE ,P-MATCHLEN 0>)>
<PUT ,P-OVTBL 0 <GET ,P-VTBL 0>>
<PUTB ,P-OVTBL 2 <GETB ,P-VTBL 2>>
<PUTB ,P-OVTBL 3 <GETB ,P-VTBL 3>>
<REPEAT ()
<COND (<IGRTR? CNT ,P-ITBLLEN> <RETURN>)
(T <PUT ,P-OTBL .CNT <GET ,P-ITBL .CNT>>)>>
<COND (<==? ,P-NCN 2>
<PUT ,P-CCTBL ,CC-SBPTR ,P-NC2>
<PUT ,P-CCTBL ,CC-SEPTR ,P-NC2L>
<PUT ,P-CCTBL ,CC-DBPTR ,P-NC2>
<PUT ,P-CCTBL ,CC-DEPTR ,P-NC2L>
<CLAUSE-COPY ,P-ITBL ,P-OTBL>)>
<COND (<NOT <L? ,P-NCN 1>>
<PUT ,P-CCTBL ,CC-SBPTR ,P-NC1>
<PUT ,P-CCTBL ,CC-SEPTR ,P-NC1L>
<PUT ,P-CCTBL ,CC-DBPTR ,P-NC1>
<PUT ,P-CCTBL ,CC-DEPTR ,P-NC1L>
<CLAUSE-COPY ,P-ITBL ,P-OTBL>)>
<COND (.D1
<PUT ,P-OTBL ,P-PREP1 <GETB .D1 ,P-SPREP1>>
<PUT ,P-OTBL ,P-NC1 1>)
(.D2
<PUT ,P-OTBL ,P-PREP2 <GETB .D2 ,P-SPREP2>>
<PUT ,P-OTBL ,P-NC2 1>)>>
<ROUTINE CLAUSE-PRINT (BPTR EPTR "OPTIONAL" (THE? T))
<BUFFER-PRINT <GET ,P-ITBL .BPTR> <GET ,P-ITBL .EPTR> .THE?>>
<ROUTINE BUFFER-PRINT (BEG END CP "AUX" (NOSP <>) WRD (FIRST?? T) (PN <>))
<REPEAT ()
<COND (<==? .BEG .END> <RETURN>)
(T
<COND (.NOSP <SET NOSP <>>)
(T <TELL " ">)>
<SET WRD <GET .BEG 0>>
<COND (<OR <AND <EQUAL? .WRD ,W?HIM>
<NOT <VISIBLE? ,P-HIM-OBJECT>>>
<AND <EQUAL? .WRD ,W?HER>
<NOT <VISIBLE? ,P-HER-OBJECT>>>
<AND <EQUAL? .WRD ,W?THEM>
<NOT <VISIBLE? ,P-THEM-OBJECT>>>>
<SET PN T>)>
<COND (<==? .WRD ,W?PERIOD>
<SET NOSP T>)
(<EQUAL? .WRD ,W?ME>
<PRINTD ,PLAYER>
<SET PN T>)
(<CAPITAL-NOUN? .WRD>
<CAPITALIZE .BEG>
<SET PN T>)
(T
<COND (<AND .FIRST?? <NOT .PN> .CP>
<TELL "the ">)>
<COND (<OR ,P-OFLAG ,P-MERGED> <PRINTB .WRD>)
(<AND <==? .WRD ,W?IT>
<VISIBLE? ,P-IT-OBJECT>>
<PRINTD ,P-IT-OBJECT>)
(<AND <EQUAL? .WRD ,W?HER>
<NOT .PN> ;"VISIBLE check above"
;<VISIBLE? ,P-HER-OBJECT>>
<PRINTD ,P-HER-OBJECT>)
(<AND <EQUAL? .WRD ,W?THEM>
<NOT .PN>
;<VISIBLE? ,P-THEM-OBJECT>>
<PRINTD ,P-THEM-OBJECT>)
(<AND <EQUAL? .WRD ,W?HIM>
<NOT .PN>
;<VISIBLE? ,P-HIM-OBJECT>>
<PRINTD ,P-HIM-OBJECT>)
(T
<WORD-PRINT <GETB .BEG 2>
<GETB .BEG 3>>)>
<SET FIRST?? <>>)>)>
<SET BEG <REST .BEG ,P-WORDLEN>>>>
<ROUTINE CAPITAL-NOUN? (WRD)
<OR <EQUAL? .WRD ,W?FRBZ ,W?GRNZ ,W?GOLA>
<EQUAL? .WRD ,W?KNUT ,W?HRNG ,W?WIEN>>>
<ROUTINE CAPITALIZE (PTR)
<PRINTC <- <GETB ,P-INBUF <GETB .PTR 3>> 32>>
<WORD-PRINT <- <GETB .PTR 2> 1> <+ <GETB .PTR 3> 1>>>
<ROUTINE PREP-PRINT (PREP "OPTIONAL" (SP? T) "AUX" WRD)
;#DECL ((PREP) FIX)
<COND (<NOT <0? .PREP>>
<COND (.SP? <TELL " ">)>
<SET WRD <PREP-FIND .PREP>>
<COND (<==? .WRD ,W?AGAINST> <TELL "against">)
(<==? .WRD ,W?THROUGH> <TELL "through">)
(T <PRINTB .WRD>)>
<COND (<AND <==? ,W?SIT <GET <GET ,P-ITBL ,P-VERBN> 0>>
<==? ,W?DOWN .WRD>>
<TELL " on">)>
<COND (<AND <==? ,W?GET <GET <GET ,P-ITBL ,P-VERBN> 0>>
<==? ,W?OUT .WRD>> ;"Will it ever work? --SWG"
<TELL " of">)>
<RTRUE>)>>
<GLOBAL P-CCTBL <TABLE 0 0 0 0>>
"pointers used by CLAUSE-COPY (source/destination beginning/end pointers)"
<CONSTANT CC-SBPTR 0>
<CONSTANT CC-SEPTR 1>
<CONSTANT CC-DBPTR 2>
<CONSTANT CC-DEPTR 3>
<ROUTINE CLAUSE-COPY (SRC DEST "OPTIONAL" (INSRT <>) "AUX" BEG END)
<SET BEG <GET .SRC <GET ,P-CCTBL ,CC-SBPTR>>>
<SET END <GET .SRC <GET ,P-CCTBL ,CC-SEPTR>>>
<PUT .DEST
<GET ,P-CCTBL ,CC-DBPTR>
<REST ,P-OCLAUSE
<+ <* <GET ,P-OCLAUSE ,P-MATCHLEN> ,P-LEXELEN> 2>>>
<REPEAT ()
<COND (<==? .BEG .END>
<PUT .DEST
<GET ,P-CCTBL ,CC-DEPTR>
<REST ,P-OCLAUSE
<+ <* <GET ,P-OCLAUSE ,P-MATCHLEN> ,P-LEXELEN>
2>>>
<RETURN>)
(T
<COND (<AND .INSRT <==? ,P-ANAM <GET .BEG 0>>>
<CLAUSE-ADD .INSRT>)>
<CLAUSE-ADD <GET .BEG 0>>)>
<SET BEG <REST .BEG ,P-WORDLEN>>>>
<ROUTINE CLAUSE-ADD (WRD "AUX" PTR)
;#DECL ((WRD) TABLE (PTR) FIX)
<SET PTR <+ <GET ,P-OCLAUSE ,P-MATCHLEN> 2>>
<PUT ,P-OCLAUSE <- .PTR 1> .WRD>
<PUT ,P-OCLAUSE .PTR 0>
<PUT ,P-OCLAUSE ,P-MATCHLEN .PTR>>
<ROUTINE PREP-FIND (PREP "AUX" (CNT 0) SIZE)
;#DECL ((PREP CNT SIZE) FIX)
<SET SIZE <* <GET ,PREPOSITIONS 0> 2>>
<REPEAT ()
<COND (<IGRTR? CNT .SIZE> <RFALSE>)
(<==? <GET ,PREPOSITIONS .CNT> .PREP>
<RETURN <GET ,PREPOSITIONS <- .CNT 1>>>)>>>
<ROUTINE SYNTAX-FOUND (SYN)
;#DECL ((SYN) <PRIMTYPE VECTOR>)
<SETG P-SYNTAX .SYN>
<SETG PRSA <GETB .SYN ,P-SACTION>>>
<GLOBAL P-GWIMBIT 0>
<ROUTINE GWIM (GBIT LBIT PREP "AUX" OBJ WPREP)
;#DECL ((GBIT LBIT) FIX (OBJ) OBJECT)
<COND (<==? .GBIT ,RMUNGBIT>
<RETURN ,ROOMS>)>
<SETG P-GWIMBIT .GBIT>
<SETG P-SLOCBITS .LBIT>
<PUT ,P-MERGE ,P-MATCHLEN 0>
<COND (<GET-OBJECT ,P-MERGE <>>
<SETG P-GWIMBIT 0>
<COND (<==? <GET ,P-MERGE ,P-MATCHLEN> 1>
<SET OBJ <GET ,P-MERGE 1>>
<TELL "(">
<COND (<PREP-PRINT .PREP <>>
<THE? .OBJ>
<TELL " ">)>
<TELL D .OBJ ")" CR>
.OBJ)>)
(T <SETG P-GWIMBIT 0> <RFALSE>)>>
<ROUTINE SNARF-OBJECTS ("AUX" PTR)
;#DECL ((PTR) <OR FIX <PRIMTYPE VECTOR>>)
<COND (<NOT <==? <SET PTR <GET ,P-ITBL ,P-NC1>> 0>>
<SETG P-SLOCBITS <GETB ,P-SYNTAX ,P-SLOC1>>
<OR <SNARFEM .PTR <GET ,P-ITBL ,P-NC1L> ,P-PRSO> <RFALSE>>
<OR <0? <GET ,P-BUTS ,P-MATCHLEN>>
<SETG P-PRSO <BUT-MERGE ,P-PRSO>>>)>
<COND (<NOT <==? <SET PTR <GET ,P-ITBL ,P-NC2>> 0>>
<SETG P-SLOCBITS <GETB ,P-SYNTAX ,P-SLOC2>>
<OR <SNARFEM .PTR <GET ,P-ITBL ,P-NC2L> ,P-PRSI> <RFALSE>>
<COND (<NOT <0? <GET ,P-BUTS ,P-MATCHLEN>>>
<COND (<==? <GET ,P-PRSI ,P-MATCHLEN> 1>
<SETG P-PRSO <BUT-MERGE ,P-PRSO>>)
(T <SETG P-PRSI <BUT-MERGE ,P-PRSI>>)>)>)>
<RTRUE>>
<ROUTINE BUT-MERGE (TBL "AUX" LEN BUTLEN (CNT 1) (MATCHES 0) OBJ NTBL)
;#DECL ((TBL NTBL) TABLE (LEN BUTLEN MATCHES) FIX (OBJ) OBJECT)
<SET LEN <GET .TBL ,P-MATCHLEN>>
<PUT ,P-MERGE ,P-MATCHLEN 0>
<REPEAT ()
<COND (<DLESS? LEN 0> <RETURN>)
(<ZMEMQ <SET OBJ <GET .TBL .CNT>> ,P-BUTS>)
(T
<PUT ,P-MERGE <+ .MATCHES 1> .OBJ>
<SET MATCHES <+ .MATCHES 1>>)>
<SET CNT <+ .CNT 1>>>
<PUT ,P-MERGE ,P-MATCHLEN .MATCHES>
<SET NTBL ,P-MERGE>
<SETG P-MERGE .TBL>
.NTBL>
<GLOBAL P-NAM <>>
<GLOBAL P-XNAM <>>
<GLOBAL P-ADJ <>>
<GLOBAL P-XADJ <>>
<GLOBAL P-ADJN <>>
<GLOBAL P-XADJN <>>
<GLOBAL P-PRSO <ITABLE NONE 25>>
<GLOBAL P-PRSI <ITABLE NONE 25>>
<GLOBAL P-BUTS <ITABLE NONE 25>>
<GLOBAL P-MERGE <ITABLE NONE 25>>
<GLOBAL P-OCLAUSE <ITABLE NONE 25>>
<GLOBAL P-MATCHLEN 0>
<GLOBAL P-GETFLAGS 0>
<CONSTANT P-ALL 1>
<CONSTANT P-ONE 2>
<CONSTANT P-INHIBIT 4>
<GLOBAL P-CSPTR <>>
<GLOBAL P-CEPTR <>>
<GLOBAL P-AND <>>
<ROUTINE SNARFEM (PTR EPTR TBL "AUX" (BUT <>) LEN WV WRD NW)
;"Next SETG 6/21/84 for WHICH retrofix"
<SETG P-AND <>>
<SETG P-GETFLAGS 0>
<SETG P-CSPTR .PTR>
<SETG P-CEPTR .EPTR>
<PUT ,P-BUTS ,P-MATCHLEN 0>
<PUT .TBL ,P-MATCHLEN 0>
<SET WRD <GET .PTR 0>>
<REPEAT ()
<COND (<==? .PTR .EPTR> <RETURN <GET-OBJECT <OR .BUT .TBL>>>)
(T
<SET NW <GET .PTR ,P-LEXELEN>>
<COND (<EQUAL? .WRD ,W?ALL ,W?BOTH>
<SETG P-GETFLAGS ,P-ALL>
<COND (<==? .NW ,W?OF>
<SET PTR <REST .PTR ,P-WORDLEN>>)>)
(<EQUAL? .WRD ,W?BUT ,W?EXCEPT>
<OR <GET-OBJECT <OR .BUT .TBL>> <RFALSE>>
<SET BUT ,P-BUTS>
<PUT .BUT ,P-MATCHLEN 0>)
(<BUZZER-WORD? .WRD>
<RFALSE>)
(<EQUAL? .WRD ,W?A ,W?ONE>
<COND (<NOT ,P-ADJ>
<SETG P-GETFLAGS ,P-ONE>
<COND (<==? .NW ,W?OF>
<SET PTR <REST .PTR ,P-WORDLEN>>)>)
(T
<SETG P-NAM ,P-ONEOBJ>
<OR <GET-OBJECT <OR .BUT .TBL>> <RFALSE>>
<AND <0? .NW> <RTRUE>>)>)
(<AND <EQUAL? .WRD ,W?AND ,W?COMMA>
<NOT <EQUAL? .NW ,W?AND ,W?COMMA>>>
;"Next SETG 6/21/84 for WHICH retrofix"
<SETG P-AND T>
<OR <GET-OBJECT <OR .BUT .TBL>> <RFALSE>>
T)
(<WT? .WRD ,PS?BUZZ-WORD>)
(<EQUAL? .WRD ,W?AND ,W?COMMA>)
(<==? .WRD ,W?OF>
<COND (<0? ,P-GETFLAGS>
<SETG P-GETFLAGS ,P-INHIBIT>)>)
(<AND <SET WV <WT? .WRD ,PS?ADJECTIVE ,P1?ADJECTIVE>>
<NOT ,P-ADJ>>
<SETG P-ADJ .WV>
<SETG P-ADJN .WRD>)
(<WT? .WRD ,PS?OBJECT ,P1?OBJECT>
<SETG P-NAM .WRD>
<SETG P-ONEOBJ .WRD>)>)>
<COND (<NOT <==? .PTR .EPTR>>
<SET PTR <REST .PTR ,P-WORDLEN>>
<SET WRD .NW>)>>>
<CONSTANT SH 128>
<CONSTANT SC 64>
<CONSTANT SIR 32>
<CONSTANT SOG 16>
<CONSTANT STAKE 8>
<CONSTANT SMANY 4>
<CONSTANT SHAVE 2>
<ROUTINE GET-OBJECT (TBL
"OPTIONAL" (VRB T)
"AUX" BTS LEN XBITS TLEN (GCHECK <>) (OLEN 0) OBJ ADJ)
;#DECL ((TBL) TABLE (XBITS BTS TLEN LEN) FIX (GWIM) <OR FALSE FIX>
(VRB GCHECK) <OR ATOM FALSE>)
<SET XBITS ,P-SLOCBITS>
<SET TLEN <GET .TBL ,P-MATCHLEN>>
;<COND (,DEBUG <TELL "[GETOBJ: TLEN=" N .TLEN "]" CR>)>
<COND (<BTST ,P-GETFLAGS ,P-INHIBIT> <RTRUE>)>
<SET ADJ ,P-ADJN>
<COND (<AND <NOT ,P-NAM> ,P-ADJ>
<COND (<WT? ,P-ADJN ,PS?OBJECT ,P1?OBJECT>
<SETG P-NAM ,P-ADJN>
<SETG P-ADJ <>>)
(<SET BTS <WT? ,P-ADJN ,PS?DIRECTION ,P1?DIRECTION>>
<SETG P-ADJ <>>
<PUT .TBL ,P-MATCHLEN 1>
<PUT .TBL 1 ,INTDIR>
<SETG P-DIRECTION .BTS>
<RTRUE>)>)>
<COND (<AND <NOT ,P-NAM>
<NOT ,P-ADJ>
<NOT <==? ,P-GETFLAGS ,P-ALL>>
<0? ,P-GWIMBIT>>
<COND (.VRB <MISSING-NOUN .ADJ>)>
<RFALSE>)>
<COND (<OR <NOT <==? ,P-GETFLAGS ,P-ALL>> <0? ,P-SLOCBITS>>
<SETG P-SLOCBITS -1>)>
<SETG P-TABLE .TBL>
<PROG ()
;<COND (,DEBUG <TELL "[GETOBJ: GCHECK=" N .GCHECK "]" CR>)>
<COND (.GCHECK
;<COND (,DEBUG <TELL "[GETOBJ: calling GLOBAL-CHECK]" CR>)>
<GLOBAL-CHECK .TBL>)
(T
<COND (,LIT
<FCLEAR ,PLAYER ,TRANSBIT>
<DO-SL ,HERE ,SOG ,SIR>
<FSET ,PLAYER ,TRANSBIT>)>
<DO-SL ,PLAYER ,SH ,SC>)>
<SET LEN <- <GET .TBL ,P-MATCHLEN> .TLEN>>
;<COND (,DEBUG <TELL "[GETOBJ: LEN=" N .LEN "]" CR>)>
<COND (<BTST ,P-GETFLAGS ,P-ALL>)
(<AND <BTST ,P-GETFLAGS ,P-ONE>
<NOT <0? .LEN>>>
<COND (<NOT <==? .LEN 1>>
<PUT .TBL 1 <GET .TBL <RANDOM .LEN>>>
<TELL "(How about" THE <GET .TBL 1> "?)" CR>)>
<PUT .TBL ,P-MATCHLEN 1>)
(<OR <G? .LEN 1>
<AND <0? .LEN> <NOT <==? ,P-SLOCBITS -1>>>>
<COND (<==? ,P-SLOCBITS -1>
<SETG P-SLOCBITS .XBITS>
<SET OLEN .LEN>
<PUT .TBL ,P-MATCHLEN <- <GET .TBL ,P-MATCHLEN> .LEN>>
<AGAIN>)
(T
<COND (<0? .LEN> <SET LEN .OLEN>)>
<COND (<AND ,P-NAM
;<REMOTE-VERB?>
<SET OBJ <GET .TBL <+ .TLEN 1>>>
<SET OBJ <APPLY <GETP .OBJ ,P?GENERIC> .TBL>>>
<COND (<==? .OBJ ,NOT-HERE-OBJECT>
<RFALSE>)>
<PUT .TBL 1 .OBJ>
<PUT .TBL ,P-MATCHLEN 1>
<SETG P-NAM <>>
<SETG P-ADJ <>>
;<SETG P-ADJN <>>
<RTRUE>)
(<NOT <==? ,WINNER ,PLAYER>>
<CANT-ORPHAN>
<RFALSE>)
(<AND .VRB ,P-NAM>
<WHICH-PRINT .TLEN .LEN .TBL>
<SETG P-ACLAUSE
<COND (<==? .TBL ,P-PRSO> ,P-NC1)
(T ,P-NC2)>>
<SETG P-AADJ ,P-ADJ>
<SETG P-ANAM ,P-NAM>
<ORPHAN <> <>>
<SETG P-OFLAG T>)
(.VRB
<MISSING-NOUN .ADJ>)>
<SETG P-NAM <>>
<SETG P-ADJ <>>
<RFALSE>)>)
(<AND <0? .LEN> .GCHECK>
<COND (.VRB
<COND (<OR ,LIT <SPEAKING-VERB?>>
<OBJ-FOUND ,NOT-HERE-OBJECT .TBL>
<SETG P-XNAM ,P-NAM>
<SETG P-XADJ ,P-ADJ>
<SETG P-XADJN ,P-ADJN>
<SETG P-NAM <>>
<SETG P-ADJ <>>
<SETG P-ADJN <>>
<RTRUE>)
(T <TOO-DARK>)>)>
<SETG P-NAM <>>
<SETG P-ADJ <>>
<RFALSE>)
(<0? .LEN>
<SET GCHECK T>
;<COND (,DEBUG <TELL "[GETOBJ: GCHECK set to " N .GCHECK "]" CR>)>
<AGAIN>)>
<COND (<AND ,P-ADJ <NOT ,P-NAM>>
<TELL ,I-ASSUME THE <GET .TBL <+ .TLEN ;0 1>> ".)" CR>)>
<SETG P-SLOCBITS .XBITS>
<SETG P-NAM <>>
<SETG P-ADJ <>>
<RTRUE>>>
<ROUTINE SPEAKING-VERB? ("OPTIONAL" (V <>))
<COND (<NOT .V> <SET V ,PRSA>)>
<COND (<EQUAL? .V ,V?$CALL ,V?ASK ,V?ASK-ABOUT> <RTRUE>)
(<EQUAL? .V ,V?ASK-FOR ,V?GOODBYE ,V?HELLO> <RTRUE>)
(<EQUAL? .V ,V?NO ,V?TELL ,V?TELL-ABOUT> <RTRUE>)
(<EQUAL? .V ,V?YES ,V?TALK-ABOUT> <RTRUE>)
(<EQUAL? .V ,V?ASK-CONTEXT-ABOUT ,V?ASK-CONTEXT-FOR> <RTRUE>)>>
<ROUTINE CANT-ORPHAN ()
<TELL "(Please try saying that another way.)" CR>
<RFALSE>>
<ROUTINE MISSING-NOUN (ADJ)
<COND ;(<EQUAL? .ADJ ,W?NUMBER>
<TELL "(Please use units with numbers.)" CR>)
(T <TELL
"(I couldn't find enough nouns in that sentence!)" CR>)>>
<ROUTINE MISSING-VERB ()
<TELL "(I couldn't find a verb in that sentence!)" CR>>
<ROUTINE MOBY-FIND (TBL "AUX" (OBJ 1) LEN FOO)
<SETG P-NAM ,P-XNAM>
<SETG P-ADJ ,P-XADJ>
<PUT .TBL ,P-MATCHLEN 0>
<COND (<NOT <ZERO? <GETB 0 18>>> ;"ZIP case"
<REPEAT ()
<COND (<AND <SET FOO <META-LOC .OBJ T>>
<SET FOO <THIS-IT? .OBJ>>>
<SET FOO <OBJ-FOUND .OBJ .TBL>>)>
<COND (<IGRTR? OBJ ,PSEUDO-OBJECT> ;"last object"
<RETURN>)>>
<SET LEN <GET .TBL ,P-MATCHLEN>>
<COND (<EQUAL? .LEN 1>
<SETG P-MOBY-FOUND <GET .TBL 1>>)>
.LEN)
(T ;"ZIL case"
<SETG P-MOBY-FLAG T>
<SETG P-TABLE .TBL>
<SETG P-SLOCBITS -1>
<SET FOO <FIRST? ,ROOMS>>
<REPEAT ()
<COND (<NOT .FOO> <RETURN>)
(T
<SEARCH-LIST .FOO .TBL ,P-SRCALL>
<SET FOO <NEXT? .FOO>>)>>
<COND (<EQUAL? <SET LEN <GET .TBL ,P-MATCHLEN>> 0>
<DO-SL ,LOCAL-GLOBALS 1 1>)>
<COND (<EQUAL? <SET LEN <GET .TBL ,P-MATCHLEN>> 0>
<DO-SL ,ROOMS 1 1>)>
<COND (<EQUAL? <SET LEN <GET .TBL ,P-MATCHLEN>> 1>
<SETG P-MOBY-FOUND <GET .TBL 1>>)>
<SETG P-MOBY-FLAG <>>
.LEN)>>
<GLOBAL P-MOBY-FOUND <>>
<GLOBAL P-MOBY-FLAG <>>
<ROUTINE WHICH-PRINT (TLEN LEN TBL "AUX" OBJ RLEN)
<SET RLEN .LEN>
<TELL "(Which">
<COND (<OR ,P-OFLAG ,P-MERGED ,P-AND> <TELL " "> <PRINTB ,P-NAM>)
(<==? .TBL ,P-PRSO>
<CLAUSE-PRINT ,P-NC1 ,P-NC1L <>>)
(T <CLAUSE-PRINT ,P-NC2 ,P-NC2L <>>)>
<TELL " do you mean,">
<REPEAT ()
<SET TLEN <+ .TLEN 1>>
<SET OBJ <GET .TBL .TLEN>>
<TELL THE .OBJ>
<COND (<==? .LEN 2>
<COND (<NOT <==? .RLEN 2>> <TELL ",">)>
<TELL " or">)
(<G? .LEN 2> <TELL ",">)>
<COND (<L? <SET LEN <- .LEN 1>> 1>
<TELL "?)" CR>
<RETURN>)>>>
<ROUTINE GLOBAL-CHECK (TBL "AUX" LEN RMG RMGL (CNT 0) OBJ OBITS FOO)
;#DECL((TBL) TABLE (RMG) <OR FALSE TABLE> (RMGL CNT) FIX (OBJ) OBJECT)
<SET LEN <GET .TBL ,P-MATCHLEN>>
<SET OBITS ,P-SLOCBITS>
<COND (<SET RMG <GETPT ,HERE ,P?GLOBAL>>
<SET RMGL <- <PTSIZE .RMG> 1>>
;<COND (,DEBUG <TELL "[GLBCHK: (LG) RMGL=" N .RMGL "]" CR>)>
<REPEAT ()
<SET OBJ <GETB .RMG .CNT>>
<COND (<FIRST? .OBJ>
<SEARCH-LIST .OBJ .TBL ,P-SRCALL>)>
<COND (<THIS-IT? .OBJ>
<OBJ-FOUND .OBJ .TBL>)>
<COND (<IGRTR? CNT .RMGL> <RETURN>)>>)>
<COND (<SET RMG <GETPT ,HERE ,P?PSEUDO>>
<SET RMGL <- </ <PTSIZE .RMG> 4> 1>>
<SET CNT 0>
;<COND (,DEBUG <TELL "[GLBCHK: (PS) RMGL=" N .RMGL "]" CR>)>
<REPEAT ()
<COND (<==? ,P-NAM <GET .RMG <* .CNT 2>>>
<SETG LAST-PSEUDO-LOC ,HERE>
<PUTP ,PSEUDO-OBJECT
,P?ACTION
<GET .RMG <+ <* .CNT 2> 1>>>
<SET FOO
<BACK <GETPT ,PSEUDO-OBJECT ,P?ACTION> 5>>
<PUT .FOO 0 <GET ,P-NAM 0>>
<PUT .FOO 1 <GET ,P-NAM 1>>
<OBJ-FOUND ,PSEUDO-OBJECT .TBL>
<RETURN>)
(<IGRTR? CNT .RMGL> <RETURN>)>>)>
<COND (<==? <GET .TBL ,P-MATCHLEN> .LEN>
<SETG P-SLOCBITS -1>
<SETG P-TABLE .TBL>
<DO-SL ,GLOBAL-OBJECTS 1 1>
<SETG P-SLOCBITS .OBITS>
<COND (<0? <GET .TBL ,P-MATCHLEN>>
<COND (<VERB? EXAMINE FIND FOLLOW LEAVE LOOK-INSIDE
SEARCH SEARCH-FOR SMELL THROUGH WALK-TO>
<DO-SL ,ROOMS 1 1>)>)>)>>
<ROUTINE DO-SL (OBJ BIT1 BIT2 "AUX" BITS)
;#DECL ((OBJ) OBJECT (BIT1 BIT2 BITS) FIX)
<COND (<BTST ,P-SLOCBITS <+ .BIT1 .BIT2>>
<SEARCH-LIST .OBJ ,P-TABLE ,P-SRCALL>)
(T
<COND (<BTST ,P-SLOCBITS .BIT1>
<SEARCH-LIST .OBJ ,P-TABLE ,P-SRCTOP>)
(<BTST ,P-SLOCBITS .BIT2>
<SEARCH-LIST .OBJ ,P-TABLE ,P-SRCBOT>)
(T <RTRUE>)>)>>
<CONSTANT P-SRCBOT 2>
<CONSTANT P-SRCTOP 0>
<CONSTANT P-SRCALL 1>
<ROUTINE SEARCH-LIST (OBJ TBL LVL)
;#DECL ((OBJ NOBJ) <OR FALSE OBJECT> (TBL) TABLE (LVL) FIX)
;<COND (<EQUAL? .OBJ ,GLOBAL-OBJECTS> <SET GLOB T>) (T <SET GLOB <>>)>
<COND (<SET OBJ <FIRST? .OBJ>>
<REPEAT ()
;<COND (<AND .GLOB ,DEBUG>
<TELL "[SRCLST: OBJ=" D .OBJ "]" CR>)>
<COND (<AND <NOT <==? .LVL ,P-SRCBOT>>
<GETPT .OBJ ,P?SYNONYM>
<THIS-IT? .OBJ>>
<OBJ-FOUND .OBJ .TBL>)>
<COND (<AND <OR <NOT <==? .LVL ,P-SRCTOP>>
<FSET? .OBJ ,SEARCHBIT>
<FSET? .OBJ ,SURFACEBIT>>
<FIRST? .OBJ>
<OR <FSET? .OBJ ,OPENBIT>
<FSET? .OBJ ,TRANSBIT>
,P-MOBY-FLAG
<AND <FSET? .OBJ ,PERSONBIT>
<NOT <==? .OBJ ,PLAYER>>>>
;<NOT <EQUAL? .OBJ ,PLAYER ,LOCAL-GLOBALS>>>
<SEARCH-LIST .OBJ .TBL
<COND (<FSET? .OBJ ,SURFACEBIT> ,P-SRCALL)
(<FSET? .OBJ ,SEARCHBIT> ,P-SRCALL)
(T ,P-SRCTOP)>>)>
<COND (<SET OBJ <NEXT? .OBJ>>) (T <RETURN>)>>)>>
<ROUTINE THIS-IT? (OBJ "AUX" SYNS)
<COND (<FSET? .OBJ ,INVISIBLE>
<RFALSE>)
(<AND ,P-NAM
<OR <NOT <SET SYNS <GETPT .OBJ ,P?SYNONYM>>>
<NOT <ZMEMQ ,P-NAM .SYNS <- </ <PTSIZE .SYNS> 2> 1>>>>>
<RFALSE>)
(<AND ,P-ADJ
<OR <NOT <SET SYNS <GETPT .OBJ ,P?ADJECTIVE>>>
<NOT <ZMEMQB ,P-ADJ .SYNS <- <PTSIZE .SYNS> 1>>>>>
<RFALSE>)
(<AND <NOT <0? ,P-GWIMBIT>> <NOT <FSET? .OBJ ,P-GWIMBIT>>>
<RFALSE>)>
<RTRUE>>
<ROUTINE OBJ-FOUND (OBJ TBL "AUX" PTR)
;#DECL ((OBJ) OBJECT (TBL) TABLE (PTR) FIX)
<SET PTR <GET .TBL ,P-MATCHLEN>>
<PUT .TBL <+ .PTR 1> .OBJ>
<PUT .TBL ,P-MATCHLEN <+ .PTR 1>>>
<ROUTINE TAKE-CHECK ()
<AND <ITAKE-CHECK ,P-PRSO <GETB ,P-SYNTAX ,P-SLOC1>>
<ITAKE-CHECK ,P-PRSI <GETB ,P-SYNTAX ,P-SLOC2>>>>
<ROUTINE ITAKE-CHECK (TBL BITS "AUX" PTR OBJ TAKEN)
;"changed by MARC 11/17/83"
;#DECL ((TBL) TABLE (BITS PTR) FIX (OBJ) OBJECT
(TAKEN) <OR FALSE FIX ATOM>)
<COND (<AND <SET PTR <GET .TBL ,P-MATCHLEN>>
<OR <BTST .BITS ,SHAVE>
<BTST .BITS ,STAKE>>>
<REPEAT ()
<COND (<L? <SET PTR <- .PTR 1>> 0> <RETURN>)>
<SET OBJ <GET .TBL <+ .PTR 1>>>
<COND (<==? .OBJ ,IT>
<COND (<NOT <ACCESSIBLE? ,P-IT-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)
(T
<SET OBJ ,P-IT-OBJECT>)>)
(<==? .OBJ ,HER>
<COND (<NOT <ACCESSIBLE? ,P-HER-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)
(T
<SET OBJ ,P-HER-OBJECT>)>)
(<==? .OBJ ,HIM>
<COND (<NOT <ACCESSIBLE? ,P-HIM-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)
(T
<SET OBJ ,P-HIM-OBJECT>)>)
(<==? .OBJ ,THEM>
<COND (<NOT <ACCESSIBLE? ,P-THEM-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)
(T
<SET OBJ ,P-THEM-OBJECT>)>)>
<COND (<AND <NOT <HELD? .OBJ>> ;<NOT <==? .OBJ ,HANDS>>>
<SETG PRSO .OBJ>
<COND (<FSET? .OBJ ,TRYTAKEBIT>
<SET TAKEN T>)
;(<NOT <==? ,WINNER ,PLAYER>>
<SET TAKEN <>>)
(<AND <BTST .BITS ,STAKE>
<==? <ITAKE <>> T>>
<SET TAKEN <>>)
(T <SET TAKEN T>)>
<COND (<AND .TAKEN <BTST .BITS ,SHAVE>>
<TELL "(">
<HE-SHE-IT ,WINNER T "do" ;"is">
<TELL "n't seem to be holding">
<COND (<L? 1 <GET .TBL ,P-MATCHLEN>>
<TELL " all those things">)
(<EQUAL? .OBJ ,NOT-HERE-OBJECT>
<TELL " that">)
(T
<THIS-IS-IT .OBJ>
<TELL THE .OBJ>)>
<TELL "!)" CR>
<RFALSE>)
(<AND <NOT .TAKEN> ;<==? ,WINNER ,PLAYER>>
<TELL "(taking" THE ,PRSO>
<COND (,ITAKE-LOC
<TELL " from" THE ,ITAKE-LOC>)>
<TELL " first)" CR>)>)>>)
(T)>>
<ROUTINE MANY-CHECK ("AUX" (LOSS <>) TMP)
;#DECL ((LOSS) <OR FALSE FIX>)
<COND (<AND <G? <GET ,P-PRSO ,P-MATCHLEN> 1>
<NOT <BTST <GETB ,P-SYNTAX ,P-SLOC1> ,SMANY>>>
<SET LOSS 1>)
(<AND <G? <GET ,P-PRSI ,P-MATCHLEN> 1>
<NOT <BTST <GETB ,P-SYNTAX ,P-SLOC2> ,SMANY>>>
<SET LOSS 2>)>
<COND (.LOSS
<COND ;(<NOT <EQUAL? ,WINNER ,PLAYER>>
<TELL "\"Please, to me simple English speak.\"" CR>
<RFALSE>)
(T
<TELL "(You can't use more than one ">
<COND (<==? .LOSS 2> <TELL "in">)>
<TELL "direct object with \"">
<SET TMP <GET ,P-ITBL ,P-VERBN>>
<COND (<0? .TMP> <TELL "tell">)
(<OR ,P-OFLAG ,P-MERGED>
<PRINTB <GET .TMP 0>>)
(T
<WORD-PRINT <GETB .TMP 2> <GETB .TMP 3>>)>
<TELL "\"!)" CR>
<RFALSE>)>)
(T)>>
<ROUTINE ZMEMQ (ITM TBL "OPTIONAL" (SIZE -1) "AUX" (CNT 1))
<COND (<NOT .TBL> <RFALSE>)>
<COND (<NOT <L? .SIZE 0>> <SET CNT 0>)
(ELSE <SET SIZE <GET .TBL 0>>)>
<REPEAT ()
<COND (<==? .ITM <GET .TBL .CNT>>
<COND (<0? .CNT> <RTRUE>)
(T <RETURN .CNT>)>)
(<IGRTR? CNT .SIZE> <RFALSE>)>>>
<ROUTINE ZMEMZ (ITM TBL "AUX" (CNT 0))
<COND (<NOT .TBL> <RFALSE>)>
<REPEAT ()
<COND (<ZERO? <GET .TBL .CNT>>
<RFALSE>)
(<==? .ITM <GET .TBL .CNT>>
<COND (<0? .CNT> <RTRUE>)
(T <RETURN .CNT>)>)
(T <INC CNT>)>>>
<ROUTINE ZMEMQB (ITM TBL SIZE "AUX" (CNT 0))
;#DECL ((ITM) ANY (TBL) TABLE (SIZE CNT) FIX)
<REPEAT ()
<COND (<==? .ITM <GETB .TBL .CNT>>
<COND (<0? .CNT> <RTRUE>)
(T <RETURN .CNT>)>)
(<IGRTR? CNT .SIZE> <RFALSE>)>>>
;<ROUTINE ZMEMQBIT (ITM TBL SIZE "AUX" (CNT 0) X)
;#DECL ((ITM) ANY (TBL) TABLE (SIZE CNT) FIX)
<REPEAT ()
<COND (<FSET? <SET X <GETB .TBL .CNT>> .ITM> <RETURN .X>)
(<IGRTR? CNT .SIZE> <RFALSE>)>>>
<GLOBAL ALWAYS-LIT <>>
<ROUTINE LIT? (RM "OPTIONAL" (RMBIT T) "AUX" OHERE (LIT <>))
<COND (<AND ,ALWAYS-LIT <EQUAL? ,WINNER ,PLAYER>>
<RTRUE>)>
<SETG P-GWIMBIT ,ONBIT>
<SET OHERE ,HERE>
<SETG HERE .RM>
<COND (<AND .RMBIT <FSET? .RM ,ONBIT>>
<SET LIT T>)
(T
<PUT ,P-MERGE ,P-MATCHLEN 0>
<SETG P-TABLE ,P-MERGE>
<SETG P-SLOCBITS -1>
<COND (<==? .OHERE .RM>
<DO-SL ,WINNER 1 1>
<COND (<AND <NOT <EQUAL? ,WINNER ,PLAYER>>
<IN? ,PLAYER .RM>>
<DO-SL ,PLAYER 1 1>)>)>
<DO-SL .RM 1 1>
<COND (<G? <GET ,P-TABLE ,P-MATCHLEN> 0> <SET LIT T>)>)>
<SETG HERE .OHERE>
<SETG P-GWIMBIT 0>
.LIT>
;<ROUTINE VPRINT ("AUX" TMP)
<SET TMP <GET ,P-OTBL ,P-VERBN>>
<COND (<==? .TMP 0> <TELL "tell">)
(<0? <GETB ,P-VTBL 2>>
<PRINTB <GET .TMP 0>>)
(T
<WORD-PRINT <GETB .TMP 2> <GETB .TMP 3>>)>>
<ROUTINE NOT-HERE (OBJ)
<SETG CLOCK-WAIT T>
<TELL "(You can't see ">
<COND (<NOT <FSET? .OBJ ,NARTICLEBIT>> <TELL "any ">)>
<TELL D .OBJ " here.)" CR>>
<OBJECT HER
(IN GLOBAL-OBJECTS)
(SYNONYM SHE HER ;WOMAN ;GIRL)
(DESC "her")
(FLAGS NARTICLEBIT)>
<OBJECT HIM
(IN GLOBAL-OBJECTS)
(SYNONYM HE HIM ;MAN ;BOY)
(DESC "him")
(FLAGS NARTICLEBIT)>
<OBJECT THEM
(IN GLOBAL-OBJECTS)
(SYNONYM THEY THEM)
(DESC "them")
(FLAGS NARTICLEBIT)>
<OBJECT GAME
(IN GLOBAL-OBJECTS)
(DESC ;"STEAM AND VARIATIONS" "CHECKPOINT" ;"SEVEN SHADOWS")
(ADJECTIVE SPY)
(SYNONYM THRILLER GAME CHECKPOINT)
(FLAGS NARTICLEBIT)
(ACTION GAME-F)>
<ROUTINE GAME-F ()
<COND (<VERB? EXAMINE PLAY READ>
<SETG P-WON <>>
<TELL "(You're doing it now!)" CR>)>>
<GLOBAL QCONTEXT <>>
<GLOBAL QCONTEXT-ROOM <>>
<GLOBAL LAST-PSEUDO-LOC <>>
<GLOBAL I-ASSUME "(I assume you mean:">
<OBJECT INTDIR
(IN GLOBAL-OBJECTS)
(SYNONYM DIRECT)
(ADJECTIVE NORTH EAST SOUTH WEST ;"NE NW SE SW")
(DESC ;"compass " "direction")>
Reference in a new issue View git blame Copy permalink