2908 lines
83 KiB
Plaintext
2908 lines
83 KiB
Plaintext
"PARSER for WISHBRINGER: (C)1985 Infocom, Inc. All rights reserved."
|
|
|
|
<SETG SIBREAKS ".,\"!?">
|
|
|
|
<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 LAST-PLAYER-LOC 0>
|
|
<GLOBAL WINNER 0>
|
|
<GLOBAL P-LEXV <ITABLE BYTE 120>>
|
|
|
|
<GLOBAL LAST-PSEUDO-LOC <>>
|
|
<GLOBAL ITAKE-LOC <>>
|
|
|
|
"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-PRSO-NOT-HERE <>>
|
|
;<GLOBAL L-PRSI-NOT-HERE <>>
|
|
|
|
<GLOBAL L-WINNER <>>
|
|
<GLOBAL BOTTOM? <>>
|
|
<GLOBAL P-WALK-DIR <>>
|
|
|
|
" 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."
|
|
|
|
<ROUTINE PARSER ("AUX" (PTR ,P-LEXSTART) WRD (VAL 0) (VERB <>) (BOTTOM <>)
|
|
LEN (DIR <>) (NW 0) (LW 0) NUM SCNT (CNT -1) OWINNER
|
|
(OF-FLAG <>))
|
|
<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>
|
|
<NOT <EQUAL? ,WINNER ,PROTAGONIST>>>
|
|
<SETG L-WINNER ,WINNER>
|
|
<SETG WINNER ,PROTAGONIST>
|
|
<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 (,SAYING?
|
|
<SETG SAYING? <>>)
|
|
(<AND <NOT ,SUPER-BRIEF>
|
|
<EQUAL? ,PROTAGONIST ,WINNER>>
|
|
<CRLF>)>
|
|
; <COND (<NOT <VERB? ASK TELL SAY>>
|
|
<CRLF>)>)
|
|
(T
|
|
<SETG SAYING? <>>
|
|
<SETG L-WINNER ,WINNER>
|
|
<SETG WINNER ,PROTAGONIST>
|
|
<SETG QUOTE-FLAG <>>
|
|
<SETG LAST-PLAYER-LOC ,HERE>
|
|
<SETG HERE <LOC ,WINNER>>
|
|
<SETG LIT <LIT? ,HERE>>
|
|
<COND (<NOT ,SUPER-BRIEF>
|
|
<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 (<EQUAL? <GET ,P-LEXV .PTR> ,W?QUOTE> ; "Quote 1st token?"
|
|
<SET PTR <+ .PTR ,P-LEXELEN>> ;"If so, ignore it."
|
|
<SETG P-LEN <- ,P-LEN 1>>)>
|
|
<COND (<EQUAL? ,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>
|
|
<EQUAL? ,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 (<ZERO? ,P-LEN>
|
|
<TELL "Beg pardon?" CR>
|
|
<RFALSE>)>
|
|
<SET LEN ,P-LEN>
|
|
<SETG P-DIR <>>
|
|
<SETG P-NCN 0>
|
|
<SETG P-GETFLAGS 0>
|
|
<SET BOTTOM <>>
|
|
;"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 <EQUAL? .WRD ,W?TO>
|
|
<EQUAL? .VERB ,ACT?TELL ,ACT?ASK>>
|
|
<SET VERB ,ACT?TELL>
|
|
<SET WRD ,W?QUOTE>)
|
|
(<AND <EQUAL? .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?MR ,W?MS ,W?SGT>>
|
|
<SET LW 0>)
|
|
(<EQUAL? .WRD ,W?THEN ,W?PERIOD ,W?QUOTE>
|
|
<COND (<EQUAL? .WRD ,W?QUOTE>
|
|
<COND (,QUOTE-FLAG
|
|
<SETG QUOTE-FLAG <>>)
|
|
(T
|
|
<SETG QUOTE-FLAG T>)>)>
|
|
<OR <ZERO? ,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>
|
|
<OR <EQUAL? .LEN 1>
|
|
<AND <EQUAL? .LEN 2>
|
|
<EQUAL? .VERB ,ACT?WALK>>
|
|
<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
|
|
<EQUAL? .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>>
|
|
<NOT .VERB>
|
|
;<OR <NOT .VERB>
|
|
<EQUAL? .VERB ,ACT?WHAT>>>
|
|
; <COND (<EQUAL? .VERB ,ACT?WHAT>
|
|
<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
|
|
,W?EVERYTHING>
|
|
<WT? .WRD ,PS?ADJECTIVE>
|
|
<WT? .WRD ,PS?OBJECT>>
|
|
<SET VAL 0>>>
|
|
<COND (<AND <G? ,P-LEN 1> ; "1 IN RETROFIX #34"
|
|
<EQUAL? <GET ,P-LEXV
|
|
<+ .PTR ,P-LEXELEN>>
|
|
,W?OF>
|
|
<NOT <EQUAL? .VERB
|
|
;,ACT?MAKE ,ACT?TAKE>>
|
|
<ZERO? .VAL>
|
|
<NOT <EQUAL? .WRD ; ,W?ONE ,W?A>>
|
|
<NOT <EQUAL? .WRD ,W?ALL ,W?BOTH
|
|
,W?EVERYTHING>>>
|
|
<COND (<EQUAL? .WRD ,W?BOTTOM>
|
|
<SET BOTTOM T>)>
|
|
<SET OF-FLAG T>)
|
|
(<AND <NOT <ZERO? .VAL>>
|
|
<OR <ZERO? ,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>)>)
|
|
(<EQUAL? ,P-NCN 2>
|
|
<TELL
|
|
"(There are 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>)>)>)
|
|
;(<EQUAL? .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>)
|
|
(<EQUAL? .WRD ,W?OF> ; "RETROFIX #34"
|
|
<COND (<OR <NOT .OF-FLAG>
|
|
<EQUAL?
|
|
<GET ,P-LEXV <+ .PTR ,P-LEXELEN>>
|
|
,W?PERIOD ,W?THEN>>
|
|
<CANT-USE .PTR>
|
|
<RFALSE>)
|
|
(T
|
|
<SET OF-FLAG <>>)>)
|
|
(<WT? .WRD ,PS?BUZZ-WORD>)
|
|
(<AND <EQUAL? .VERB ,ACT?TELL>
|
|
<WT? .WRD ,PS?VERB ,P1?VERB>>
|
|
<WAY-TO-TALK>
|
|
<RFALSE>)
|
|
(T
|
|
<CANT-USE .PTR>
|
|
<RFALSE>)>)
|
|
(T
|
|
<UNKNOWN-WORD .PTR>
|
|
<RFALSE>)>
|
|
<SET LW .WRD>
|
|
<SET PTR <+ .PTR ,P-LEXELEN>>>
|
|
<COND (.DIR
|
|
<SETG PRSA ,V?WALK>
|
|
<SETG P-WALK-DIR .DIR>
|
|
<SETG PRSO .DIR>
|
|
<SETG P-OFLAG <>>
|
|
<RTRUE>)>
|
|
<SETG P-WALK-DIR <>>
|
|
<COND (<AND ,P-OFLAG
|
|
<ORPHAN-MERGE>>
|
|
<SETG WINNER .OWINNER>)
|
|
(T
|
|
<SETG BOTTOM? .BOTTOM>)>
|
|
;<COND (<EQUAL? <GET ,P-ITBL ,P-VERB> 0>
|
|
<PUT ,P-ITBL ,P-VERB ,ACT?$CALL>)>
|
|
<COND (<AND <SYNTAX-CHECK>
|
|
<SNARF-OBJECTS>
|
|
<MANY-CHECK>
|
|
<TAKE-CHECK>>
|
|
T)>>
|
|
|
|
<ROUTINE WAY-TO-TALK ()
|
|
<REFER-TO-MANUAL>
|
|
<TELL
|
|
" for the correct way to talk to characters.)" CR>>
|
|
|
|
"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 <EQUAL? .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))
|
|
<SET OFF <* <- ,P-NCN 1> 2>>
|
|
<COND (<NOT <EQUAL? .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 (<ZERO? ,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 (<ZERO? ,P-LEN> <SET NW 0>)
|
|
(T <SET NW <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>>)>
|
|
;<COND (<AND <EQUAL? .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?MR ,W?MS ,W?SGT>>
|
|
<SET LW 0>)
|
|
(<EQUAL? .WRD ,W?AND ,W?COMMA>
|
|
<SET ANDFLG T>)
|
|
(<EQUAL? .WRD ,W?ALL ,W?BOTH ,W?EVERYTHING>
|
|
; <OR <EQUAL? .WRD ,W?ALL ,W?BOTH ,W?ONE>
|
|
<EQUAL? .WRD ,W?EVERYTHING>>
|
|
<COND (<EQUAL? .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
|
|
,W?EVERYTHING>>>
|
|
T)
|
|
(<AND <WT? .WRD
|
|
,PS?ADJECTIVE
|
|
,P1?ADJECTIVE>
|
|
<NOT <EQUAL? .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 <>>)>)
|
|
;"Next clause replaced by following one to enable
|
|
OLD WOMAN, HELLO"
|
|
;(<AND <OR ,P-MERGED
|
|
,P-OFLAG
|
|
<NOT <EQUAL? <GET ,P-ITBL ,P-VERB> 0>>>
|
|
<OR <WT? .WRD ,PS?ADJECTIVE>
|
|
<WT? .WRD ,PS?BUZZ-WORD>>>)
|
|
(<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 THIS-IS-IT (OBJ)
|
|
<COND (<OR <EQUAL? .OBJ <> ,PROTAGONIST ,NOT-HERE-OBJECT>
|
|
<EQUAL? .OBJ ,INTDIR>>
|
|
<RTRUE>)
|
|
(<AND <EQUAL? ,PRSA ,V?WALK ,V?WALK-TO>
|
|
<EQUAL? .OBJ ,PRSO>>
|
|
<RTRUE>)
|
|
(<OR <EQUAL? .OBJ ,CHAINS ,GLASSES ,BOOTS>
|
|
<EQUAL? .OBJ ,CROWD ,MONUMENTS ,HUMANOIDS>
|
|
<EQUAL? .OBJ ,VAPORS ,INSTRUMENTS ,SHARKS>>
|
|
<SETG P-IT-OBJECT .OBJ>
|
|
<SETG P-THEM-OBJECT .OBJ>)
|
|
(<EQUAL? .OBJ ,MISS-VOSS ,OLD-WOMAN ,EVIL-ONE>
|
|
<SETG P-HER-OBJECT .OBJ>)
|
|
(<EQUAL? .OBJ ,KITTY ,CHAOS ,PRINCESS>
|
|
<SETG P-IT-OBJECT .OBJ>
|
|
<SETG P-HER-OBJECT .OBJ>)
|
|
(<EQUAL? .OBJ ,CRISP ,GRAVEDIGGER ,MACGUFFIN>
|
|
<SETG P-HIM-OBJECT .OBJ>)
|
|
(<OR <EQUAL? .OBJ ,TROLL ,KING ,VULTURE>
|
|
<EQUAL? .OBJ ,GOLDFISH ,PIRANHA ,HORSE>>
|
|
<SETG P-IT-OBJECT .OBJ>
|
|
<SETG P-HIM-OBJECT .OBJ>)
|
|
(T
|
|
<SETG P-IT-OBJECT .OBJ>)>
|
|
<RTRUE>>
|
|
|
|
<ROUTINE FAKE-ORPHAN ("AUX" TMP)
|
|
<ORPHAN ,P-SYNTAX <>>
|
|
<BE-SPECIFIC>
|
|
<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 <>>
|
|
<TELL "?)" CR>>
|
|
|
|
<ROUTINE SEE-VERB? ()
|
|
<COND (<OR <EQUAL? ,PRSA ,V?LOOK ,V?EXAMINE ,V?LOOK-INSIDE>
|
|
<EQUAL? ,PRSA ,V?SEARCH ,V?FIND ,V?LOOK-ON>
|
|
<EQUAL? ,PRSA ,V?LOOK-UNDER ,V?LOOK-BEHIND ,V?READ>
|
|
<EQUAL? ,PRSA ,V?LOOK-THRU ,V?LOOK-DOWN ,V?COUNT>>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" (V <>) OA OO OI)
|
|
<SET OA ,PRSA>
|
|
<SET OO ,PRSO>
|
|
<SET OI ,PRSI>
|
|
<SETG PRSA .A>
|
|
<COND (<AND <NOT ,LIT>
|
|
<SEE-VERB?>>
|
|
<TOO-DARK>
|
|
<RFATAL>)
|
|
(<AND ,IMMOBILIZED?
|
|
<NOT <SEE-VERB?>>
|
|
<NOT <GAME-VERB?>>
|
|
<NOT <EQUAL? ,PRSA ,V?AGAIN>>>
|
|
<TELL "Your body seems unwilling to respond." CR>
|
|
<RFATAL>)
|
|
(<NOT <EQUAL? .A ,V?WALK>>
|
|
<COND (<AND <EQUAL? ,IT .I .O>
|
|
<NOT <ACCESSIBLE? ,P-IT-OBJECT>>>
|
|
<COND (<NOT .I>
|
|
<FAKE-ORPHAN>)
|
|
(T
|
|
<CANT-SEE-ANY ,P-IT-OBJECT>)>
|
|
<RFATAL>)>
|
|
<COND (<EQUAL? ,THEM .I .O>
|
|
<COND (<VISIBLE? ,P-THEM-OBJECT>
|
|
; <COND (,DEBUG
|
|
<TELL "[them=" D ,P-THEM-OBJECT "]" CR>)>
|
|
<COND (<EQUAL? ,THEM .O>
|
|
<SET O ,P-THEM-OBJECT>)>
|
|
<COND (<EQUAL? ,THEM .I>
|
|
<SET I ,P-THEM-OBJECT>)>)
|
|
(T
|
|
<COND (<NOT .I>
|
|
<FAKE-ORPHAN>)
|
|
(T
|
|
<CANT-SEE-ANY ,P-THEM-OBJECT>)>
|
|
<RFATAL>)>)>
|
|
<COND (<EQUAL? ,HER .I .O>
|
|
<COND (<VISIBLE? ,P-HER-OBJECT>
|
|
; <COND (,DEBUG
|
|
<TELL "[her=" D ,P-HER-OBJECT "]" CR>)>
|
|
<COND (<EQUAL? ,HER .O>
|
|
<SET O ,P-HER-OBJECT>)>
|
|
<COND (<EQUAL? ,HER .I>
|
|
<SET I ,P-HER-OBJECT>)>)
|
|
(T
|
|
<COND (<NOT .I>
|
|
<FAKE-ORPHAN>)
|
|
(T
|
|
<CANT-SEE-ANY ,P-HER-OBJECT>)>
|
|
<RFATAL>)>)>
|
|
<COND (<EQUAL? ,HIM .I .O>
|
|
<COND (<VISIBLE? ,P-HIM-OBJECT>
|
|
; <COND (,DEBUG
|
|
<TELL "[him=" D ,P-HIM-OBJECT "]" CR>)>
|
|
<COND (<EQUAL? ,HIM .O>
|
|
<SET O ,P-HIM-OBJECT>)>
|
|
<COND (<EQUAL? ,HIM .I>
|
|
<SET I ,P-HIM-OBJECT>)>)
|
|
(T
|
|
<COND (<NOT .I>
|
|
<FAKE-ORPHAN>)
|
|
(T
|
|
<CANT-SEE-ANY ,P-HIM-OBJECT>)>
|
|
<RFATAL>)>)>
|
|
<COND (<EQUAL? .O ,IT>
|
|
<SET O ,P-IT-OBJECT>
|
|
; <COND (,DEBUG
|
|
<TELL "[it=" D .O "]" CR>)>)
|
|
;"(<EQUAL? .O ,THEM><SET O ,P-THEM-OBJECT>)
|
|
(<EQUAL? .O ,HER> <SET O ,P-HER-OBJECT>)
|
|
(<EQUAL? .O ,HIM> <SET O ,P-HIM-OBJECT>)">
|
|
<COND (<EQUAL? .I ,IT>
|
|
<SET I ,P-IT-OBJECT>
|
|
; <COND (,DEBUG
|
|
<TELL "[it=" D .O "]" CR>)>)
|
|
;"(<EQUAL? .I ,THEM><SET I ,P-THEM-OBJECT>)
|
|
(<EQUAL? .I ,HER> <SET I ,P-HER-OBJECT>)
|
|
(<EQUAL? .I ,HIM> <SET I ,P-HIM-OBJECT>)">)>
|
|
<SETG PRSI .I>
|
|
<SETG PRSO .O>
|
|
<SET V <>>
|
|
<COND (<AND <NOT <EQUAL? .A ,V?WALK>>
|
|
<EQUAL? ,NOT-HERE-OBJECT ,PRSO ,PRSI>>
|
|
<SET V <APPLY ,NOT-HERE-OBJECT-F>>
|
|
<COND (.V
|
|
<SETG P-WON <>>)>)>
|
|
<THIS-IS-IT ,PRSI>
|
|
<THIS-IS-IT ,PRSO>
|
|
<SET O ,PRSO>
|
|
<SET I ,PRSI>
|
|
<COND (<ZERO? .V>
|
|
<SET V <APPLY <GETP ,WINNER ,P?ACTION> ,M-WINNER>>)>
|
|
<COND (<ZERO? .V>
|
|
<SET V <APPLY <GETP <LOC ,WINNER> ,P?ACTION> ,M-BEG>>)>
|
|
<COND (<ZERO? .V>
|
|
<SET V <APPLY <GET ,PREACTIONS .A>>>)>
|
|
<COND (<AND <ZERO? .V>
|
|
<NOT <EQUAL? ,WINNER ,PROTAGONIST>>>
|
|
<APPLY <GET ,ACTIONS .A>>
|
|
<SET V T>)>
|
|
<COND (<AND <ZERO? .V>
|
|
.I
|
|
<NOT <EQUAL? .A ,V?WALK>>
|
|
<LOC .I>>
|
|
<SET V <GETP <LOC .I> ,P?CONTFCN>>
|
|
<COND (.V
|
|
<SET V <APPLY .V ,M-CONT>>)>)>
|
|
<COND (<AND <ZERO? .V>
|
|
.I>
|
|
<SET V <APPLY <GETP .I ,P?ACTION>>>)>
|
|
<COND (<AND <ZERO? .V>
|
|
.O
|
|
<NOT <EQUAL? .A ,V?WALK>>
|
|
<LOC .O>>
|
|
<SET V <GETP <LOC .O> ,P?CONTFCN>>
|
|
<COND (.V
|
|
<SET V <APPLY .V ,M-CONT>>)>)>
|
|
<COND (<AND <ZERO? .V>
|
|
.O
|
|
<NOT <EQUAL? .A ,V?WALK>>>
|
|
<SET V <APPLY <GETP .O ,P?ACTION>>>
|
|
<COND (.V
|
|
<THIS-IS-IT .O>)>)>
|
|
<COND (<ZERO? .V>
|
|
<SET V <APPLY <GET ,ACTIONS .A>>>)>
|
|
|
|
; <COND (<NOT <EQUAL? .V ,M-FATAL>>
|
|
<COND (<NOT <GAME-VERB?>>
|
|
<SET V
|
|
<APPLY <GETP <LOC ,WINNER> ,P?ACTION> ,M-END>>)>)>
|
|
<SETG PRSA .OA>
|
|
<SETG PRSO .OO>
|
|
<SETG PRSI .OI>
|
|
.V>
|
|
|
|
<ROUTINE BUZZER-WORD? (WORD)
|
|
<COND (<QUESTION-WORD? .WORD>
|
|
<RTRUE>)
|
|
(<NAUGHTY-WORD? .WORD>
|
|
<RTRUE>)
|
|
(<MAGIC-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 "(You don't need to use \"">
|
|
;<PRINTB .WORD>
|
|
;<TELL "\" directions in this story.)" CR>
|
|
<V-BAD-DIRECTION>
|
|
<RTRUE>)
|
|
|
|
(<EQUAL? .WORD ,W?MOUSE ,W?RAT ,W?RODENT>
|
|
<COND (<AND <EQUAL? ,HERE ,INSIDE-CHURCH>
|
|
<NOT <FSET? ,CHURCH ,TOUCHBIT>>>
|
|
<TELL
|
|
"It disappeared before you could get a good look." CR>)
|
|
(T
|
|
<CANT-SEE-ANY>)>
|
|
<RTRUE>)
|
|
(<SESAME? .WORD>
|
|
<RTRUE>)
|
|
(<AND <EQUAL? .WORD ,W?FUZZY ,W?BLURRY ,W?BLURRED>
|
|
<NOT ,FUZZY?>>
|
|
<TELL ,YOU-SEE "nothing ">
|
|
<PRINTB .WORD>
|
|
<TELL " here!" CR>
|
|
<RTRUE>)
|
|
(<EQUAL? .WORD ,W?CORKY>
|
|
<COND (<IN? ,CRISP ,HERE>
|
|
<TELL D ,CRISP
|
|
" reddens. \"Don't use that name in front of me!\"">)
|
|
(T
|
|
<TELL "(" D ,CRISP
|
|
" hates it when you use that name!)">)>
|
|
<CRLF>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<BUZZ AM ANY ARE 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 MOUSE RAT RODENT KALUZE FRATTO SORKIN
|
|
FUZZY BLURRY BLURRED CORKY>
|
|
|
|
<GLOBAL POWER 0>
|
|
|
|
<ROUTINE SESAME? (WORD "AUX" MWORD)
|
|
<COND (<EQUAL? .WORD ,W?KALUZE ,W?FRATTO ,W?SORKIN>
|
|
<COND (<ZERO? ,POWER>
|
|
<SET MWORD ,W?KALUZE>)
|
|
(<EQUAL? ,POWER 1>
|
|
<SET MWORD ,W?FRATTO>)
|
|
(T
|
|
<SET MWORD ,W?SORKIN>)>
|
|
<COND (<OR <NOT ,SKEWED?>
|
|
<NOT <EQUAL? ,HERE ,HILLTOP>>
|
|
<NOT <EQUAL? .WORD .MWORD>>>
|
|
<TELL "(The word \"">
|
|
<PRINTB .WORD>
|
|
<TELL "\" isn't useful here.)" CR>)
|
|
(<FSET? ,PELICAN ,RMUNGBIT>
|
|
<SAY-THE ,DRAWBRIDGE>
|
|
<TELL " decides that you're only guessing the word \"">
|
|
<PRINTB .WORD>
|
|
<TELL ",\" and refuses to cooperate." CR>)
|
|
(<FSET? ,DRAWBRIDGE ,RMUNGBIT>
|
|
<NOTHING-EXCITING>)
|
|
(,ECLIPSE?
|
|
<DARK-IS-POWERFUL>)
|
|
(T
|
|
<FSET ,DRAWBRIDGE ,RMUNGBIT>
|
|
<FSET ,DRAWBRIDGE ,OPENBIT>
|
|
<TELL
|
|
"With a great creak of wood and rattle of chains, the " D ,DRAWBRIDGE " slowly lowers across the moat." CR CR>
|
|
<UPDATE-SCORE 3>
|
|
<GOOD-PLACE-TO-SAVE>)>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE QUESTION-WORD? (WORD)
|
|
<COND (<EQUAL? .WORD ,W?WHERE>
|
|
<TO-DO-THING-USE "locate" "FIND">
|
|
<RTRUE>)
|
|
|
|
(<OR <EQUAL? .WORD ,W?WHAT ,W?WHAT\'S ,W?WHO>
|
|
<EQUAL? .WORD ,W?WHO\'S ,W?WHY ,W?HOW>
|
|
<EQUAL? .WORD ,W?WHEN ,W?WHEN\'S ,W?AM>
|
|
<EQUAL? .WORD ,W?WOULD ,W?COULD ,W?SHOULD>>
|
|
<TO-DO-THING-USE "ask about" "ASK CHARACTER ABOUT">
|
|
<RTRUE>)
|
|
|
|
(<OR <EQUAL? .WORD ,W?THAT\'S ,W?IT\'S ,W?I\'M>
|
|
<EQUAL? .WORD ,W?IS ,W?DID ,W?ARE>
|
|
<EQUAL? .WORD ,W?DO ,W?HAVE ,W?ANY>
|
|
<EQUAL? .WORD ,W?WILL ,W?WAS ,W?WERE>
|
|
<EQUAL? .WORD ,W?I\'LL ,W?WHICH ,W?WE\'RE>
|
|
<EQUAL? .WORD ,W?I\'VE ,W?WON\'T ,W?HAS>
|
|
<EQUAL? .WORD ,W?YOU\'RE ,W?HE\'S ,W?SHE\'S>
|
|
<EQUAL? .WORD ,W?THEY\'RE ,W?SHALL>>
|
|
<TELL "(Please use commands, not statements or questions.)" CR>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<BUZZ FUCK FUCKED CURSE GODDAMNED CUSS DAMN SHIT ASSHOLE CUNT
|
|
SHITHEAD PISS SUCK BASTARD SCREW FUCKING DAMNED PEE COCKSUCKER BITCH>
|
|
|
|
<ROUTINE NAUGHTY-WORD? (WORD)
|
|
<COND (<OR <EQUAL? .WORD ,W?CURSE ,W?GODDAMNED ,W?CUSS>
|
|
<EQUAL? .WORD ,W?DAMN ,W?SHIT ,W?FUCK>
|
|
<EQUAL? .WORD ,W?SHITHEAD ,W?PISS ,W?SUCK>
|
|
<EQUAL? .WORD ,W?BASTARD ,W?SCREW ,W?FUCKING>
|
|
<EQUAL? .WORD ,W?DAMNED ,W?PEE ,W?COCKSUCKER>
|
|
<EQUAL? .WORD ,W?FUCKED ,W?CUNT ,W?ASSHOLE>
|
|
<EQUAL? .WORD ,W?BITCH>>
|
|
<TELL "(" <PICK-ONE ,OFFENDED> ".)" CR>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<GLOBAL OFFENDED
|
|
<LTABLE 0
|
|
"What charming language"
|
|
"Computers aren't impressed by naughty words"
|
|
"Grow up">>
|
|
|
|
<BUZZ PLUGH XYZZY YOHO ODYSSEUS ULYSSES ECHO SAILOR ZORK OZMOO>
|
|
|
|
<ROUTINE MAGIC-WORD? (WORD)
|
|
<COND (<OR <EQUAL? .WORD ,W?PLUGH ,W?XYZZY ,W?YOHO>
|
|
<EQUAL? .WORD ,W?ECHO ,W?ODYSSEUS ,W?ULYSSES>
|
|
<EQUAL? .WORD ,W?SAILOR ,W?ZORK ,W?OZMOO>>
|
|
<TELL "A hollow voice says, \"Fool!\"" CR>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<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 (<EQUAL? .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?INTNUM>
|
|
<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?INTNUM
|
|
;<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>)
|
|
(<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 <ZERO? <SET VERB <GET ,P-ITBL ,P-VERB>>>>
|
|
<NOT .ADJ>
|
|
<NOT <EQUAL? .VERB <GET ,P-OTBL ,P-VERB>>>>
|
|
<RFALSE>)
|
|
(<EQUAL? ,P-NCN 2>
|
|
<RFALSE>)
|
|
(<EQUAL? <GET ,P-OTBL ,P-NC1> 1>
|
|
<COND (<OR <EQUAL? <SET TEMP <GET ,P-ITBL ,P-PREP1>>
|
|
<GET ,P-OTBL ,P-PREP1>>
|
|
<ZERO? .TEMP>>
|
|
<COND (.ADJ
|
|
<PUT ,P-OTBL ,P-NC1 <REST ,P-LEXV 2>>
|
|
<COND (<ZERO? <GET ,P-ITBL ,P-NC1L>>
|
|
<PUT ,P-ITBL ,P-NC1L <REST ,P-LEXV 6>>)>
|
|
<COND (<ZERO? ,P-NCN>
|
|
<SETG P-NCN 1>)>)
|
|
(T
|
|
<PUT ,P-OTBL ,P-NC1 <GET ,P-ITBL ,P-NC1>>
|
|
;<PUT ,P-OTBL ,P-NC1L <GET ,P-ITBL ,P-NC1L>>)>
|
|
<PUT ,P-OTBL ,P-NC1L <GET ,P-ITBL ,P-NC1L>>)
|
|
(T
|
|
<RFALSE>)>)
|
|
(<EQUAL? <GET ,P-OTBL ,P-NC2> 1>
|
|
<COND (<OR <EQUAL? <SET TEMP <GET ,P-ITBL ,P-PREP1>>
|
|
<GET ,P-OTBL ,P-PREP2>>
|
|
<ZERO? .TEMP>>
|
|
<COND (.ADJ
|
|
<PUT ,P-ITBL ,P-NC1 <REST ,P-LEXV 2>>
|
|
<COND (<ZERO? <GET ,P-ITBL ,P-NC1L>>
|
|
<PUT ,P-ITBL ,P-NC1L <REST ,P-LEXV 6>>)>)>
|
|
<PUT ,P-OTBL ,P-NC2 <GET ,P-ITBL ,P-NC1>>
|
|
<PUT ,P-OTBL ,P-NC2L <GET ,P-ITBL ,P-NC1L>>
|
|
<SETG P-NCN 2>)
|
|
(T
|
|
<RFALSE>)>)
|
|
(,P-ACLAUSE
|
|
<COND (<AND <NOT <EQUAL? ,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 (<EQUAL? .BEG .END>
|
|
<COND (.ADJ
|
|
<ACLAUSE-WIN .ADJ>
|
|
<RETURN>)
|
|
(T
|
|
<SETG P-ACLAUSE <>> <RFALSE>)>)
|
|
(<AND <NOT .ADJ>
|
|
<OR <BTST <GETB .WRD ,P-PSOFF>
|
|
,PS?ADJECTIVE> ;"same as WT?"
|
|
<EQUAL? .WRD ,W?ALL ; ,W?ONE
|
|
,W?EVERYTHING>>>
|
|
<SET ADJ .WRD>)
|
|
; (<EQUAL? .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>
|
|
;<AND <NOT <EQUAL? <GET ,P-OTBL ,P-NC2> 0>> <SETG P-NCN 2>>
|
|
<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 <EQUAL? <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 <EQUAL? <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
|
|
<LTABLE 0
|
|
<PTABLE "This story doesn'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 this story doesn't recognize the word \""
|
|
".\"">>>
|
|
|
|
<ROUTINE UNKNOWN-WORD (PTR "AUX" BUF MSG)
|
|
<SET MSG <PICK-ONE ,UNKNOWN-MSGS>>
|
|
<TELL "(" <GET .MSG 0>>
|
|
<WORD-PRINT <GETB <REST ,P-LEXV <SET BUF <* .PTR 2>>> 2>
|
|
<GETB <REST ,P-LEXV .BUF> 3>>
|
|
<SETG QUOTE-FLAG <>>
|
|
<SETG P-OFLAG <>>
|
|
<TELL <GET .MSG 1> ")" 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)
|
|
<SET VERB <GET ,P-ITBL ,P-VERB>>
|
|
<COND (<ZERO? .VERB>
|
|
<NOT-IN-SENTENCE "any verbs">
|
|
<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>>
|
|
<ZERO? ,P-NCN>
|
|
<OR <ZERO? <SET PREP <GET ,P-ITBL ,P-PREP1>>>
|
|
<EQUAL? .PREP <GETB .SYN ,P-SPREP1>>>>
|
|
<SET DRIVE1 .SYN>)
|
|
(<EQUAL? <GETB .SYN ,P-SPREP1> <GET ,P-ITBL ,P-PREP1>>
|
|
<COND (<AND <EQUAL? .NUM 2> <EQUAL? ,P-NCN 1>>
|
|
<SET DRIVE2 .SYN>)
|
|
(<EQUAL? <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?WHAT>
|
|
<TELL "That's your problem!" CR>
|
|
<RFALSE>)
|
|
(T
|
|
<COND (<EQUAL? ,WINNER ,PROTAGONIST>
|
|
<ORPHAN .DRIVE1 .DRIVE2>
|
|
<TELL "(Wh"
|
|
<COND (<EQUAL? .VERB ,ACT?WALK> "ere")
|
|
(T "at")>
|
|
" do you want to ">)
|
|
(T
|
|
<TELL
|
|
"(Your command wasn't complete. Next time, type wh"
|
|
<COND (<EQUAL? .VERB ,ACT?WALK> "ere") (T "at")>
|
|
" you want ">
|
|
<ARTICLE ,WINNER T>
|
|
<TELL D ,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 ,PROTAGONIST>
|
|
<SETG P-OFLAG T>
|
|
<TELL "?)" CR>)
|
|
(T
|
|
<SETG P-OFLAG <>>
|
|
<TELL ".)" CR>)>
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE VERB-PRINT ("AUX" TMP)
|
|
<SET TMP <GET ,P-ITBL ,P-VERBN>> ;"? ,P-OTBL?"
|
|
<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>)>>
|
|
|
|
<ROUTINE ORPHAN (D1 D2 "AUX" (CNT -1))
|
|
<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 (<EQUAL? ,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 (<EQUAL? .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 (<EQUAL? .WRD ,W?PERIOD>
|
|
<SET NOSP T>)
|
|
(<EQUAL? .WRD ,W?ME>
|
|
<PRINTD ,PROTAGONIST>
|
|
<SET PN T>)
|
|
(<NAME? .WRD>
|
|
<CAPITALIZE .BEG>
|
|
<SET PN T>)
|
|
(T
|
|
<COND (<AND .FIRST?? <NOT .PN> .CP>
|
|
<TELL "the ">)>
|
|
<COND (<OR ,P-OFLAG ,P-MERGED> <PRINTB .WRD>)
|
|
(<AND <EQUAL? .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 NAME? (WRD)
|
|
<OR <EQUAL? .WRD ,W?CRISP ,W?VOSS ,W?MACGUFFIN>
|
|
<EQUAL? .WRD ,W?FESTERON ,W?SHOPPE ,W?MAGICK>
|
|
<EQUAL? .WRD ,W?KING ,W?PRINCESS ,W?TASMANIA>
|
|
<EQUAL? .WRD ,W?ANATINUS ,W?EVIL ,W?ONE>
|
|
<EQUAL? .WRD ,W?WISHBRINGER ,W?CHAOS ,W?MR>
|
|
<EQUAL? .WRD ,W?MISS ,W?MS ,W?ALEXIS>>>
|
|
|
|
<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)
|
|
<COND (<NOT <ZERO? .PREP>>
|
|
<COND (.SP? <TELL " ">)>
|
|
<SET WRD <PREP-FIND .PREP>>
|
|
<COND ;(<EQUAL? .WRD ,W?AGAINST> <TELL "against">)
|
|
(<EQUAL? .WRD ,W?THROUGH> <TELL "through">)
|
|
(T <PRINTB .WRD>)>
|
|
<COND (<AND <EQUAL? ,W?SIT <GET <GET ,P-ITBL ,P-VERBN> 0>>
|
|
<EQUAL? ,W?DOWN .WRD>>
|
|
<TELL " on">)>
|
|
<COND (<AND <EQUAL? ,W?GET <GET <GET ,P-ITBL ,P-VERBN> 0>>
|
|
<EQUAL? ,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 (<EQUAL? .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 <EQUAL? ,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)
|
|
<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)
|
|
<SET SIZE <* <GET ,PREPOSITIONS 0> 2>>
|
|
<REPEAT ()
|
|
<COND (<IGRTR? CNT .SIZE> <RFALSE>)
|
|
(<EQUAL? <GET ,PREPOSITIONS .CNT> .PREP>
|
|
<RETURN <GET ,PREPOSITIONS <- .CNT 1>>>)>>>
|
|
|
|
<ROUTINE SYNTAX-FOUND (SYN)
|
|
<SETG P-SYNTAX .SYN>
|
|
<SETG PRSA <GETB .SYN ,P-SACTION>>>
|
|
|
|
<GLOBAL P-GWIMBIT 0>
|
|
|
|
<ROUTINE GWIM (GBIT LBIT PREP "AUX" OBJ WPREP)
|
|
<COND (<EQUAL? .GBIT ,RLANDBIT>
|
|
<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 (<EQUAL? <GET ,P-MERGE ,P-MATCHLEN> 1>
|
|
<SET OBJ <GET ,P-MERGE 1>>
|
|
<TELL "(">
|
|
<COND (<PREP-PRINT .PREP <>>
|
|
<TELL " ">
|
|
<ARTICLE .OBJ T>)>
|
|
<TELL D .OBJ ")" CR>
|
|
.OBJ)>)
|
|
(T
|
|
<SETG P-GWIMBIT 0>
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE SNARF-OBJECTS ("AUX" PTR)
|
|
<COND (<NOT <EQUAL? <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 <ZERO? <GET ,P-BUTS ,P-MATCHLEN>>
|
|
<SETG P-PRSO <BUT-MERGE ,P-PRSO>>>)>
|
|
<COND (<NOT <EQUAL? <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 <ZERO? <GET ,P-BUTS ,P-MATCHLEN>>>
|
|
<COND (<EQUAL? <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)
|
|
<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-AND <>>
|
|
|
|
<ROUTINE SNARFEM (PTR EPTR TBL "AUX" (BUT <>) LEN WV WRD NW (WAS-ALL? <>))
|
|
;"Next SETG 6/21/84 for WHICH retrofix"
|
|
<SETG P-AND <>>
|
|
<COND (<EQUAL? ,P-GETFLAGS ,P-ALL>
|
|
<SET WAS-ALL? T>)>
|
|
<SETG P-GETFLAGS 0>
|
|
<PUT ,P-BUTS ,P-MATCHLEN 0>
|
|
<PUT .TBL ,P-MATCHLEN 0>
|
|
<SET WRD <GET .PTR 0>>
|
|
<REPEAT ()
|
|
<COND (<EQUAL? .PTR .EPTR>
|
|
<SET WV <GET-OBJECT <OR .BUT .TBL>>>
|
|
<COND (.WAS-ALL?
|
|
<SETG P-GETFLAGS ,P-ALL>)>
|
|
<RETURN .WV>)
|
|
(T
|
|
<SET NW <GET .PTR ,P-LEXELEN>>
|
|
<COND (<EQUAL? .WRD ,W?ALL ,W?BOTH ,W?EVERYTHING>
|
|
<SETG P-GETFLAGS ,P-ALL>
|
|
<COND (<EQUAL? .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 (<EQUAL? .NW ,W?OF>
|
|
<SET PTR <REST .PTR ,P-WORDLEN>>)>)
|
|
(T
|
|
<SETG P-NAM ,P-ONEOBJ>
|
|
<OR <GET-OBJECT <OR .BUT .TBL>> <RFALSE>>
|
|
<AND <ZERO? .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>)
|
|
(<EQUAL? .WRD ,W?OF>
|
|
<COND (<ZERO? ,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 <EQUAL? .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 X)
|
|
<SET XBITS ,P-SLOCBITS>
|
|
<SET TLEN <GET .TBL ,P-MATCHLEN>>
|
|
<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 <EQUAL? ,P-GETFLAGS ,P-ALL>>
|
|
<ZERO? ,P-GWIMBIT>>
|
|
<COND (.VRB
|
|
<NOT-IN-SENTENCE "enough nouns">)>
|
|
<RFALSE>)>
|
|
<COND (<OR <NOT <EQUAL? ,P-GETFLAGS ,P-ALL>> <ZERO? ,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 ,PROTAGONIST ,TRANSBIT>
|
|
<DO-SL ,HERE ,SOG ,SIR>
|
|
<FSET ,PROTAGONIST ,TRANSBIT>)>
|
|
<DO-SL ,PROTAGONIST ,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 <ZERO? .LEN>>>
|
|
<COND (<NOT <EQUAL? .LEN 1>>
|
|
<PUT .TBL 1 <GET .TBL <RANDOM .LEN>>>
|
|
<TELL "(How about ">
|
|
<ARTICLE <GET .TBL 1> T>
|
|
<TELL D <GET .TBL 1> "?)" CR>)>
|
|
<PUT .TBL ,P-MATCHLEN 1>)
|
|
(<OR <G? .LEN 1>
|
|
<AND <ZERO? .LEN> <NOT <EQUAL? ,P-SLOCBITS -1>>>>
|
|
<COND (<EQUAL? ,P-SLOCBITS -1>
|
|
<SETG P-SLOCBITS .XBITS>
|
|
<SET OLEN .LEN>
|
|
<PUT .TBL ,P-MATCHLEN <- <GET .TBL ,P-MATCHLEN> .LEN>>
|
|
<AGAIN>)
|
|
(T
|
|
<COND (<ZERO? .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 (<EQUAL? .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 <EQUAL? ,WINNER ,PROTAGONIST>>
|
|
<TELL "(Please try saying that another way.)" CR>
|
|
<RFALSE>)
|
|
(<AND .VRB ,P-NAM>
|
|
<WHICH-PRINT .TLEN .LEN .TBL>
|
|
<SETG P-ACLAUSE
|
|
<COND (<EQUAL? .TBL ,P-PRSO> ,P-NC1)
|
|
(T ,P-NC2)>>
|
|
<SETG P-AADJ ,P-ADJ>
|
|
<SETG P-ANAM ,P-NAM>
|
|
<ORPHAN <> <>>
|
|
<SETG P-OFLAG T>)
|
|
(.VRB
|
|
<NOT-IN-SENTENCE "enough nouns">)>
|
|
<SETG P-NAM <>>
|
|
<SETG P-ADJ <>>
|
|
<RFALSE>)>)
|
|
(<AND <ZERO? .LEN> .GCHECK>
|
|
<COND (.VRB
|
|
<SETG P-SLOCBITS .XBITS> ; "RETROFIX #33"
|
|
<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>)
|
|
(<ZERO? .LEN>
|
|
<SET GCHECK T>
|
|
;<COND (,DEBUG <TELL "[GETOBJ: GCHECK set to " N .GCHECK "]" CR>)>
|
|
<AGAIN>)>
|
|
<SET X <GET .TBL <+ .TLEN 1>>>
|
|
<COND (<AND ,P-ADJ <NOT ,P-NAM> .X>
|
|
<TELL ,I-ASSUME " ">
|
|
<ARTICLE .X T>
|
|
<TELL D .X ".)" CR>)>
|
|
<SETG P-SLOCBITS .XBITS>
|
|
<SETG P-NAM <>>
|
|
<SETG P-ADJ <>>
|
|
<RTRUE>>>
|
|
|
|
<ROUTINE SPEAKING-VERB? ("OPTIONAL" (V <>))
|
|
<COND (<NOT .V>
|
|
<SET V ,PRSA>)>
|
|
<COND (<OR <EQUAL? .V ,V?ASK-ABOUT ,V?ASK-FOR ,V?HELLO>
|
|
<EQUAL? .V ,V?TELL ,V?QUESTION ,V?REPLY>
|
|
;<EQUAL? .V ,V?WHAT-ABOUT ,V?GOODBYE>>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<GLOBAL P-MOBY-FOUND <>>
|
|
|
|
; <GLOBAL P-MOBY-FLAG <>> ; "Needed only for ZIL"
|
|
|
|
; "This MOBY-FIND works in ZIP only!"
|
|
|
|
<ROUTINE MOBY-FIND (TBL "AUX" (OBJ 1) LEN FOO)
|
|
<SETG P-NAM ,P-XNAM>
|
|
<SETG P-ADJ ,P-XADJ>
|
|
<PUT .TBL ,P-MATCHLEN 0>
|
|
<REPEAT ()
|
|
<COND (<AND <SET FOO <META-LOC .OBJ>>
|
|
<SET FOO <THIS-IT? .OBJ>>>
|
|
<SET FOO <OBJ-FOUND .OBJ .TBL>>)>
|
|
<COND (<IGRTR? OBJ ,DUMMY-OBJECT>
|
|
<RETURN>)>>
|
|
<SET LEN <GET .TBL ,P-MATCHLEN>>
|
|
<COND (<EQUAL? .LEN 1>
|
|
<SETG P-MOBY-FOUND <GET .TBL 1>>)>
|
|
.LEN>
|
|
|
|
; "This MOBY-FIND works in both ZIL and ZIP."
|
|
|
|
; <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>>
|
|
<SET FOO <THIS-IT? .OBJ>>>
|
|
<SET FOO <OBJ-FOUND .OBJ .TBL>>)>
|
|
<COND (<IGRTR? OBJ ,DUMMY-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)>>
|
|
|
|
<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>)
|
|
(<EQUAL? .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 " ">
|
|
<ARTICLE .OBJ T>
|
|
<TELL D .OBJ>
|
|
<COND (<EQUAL? .LEN 2>
|
|
<COND (<NOT <EQUAL? .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)
|
|
<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 (<EQUAL? ,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 (<EQUAL? <GET .TBL ,P-MATCHLEN> .LEN>
|
|
<SETG P-SLOCBITS -1>
|
|
<SETG P-TABLE .TBL>
|
|
<DO-SL ,GLOBAL-OBJECTS 1 1>
|
|
<SETG P-SLOCBITS .OBITS>
|
|
<COND (<ZERO? <GET .TBL ,P-MATCHLEN>>
|
|
<COND (<VERB? EXAMINE DUMB-EXAMINE LOOK-INSIDE FIND
|
|
FOLLOW LEAVE SEARCH SMELL THROUGH WALK-TO
|
|
WAIT-FOR LOOK-ON>
|
|
<DO-SL ,ROOMS 1 1>)>)>)>>
|
|
|
|
<ROUTINE DO-SL (OBJ BIT1 BIT2 "AUX" BITS)
|
|
<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)
|
|
<SET OBJ <FIRST? .OBJ>>
|
|
<COND (.OBJ
|
|
<REPEAT ()
|
|
<COND (<AND <NOT <EQUAL? .LVL ,P-SRCBOT>>
|
|
<GETPT .OBJ ,P?SYNONYM>
|
|
<THIS-IT? .OBJ>>
|
|
<OBJ-FOUND .OBJ .TBL>)>
|
|
<COND (<AND <OR <NOT <EQUAL? .LVL ,P-SRCTOP>>
|
|
; <FSET? .OBJ ,SEARCHBIT>
|
|
<FSET? .OBJ ,SURFACEBIT>>
|
|
<FIRST? .OBJ>
|
|
<SEE-INSIDE? .OBJ>
|
|
; <OR <SEE-INSIDE? .OBJ>
|
|
<FSET? .OBJ ,SURFACEBIT> ; "ADDED 3/26/85"
|
|
<FSET? .OBJ ,OPENBIT>
|
|
<FSET? .OBJ ,TRANSBIT>
|
|
,P-MOBY-FLAG ; "Needed only for ZIL"
|
|
<AND <FSET? .OBJ ,ACTORBIT>
|
|
<NOT <EQUAL? .OBJ ,PROTAGONIST>>>>
|
|
; <NOT <EQUAL? .OBJ ,PROTAGONIST ,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 <ZERO? ,P-GWIMBIT>> <NOT <FSET? .OBJ ,P-GWIMBIT>>>
|
|
<RFALSE>)>
|
|
<RTRUE>>
|
|
|
|
<ROUTINE OBJ-FOUND (OBJ TBL "AUX" PTR)
|
|
<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)
|
|
<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 (<EQUAL? .OBJ ,IT>
|
|
<COND (<NOT <ACCESSIBLE? ,P-IT-OBJECT>>
|
|
<REFERRING ;MORE-SPECIFIC>
|
|
<RFALSE>)
|
|
(T
|
|
<SET OBJ ,P-IT-OBJECT>)>)
|
|
(<EQUAL? .OBJ ,HER>
|
|
<COND (<NOT <ACCESSIBLE? ,P-HER-OBJECT>>
|
|
<REFERRING ;MORE-SPECIFIC>
|
|
<RFALSE>)
|
|
(T
|
|
<SET OBJ ,P-HER-OBJECT>)>)
|
|
(<EQUAL? .OBJ ,HIM>
|
|
<COND (<NOT <ACCESSIBLE? ,P-HIM-OBJECT>>
|
|
<REFERRING ;MORE-SPECIFIC>
|
|
<RFALSE>)
|
|
(T
|
|
<SET OBJ ,P-HIM-OBJECT>)>)
|
|
(<EQUAL? .OBJ ,THEM>
|
|
<COND (<NOT <ACCESSIBLE? ,P-THEM-OBJECT>>
|
|
<REFERRING ;MORE-SPECIFIC>
|
|
<RFALSE>)
|
|
(T
|
|
<SET OBJ ,P-THEM-OBJECT>)>)>
|
|
<COND (<AND <NOT <HELD? .OBJ>>
|
|
<NOT <EQUAL? .OBJ ,HANDS>>>
|
|
<SETG PRSO .OBJ>
|
|
<COND (<FSET? .OBJ ,TRYTAKEBIT>
|
|
<SET TAKEN T>)
|
|
(<NOT <EQUAL? ,WINNER ,PROTAGONIST>>
|
|
<SET TAKEN <>>)
|
|
(<AND <BTST .BITS ,STAKE>
|
|
<EQUAL? <ITAKE <>> T>>
|
|
<SET TAKEN <>>)
|
|
(T
|
|
<SET TAKEN T>)>
|
|
<COND (<AND .TAKEN <BTST .BITS ,SHAVE>>
|
|
;<TELL "(">
|
|
;<HE-SHE-IT ,WINNER T "do" ;"is">
|
|
<TELL "(You don'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 " ">
|
|
<ARTICLE .OBJ T>
|
|
<TELL D .OBJ>)>
|
|
<TELL "!)" CR>
|
|
<RFALSE>)
|
|
(<AND <NOT .TAKEN> <EQUAL? ,WINNER ,PROTAGONIST>>
|
|
<TELL "(taking ">
|
|
<ARTICLE ,PRSO T>
|
|
<TELL D ,PRSO>
|
|
<COND (,ITAKE-LOC
|
|
<TELL " from ">
|
|
<ARTICLE ,ITAKE-LOC T>
|
|
<TELL D ,ITAKE-LOC>)>
|
|
<TELL " first)" CR>)>)>>)
|
|
(T)>>
|
|
|
|
<ROUTINE MANY-CHECK ("AUX" (LOSS <>) TMP)
|
|
<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
|
|
; <TELL "(" ,CANT " use more than one ">
|
|
; <COND (<EQUAL? .LOSS 2>
|
|
<TELL "in">)>
|
|
; <TELL "direct object with \"">
|
|
<TELL "(" ,CANT " use more than one object at a time with \"">
|
|
<SET TMP <GET ,P-ITBL ,P-VERBN>>
|
|
<COND (<ZERO? .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
|
|
<RTRUE>)>>
|
|
|
|
<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 (<EQUAL? .ITM <GET .TBL .CNT>>
|
|
<COND (<ZERO? .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>)
|
|
(<EQUAL? .ITM <GET .TBL .CNT>>
|
|
<COND (<ZERO? .CNT> <RTRUE>)
|
|
(T <RETURN .CNT>)>)
|
|
(T <INC CNT>)>>>
|
|
|
|
<ROUTINE ZMEMQB (ITM TBL SIZE "AUX" (CNT 0))
|
|
<REPEAT ()
|
|
<COND (<EQUAL? .ITM <GETB .TBL .CNT>>
|
|
<COND (<ZERO? .CNT> <RTRUE>)
|
|
(T <RETURN .CNT>)>)
|
|
(<IGRTR? CNT .SIZE> <RFALSE>)>>>
|
|
|
|
<GLOBAL ALWAYS-LIT? <>>
|
|
|
|
<ROUTINE LIT? (RM "OPTIONAL" (RMBIT T) "AUX" OHERE (LIT <>))
|
|
<COND (<AND ,ALWAYS-LIT?
|
|
<EQUAL? ,WINNER ,PROTAGONIST>>
|
|
<RTRUE>)
|
|
(,ECLIPSE?
|
|
<RFALSE>)>
|
|
<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 (<EQUAL? .OHERE .RM>
|
|
<DO-SL ,WINNER 1 1>
|
|
<COND (<AND <NOT <EQUAL? ,WINNER ,PROTAGONIST>>
|
|
<IN? ,PROTAGONIST .RM>>
|
|
<DO-SL ,PROTAGONIST 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 PICK-ONE (FROB)
|
|
<GET .FROB <RANDOM <GET .FROB 0>>>>
|
|
|
|
<ROUTINE PICK-ONE (FROB "OPTIONAL" (THIS <>) "AUX" L CNT RND MSG RFROB)
|
|
<SET L <GET .FROB 0>>
|
|
<SET CNT <GET .FROB 1>>
|
|
<SET L <- .L 1>>
|
|
<SET FROB <REST .FROB 2>>
|
|
<SET RFROB <REST .FROB <* .CNT 2>>>
|
|
<COND (<AND .THIS
|
|
<ZERO? .CNT>>
|
|
<SET RND .THIS>)
|
|
(T
|
|
<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 (<EQUAL? .CNT .L>
|
|
<SET CNT 0>)>
|
|
<PUT .FROB 0 .CNT>
|
|
.MSG>
|
|
|
|
<ROUTINE DONT-HAVE? (OBJ "AUX" WHERE)
|
|
<SET WHERE <LOC .OBJ>>
|
|
<COND (<EQUAL? .WHERE ,PROTAGONIST>
|
|
<RFALSE>)
|
|
; (<AND <EQUAL? .OBJ ,MILK>
|
|
<IN? ,MILK ,BOTTLE>
|
|
<IN? ,BOTTLE ,PROTAGONIST>>
|
|
<RFALSE>)
|
|
(<IN? .WHERE ,PROTAGONIST>
|
|
<TELL "You'll have to take ">
|
|
<ARTICLE .OBJ T>
|
|
<TELL D .OBJ " ">
|
|
<COND (<FSET? .WHERE ,CONTBIT>
|
|
<TELL "out">)
|
|
(T
|
|
<TELL "off">)>
|
|
<TELL " of ">
|
|
<ARTICLE .WHERE T>
|
|
<TELL D .WHERE " first." CR>
|
|
<RTRUE>)
|
|
(T
|
|
<NOT-HOLDING .OBJ>
|
|
<RTRUE>)>>
|
|
|
|
<ROUTINE NOT-HOLDING ("OPTIONAL" (OBJ <>))
|
|
<TELL "You're not holding ">
|
|
<COND (.OBJ
|
|
<ARTICLE .OBJ T>
|
|
<PRINTD .OBJ>)
|
|
(T
|
|
<TELL "that">)>
|
|
<TELL "." CR>>
|
|
|
|
<ROUTINE ASKING? (ACTOR)
|
|
<COND (<AND <VERB? ASK-ABOUT ASK-FOR QUESTION ; WHAT-ABOUT>
|
|
<EQUAL? ,PRSO .ACTOR>>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE TALKING-TO? (ACTOR)
|
|
<COND (<ASKING? .ACTOR>
|
|
<RTRUE>)
|
|
(<AND <VERB? TELL HELLO WAVE-AT REPLY ALARM ; GOODBYE>
|
|
<EQUAL? ,PRSO .ACTOR>>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE TOUCHING? (THING)
|
|
<COND (<OR <EQUAL? ,PRSA ,V?TAKE ,V?RUB ,V?SHAKE>
|
|
<EQUAL? ,PRSA ,V?SWING ,V?PLAY ,V?SPIN>
|
|
<EQUAL? ,PRSA ,V?CLEAN ,V?PUT ,V?PUT-ON>
|
|
<EQUAL? ,PRSA ,V?MOVE ,V?PULL ,V?PUSH>
|
|
<EQUAL? ,PRSA ,V?PUT-UNDER ,V?PUT-BEHIND ,V?SMELL>
|
|
<EQUAL? ,PRSA ,V?KISS>
|
|
<HURT? .THING>>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE HURT? (THING)
|
|
<COND (<AND <OR <EQUAL? ,PRSA ,V?MUNG ,V?KICK ,V?KILL>
|
|
<EQUAL? ,PRSA ,V?KNOCK ,V?SQUEEZE ,V?CUT>
|
|
<EQUAL? ,PRSA ,V?BITE ,V?RAPE ,V?SHAKE>>
|
|
<EQUAL? ,PRSO .THING>>
|
|
<RTRUE>)
|
|
(<AND <VERB? THROW>
|
|
<EQUAL? ,PRSI .THING>>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE ENTER-FROM? (ENTRY "OPTIONAL" (DEST <>) (PLACE <>))
|
|
<COND (<VERB? WALK-TO THROUGH ENTER>
|
|
<COND (<EQUAL? ,HERE .ENTRY>
|
|
<DO-WALK ,P?IN>)
|
|
(<AND .DEST .PLACE
|
|
<EQUAL? ,HERE .DEST>>
|
|
<ALREADY-IN .PLACE>)
|
|
(T
|
|
<HOW?>)>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE USE-DOOR? (OUTSIDE)
|
|
<COND (<VERB? WALK-TO ENTER THROUGH USE>
|
|
<COND (<EQUAL? ,HERE .OUTSIDE>
|
|
<DO-WALK ,P?IN>)
|
|
(T
|
|
<DO-WALK ,P?OUT>)>
|
|
<RTRUE>)
|
|
(<VERB? EXIT>
|
|
<COND (<EQUAL? ,HERE .OUTSIDE>
|
|
<V-WALK-AROUND>)
|
|
(T
|
|
<DO-WALK ,P?OUT>)>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE ANYONE-HERE? ("AUX" OBJ)
|
|
<COND (<AND <EQUAL? ,HERE ,CLIFF-BOTTOM>
|
|
<IN? ,VULTURE ,GNARLED-TREE>>
|
|
<RETURN ,VULTURE>)
|
|
(T
|
|
<SET OBJ <FIRST? ,HERE>>
|
|
<REPEAT ()
|
|
<COND (<NOT .OBJ>
|
|
<RETURN>)
|
|
(<AND <FSET? .OBJ ,ACTORBIT>
|
|
<NOT <EQUAL? .OBJ ,PROTAGONIST ,VULTURE
|
|
,ALEXIS>>>
|
|
<RETURN>)
|
|
(T
|
|
<SET OBJ <NEXT? .OBJ>>)>>
|
|
<RETURN .OBJ>)>>
|
|
|
|
<ROUTINE FIXED-FONT-ON ()
|
|
<PUT 0 8 <BOR <GET 0 8> 2>>>
|
|
|
|
<ROUTINE FIXED-FONT-OFF ()
|
|
<PUT 0 8 <BAND <GET 0 8> -3>>>
|
|
|
|
<ROUTINE GETTING-INTO? ()
|
|
<COND (<OR <EQUAL? ,PRSA ,V?WALK-TO ,V?THROUGH ,V?ENTER>
|
|
<EQUAL? ,PRSA ,V?SIT ,V?STAND-ON ,V?LIE-DOWN>
|
|
<EQUAL? ,PRSA ,V?CLIMB-UP ,V?CLIMB-ON ,V?LEAP>
|
|
<EQUAL? ,PRSA ,V?SWIM ,V?WEAR ,V?WALK-AROUND>>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<ROUTINE SAY-THE (THING)
|
|
<TELL "The " D .THING>>
|
|
|
|
<ROUTINE BUT-THE (THING)
|
|
<TELL "But ">
|
|
<ARTICLE .THING T>
|
|
<TELL D .THING " ">>
|
|
|
|
<ROUTINE MOVING? (THING)
|
|
<COND (<AND <OR <EQUAL? ,PRSA ,V?MOVE ,V?PULL ,V?PUSH>
|
|
<EQUAL? ,PRSA ,V?TAKE ,V?TURN ,V?PUSH-TO>
|
|
<EQUAL? ,PRSA ,V?RAISE ,V?SPIN ,V?SHAKE>>
|
|
<EQUAL? ,PRSO .THING>>
|
|
<RTRUE>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<OBJECT NOT-HERE-OBJECT
|
|
(DESC "that")
|
|
(FLAGS NARTICLEBIT)
|
|
(ACTION NOT-HERE-OBJECT-F)>
|
|
|
|
<ROUTINE NOT-HERE-OBJECT-F ("AUX" TBL (PRSO? T) OBJ ; (X <>))
|
|
<COND (<AND <EQUAL? ,PRSO ,NOT-HERE-OBJECT>
|
|
<EQUAL? ,PRSI ,NOT-HERE-OBJECT>>
|
|
<TELL "Those things aren't here!" CR>
|
|
<RTRUE>)
|
|
(<EQUAL? ,PRSO ,NOT-HERE-OBJECT>
|
|
<SET TBL ,P-PRSO>)
|
|
(T
|
|
<SET TBL ,P-PRSI>
|
|
<SET PRSO? <>>)>
|
|
|
|
<COND (.PRSO?
|
|
<COND (<OR <EQUAL? ,PRSA ,V?FIND ,V?FOLLOW ,V?BUY>
|
|
<EQUAL? ,PRSA ,V?WAIT-FOR ; ,V?WALK-TO ; ,V?PLAY>
|
|
<AND <EQUAL? ,PRSA ,V?TAKE>
|
|
<NOT <EQUAL? ,WINNER ,PROTAGONIST>>>>
|
|
<COND (<SET OBJ <FIND-NOT-HERE .TBL .PRSO?>>
|
|
<COND (<NOT <EQUAL? .OBJ ,NOT-HERE-OBJECT>>
|
|
<RFATAL>)>)
|
|
(T
|
|
<RFALSE>)>)>)
|
|
(T
|
|
<COND (<EQUAL? ,PRSA ,V?TELL ,V?ASK-ABOUT ,V?ASK-FOR>
|
|
<RFALSE>)>)>
|
|
|
|
<TELL ,CANT " see">
|
|
<COND (<EQUAL? ,P-XNAM ,W?GRAVEDIGGER ,W?DIGGER ,W?ONE>
|
|
<TELL " the">)
|
|
(<NOT <NAME? ,P-XNAM>>
|
|
<TELL " any">)>
|
|
<NOT-HERE-PRINT .PRSO?>
|
|
<TELL " here!">
|
|
<COND (<EQUAL? ,HERE ,FUZZY>
|
|
<TELL " Everything is too " <PICK-ONE ,BLURS> ".">)>
|
|
<CRLF>
|
|
<PCLEAR>
|
|
<RFATAL>>
|
|
|
|
<ROUTINE FIND-NOT-HERE (TBL PRSO? "AUX" M-F OBJ)
|
|
<SET M-F <MOBY-FIND .TBL>>
|
|
;<COND (,DEBUG
|
|
<TELL "[Found " N .M-F " obj]" CR>)>
|
|
<COND (<EQUAL? 1 .M-F>
|
|
;<COND (,DEBUG <TELL "[Namely: " D ,P-MOBY-FOUND "]" CR>)>
|
|
<COND (.PRSO?
|
|
<SETG PRSO ,P-MOBY-FOUND>)
|
|
(T
|
|
<SETG PRSI ,P-MOBY-FOUND>)>
|
|
<RFALSE>)
|
|
;(<EQUAL? ,PRSA ,V?TELL ,V?ASK-FOR ,V?ASK-ABOUT>
|
|
<RFALSE>)
|
|
(<NOT .PRSO?>
|
|
<TELL "You wouldn't find any">
|
|
<NOT-HERE-PRINT .PRSO?>
|
|
<TELL " there." CR>
|
|
<RTRUE>)
|
|
(T
|
|
,NOT-HERE-OBJECT)>>
|
|
|
|
; <ROUTINE GLOBAL-NOT-HERE-PRINT (OBJ "AUX" TARGET)
|
|
<PCLEAR>
|
|
<COND (<EQUAL? .OBJ ,PRSO>
|
|
<SET TARGET ,PRSO>)
|
|
(T
|
|
<SET TARGET ,PRSI>)>
|
|
<YOU-CANT-SEE>
|
|
<COND (<NOT <FSET? .TARGET ,ACTORBIT>>
|
|
<TELL "any ">)>
|
|
<TELL D .TARGET " here!" CR>>
|
|
|
|
<ROUTINE NOT-HERE-PRINT ("OPTIONAL" (PRSO? <>))
|
|
<COND (,P-OFLAG
|
|
<COND (,P-XADJ
|
|
<TELL " ">
|
|
<PRINTB ,P-XADJN>)>
|
|
<COND (,P-XNAM
|
|
<TELL " ">
|
|
<PRINTB ,P-XNAM>)>)
|
|
(.PRSO?
|
|
<BUFFER-PRINT <GET ,P-ITBL ,P-NC1> <GET ,P-ITBL ,P-NC1L> <>>)
|
|
(T
|
|
<BUFFER-PRINT <GET ,P-ITBL ,P-NC2> <GET ,P-ITBL ,P-NC2L> <>>)>>
|
|
|
|
<OBJECT C-OBJECT>
|
|
|
|
<ROUTINE PRINT-CONTENTS (THING "AUX" OBJ NXT (1ST? T) (IT? <>) (TWO? <>))
|
|
<SET OBJ <FIRST? .THING>>
|
|
<REPEAT ()
|
|
<COND (.OBJ
|
|
<SET NXT <NEXT? .OBJ>>
|
|
<COND (<OR <FSET? .OBJ ,INVISIBLE>
|
|
; <FSET? .OBJ ,NDESCBIT>
|
|
<EQUAL? .OBJ ,WINNER>>
|
|
<MOVE .OBJ ,C-OBJECT>)>
|
|
<SET OBJ .NXT>)
|
|
(T
|
|
<RETURN>)>>
|
|
<SET OBJ <FIRST? .THING>>
|
|
<COND (<NOT .OBJ>
|
|
<TELL "nothing " <PICK-ONE ,YAWNS>>)
|
|
(T
|
|
<REPEAT ()
|
|
<COND (.OBJ
|
|
<SET NXT <NEXT? .OBJ>>
|
|
<COND (.1ST?
|
|
<SET 1ST? <>>)
|
|
(T
|
|
<COND (.NXT
|
|
<TELL ", ">)
|
|
(T
|
|
<TELL " and ">)>)>
|
|
<ARTICLE .OBJ>
|
|
<COND (,FUZZY?
|
|
<TELL <PICK-ONE ,BLURS> " ">)>
|
|
<TELL D .OBJ>
|
|
<COND (<FSET? .OBJ ,WORNBIT>
|
|
<TELL " (being worn)">)>
|
|
<COND (<FSET? .OBJ ,ONBIT>
|
|
<TELL " (providing light)">)>
|
|
<COND (<AND <EQUAL? .OBJ ,BROOM>
|
|
<IN? ,BROOM ,PROTAGONIST>
|
|
,BROOM-SIT?>
|
|
<TELL " (on which you're sitting)">)>
|
|
<COND (<AND <NOT .IT?>
|
|
<NOT .TWO?>>
|
|
<SET IT? .OBJ>)
|
|
(T
|
|
<SET TWO? T>
|
|
<SET IT? <>>)>
|
|
<SET OBJ .NXT>)
|
|
(T
|
|
<COND (<AND .IT?
|
|
<NOT .TWO?>>
|
|
<THIS-IS-IT .IT?>)>
|
|
<RETURN>)>>)>
|
|
<MOVE-ALL ,C-OBJECT .THING>>
|
|
|
|
<ROUTINE MOVE-ALL (FROM TO "AUX" OBJ NXT)
|
|
<SET OBJ <FIRST? .FROM>>
|
|
<REPEAT ()
|
|
<COND (.OBJ
|
|
<SET NXT <NEXT? .OBJ>>
|
|
<FCLEAR .OBJ ,WORNBIT>
|
|
<MOVE .OBJ .TO>
|
|
<SET OBJ .NXT>)
|
|
(T
|
|
<RTRUE>)>>>
|
|
|
|
<ROUTINE DESCRIBE-OBJECTS ("AUX" OBJ NXT STR (1ST? T) (TWO? <>) (IT? <>))
|
|
<COND (<NOT ,LIT>
|
|
<TOO-DARK>
|
|
<RTRUE>)>
|
|
|
|
; "Hide invisible objects"
|
|
|
|
<SET OBJ <FIRST? ,HERE>>
|
|
<COND (<NOT .OBJ>
|
|
<RTRUE>)>
|
|
|
|
<REPEAT ()
|
|
<COND (.OBJ
|
|
<SET NXT <NEXT? .OBJ>>
|
|
<COND (<OR <FSET? .OBJ ,INVISIBLE>
|
|
<FSET? .OBJ ,NDESCBIT>
|
|
<EQUAL? .OBJ ,WINNER>>
|
|
<MOVE .OBJ ,DUMMY-OBJECT>)>
|
|
<SET OBJ .NXT>)
|
|
(T
|
|
<RETURN>)>>
|
|
|
|
; "Apply all FDESCs and eliminate those objects"
|
|
|
|
<SET OBJ <FIRST? ,HERE>>
|
|
<REPEAT ()
|
|
<COND (.OBJ
|
|
<SET NXT <NEXT? .OBJ>>
|
|
<SET STR <GETP .OBJ ,P?FDESC>>
|
|
<COND (<AND .STR
|
|
<NOT <FSET? .OBJ ,TOUCHBIT>>>
|
|
<TELL CR .STR CR>
|
|
<MOVE .OBJ ,DUMMY-OBJECT>)>
|
|
<SET OBJ .NXT>)
|
|
(T
|
|
<RETURN>)>>
|
|
|
|
; "Apply all DESCFCNs and hide those objects"
|
|
|
|
<SET OBJ <FIRST? ,HERE>>
|
|
<REPEAT ()
|
|
<COND (.OBJ
|
|
<SET NXT <NEXT? .OBJ>>
|
|
<SET STR <GETP .OBJ ,P?DESCFCN>>
|
|
<COND (.STR
|
|
<CRLF>
|
|
<SET STR <APPLY .STR ,M-OBJDESC>>
|
|
<CRLF>
|
|
<MOVE .OBJ ,DUMMY-OBJECT>)>
|
|
<SET OBJ .NXT>)
|
|
(T
|
|
<RETURN>)>>
|
|
|
|
; "Print whatever's left in a nice sentence"
|
|
|
|
<SET OBJ <FIRST? ,HERE>>
|
|
<COND (.OBJ
|
|
<REPEAT ()
|
|
<COND (.OBJ
|
|
<SET NXT <NEXT? .OBJ>>
|
|
<COND (.1ST?
|
|
<SET 1ST? <>>
|
|
<CRLF>
|
|
<COND (.NXT
|
|
<TELL ,YOU-SEE>)
|
|
(T
|
|
<TELL "There's ">)>)
|
|
(T
|
|
<COND (.NXT
|
|
<TELL ", ">)
|
|
(T
|
|
<TELL " and ">)>)>
|
|
<ARTICLE .OBJ>
|
|
<TELL D .OBJ>
|
|
<COND (<FSET? .OBJ ,ONBIT>
|
|
<TELL " (providing light)">)>
|
|
<COND (<AND <SEE-INSIDE? .OBJ>
|
|
<SEE-ANYTHING-IN? .OBJ>
|
|
<NOT <EQUAL? .OBJ ,COAT>>>
|
|
<TELL " with ">
|
|
<PRINT-CONTENTS .OBJ>
|
|
<COND (<FSET? .OBJ ,CONTBIT>
|
|
<TELL " in">)
|
|
(T
|
|
<TELL " on">)>
|
|
<TELL " it">)>
|
|
<COND (<AND <NOT .IT?>
|
|
<NOT .TWO?>>
|
|
<SET IT? .OBJ>)
|
|
(T
|
|
<SET TWO? T>
|
|
<SET IT? <>>)>
|
|
<SET OBJ .NXT>)
|
|
(T
|
|
<COND (<AND .IT?
|
|
<NOT .TWO?>>
|
|
<THIS-IS-IT .IT?>)>
|
|
<TELL " here." CR>
|
|
<RETURN>)>>)>
|
|
<MOVE-ALL ,DUMMY-OBJECT ,HERE>>
|
|
|
|
<ROUTINE SEE-ANYTHING-IN? (THING "AUX" OBJ NXT (ANY? <>))
|
|
<SET OBJ <FIRST? .THING>>
|
|
<REPEAT ()
|
|
<COND (.OBJ
|
|
<COND (<AND <NOT <FSET? .OBJ ,INVISIBLE>>
|
|
<NOT <FSET? .OBJ ,NDESCBIT>>
|
|
<NOT <EQUAL? .OBJ ,WINNER>>>
|
|
<SET ANY? T>
|
|
<RETURN>)>
|
|
<SET OBJ <NEXT? .OBJ>>)
|
|
(T
|
|
<RETURN>)>>
|
|
<RETURN .ANY?>>
|
|
|
|
<ROUTINE GLOBAL-IN? (OBJ1 OBJ2 "AUX" T)
|
|
<COND (<SET T <GETPT .OBJ2 ,P?GLOBAL>>
|
|
<ZMEMQB .OBJ1 .T <- <PTSIZE .T> 1>>)>>
|
|
|
|
<ROUTINE ARTICLE (OBJ "OPTIONAL" (THE <>))
|
|
<COND (<FSET? .OBJ ,NARTICLEBIT>
|
|
<RFALSE>)
|
|
(.THE
|
|
<TELL "the ">)
|
|
(<FSET? .OBJ ,VOWELBIT>
|
|
<TELL "an ">)
|
|
(T
|
|
<TELL "a ">)>>
|
|
|
|
<GLOBAL YOU-SEE "You can see ">
|
|
<GLOBAL YOU-HEAR "You can hear ">
|
|
|
|
<ROUTINE HELD? (OBJ)
|
|
<COND (<NOT .OBJ>
|
|
<RFALSE>)
|
|
(<IN? .OBJ ,PROTAGONIST>
|
|
<RTRUE>)
|
|
(<IN? .OBJ ,WINNER>
|
|
<RTRUE>)
|
|
(<NOT <FSET? .OBJ ,TAKEBIT>>
|
|
<RFALSE>)
|
|
(<IN? .OBJ ,ROOMS>
|
|
<RFALSE>)
|
|
(<IN? .OBJ ,GLOBAL-OBJECTS>
|
|
<RFALSE>)
|
|
(T
|
|
<HELD? <LOC .OBJ>>)>>
|
|
|
|
<ROUTINE WHAT-A-CONCEPT ()
|
|
<TELL "What a concept!" CR>>
|
|
|
|
<ROUTINE YOU-DONT-NEED (THING "OPTIONAL" (STRING? <>))
|
|
<TELL "(You don't need to refer to ">
|
|
<COND (.STRING?
|
|
<TELL "the " .THING>)
|
|
(T
|
|
<ARTICLE .THING T>
|
|
<TELL D .THING>)>
|
|
<TELL " that way to finish this story.)" CR>>
|
|
|
|
<ROUTINE ITS-CLOSED (OBJ)
|
|
<THIS-IS-IT .OBJ>
|
|
<SAY-THE .OBJ>
|
|
<IS-CLOSED>
|
|
<CRLF>>
|
|
|
|
<ROUTINE IS-CLOSED ()
|
|
<TELL " is closed.">>
|
|
|
|
<ROUTINE IF-YOU-TRIED ()
|
|
<TELL " if you tried that!" CR>>
|
|
|
|
<ROUTINE AND-DROPS-OUT (THING)
|
|
<TELL " and ">
|
|
<FCLEAR .THING ,WORNBIT>
|
|
<COND (<EQUAL? ,HERE ,FOG>
|
|
<TELL "disappears in the fog." CR>
|
|
<MOVE .THING ,CLIFF-BOTTOM>)
|
|
(<EQUAL? ,HERE ,STEEP-TRAIL>
|
|
<TELL "tumbles over the edge of the cliff." CR>
|
|
<MOVE .THING ,CLIFF-BOTTOM>)
|
|
(<EQUAL? ,HERE ,FUZZY>
|
|
<TELL "disappears in the fuzziness." CR>
|
|
<MOVE .THING ,FUZZY-FROM>)
|
|
(T
|
|
<TELL "lands at your feet." CR>
|
|
<COND (<EQUAL? ,HERE ,OUTSIDE-COTTAGE>
|
|
<CRLF>
|
|
<PERFORM ,V?GIVE .THING ,POOCH>
|
|
<SETG CLOCK-WAIT T>
|
|
<RTRUE>)
|
|
(T
|
|
<MOVE .THING ,HERE>)>)>>
|
|
|
|
<ROUTINE OPEN-CLOSED (THING "OPTIONAL" (N? <>))
|
|
<COND (<FSET? .THING ,OPENBIT>
|
|
<COND (.N?
|
|
<TELL "n">)>
|
|
<TELL " open ">)
|
|
(T
|
|
<TELL " closed ">)>>
|
|
|
|
<ROUTINE WHICH-TOWN ("OPTIONAL" (STR <>))
|
|
<TELL " ">
|
|
<COND (<OR <NOT ,SKEWED?>
|
|
,SUCCESS?>
|
|
<TELL "Festeron">)
|
|
(T
|
|
<TELL "Witchville">)>
|
|
<COND (.STR
|
|
<TELL " " .STR>)>>
|
|
|
|
"*** COMMON INTERRUPTS ***"
|
|
|
|
<ROUTINE I-BEFORE-FIVE ()
|
|
<COND (<EQUAL? ,SCORE 16>
|
|
<COND (<ZERO? ,MOVES>
|
|
<BETTER-HURRY>)
|
|
(<EQUAL? ,MOVES 30>
|
|
<BETTER-HURRY T>)>)
|
|
(<AND <EQUAL? ,SCORE 17>
|
|
<NOT <EQUAL? ,HERE ,INSIDE-SHOPPE>>>
|
|
<FIRED T>)>>
|
|
|
|
<ROUTINE I-BREAK-IN ()
|
|
<COND (<AND <EQUAL? ,HERE ,JAIL-CELL>
|
|
<PROB 10>>
|
|
<CRLF>
|
|
<HEAR-WAILS>)>>
|
|
|
|
<ROUTINE I-CREAK ()
|
|
<COND (<EQUAL? ,HERE ,EDGE-OF-LAKE>
|
|
<COND (<FSET? ,NORTH-GATE ,RMUNGBIT>
|
|
<FCLEAR ,NORTH-GATE ,RMUNGBIT>)
|
|
(T
|
|
<DISABLE <INT I-CREAK>>
|
|
<FCLEAR ,NORTH-GATE ,LOCKEDBIT>
|
|
<FSET ,NORTH-GATE ,OPENBIT>
|
|
<THIS-IS-IT ,NORTH-GATE>
|
|
<TELL CR
|
|
"A rusty \"click!\" draws your eyes to the " D ,NORTH-GATE
|
|
". You watch as it slowly creaks open, all by itself!" CR>)>)>>
|
|
|
|
<ROUTINE I-VULTURE ()
|
|
<COND (<OR ,ECLIPSE? ,FUZZY?
|
|
<FSET? ,HERE ,INDOORSBIT>
|
|
<EQUAL? ,HERE ,WEST-OF-HOUSE>>
|
|
<RTRUE>)
|
|
(<OR <FSET? ,VULTURE ,RMUNGBIT>
|
|
<PROB 5>>
|
|
<FCLEAR ,VULTURE ,RMUNGBIT>
|
|
<MOVE ,VULTURE ,HERE>
|
|
<CRLF>
|
|
<SEE-VULTURE>)>>
|
|
|
|
<ROUTINE I-BEFORE-MOONSET ("AUX" H)
|
|
<COND (<G? ,SCORE 17>
|
|
<RTRUE>)
|
|
(<G? ,SCORE 5>
|
|
<CRLF>
|
|
<COND (<AND <NOT <FSET? ,HERE ,INDOORSBIT>>
|
|
<NOT ,FUZZY?>
|
|
<NOT ,ECLIPSE?>>
|
|
<TELL "You watch with horror as the " D ,MOON
|
|
" slowly sets in the western sky." CR CR>)>
|
|
<TELL "Out of nowhere, the sad voice of the "
|
|
D ,OLD-WOMAN " from the " D ,MAGICK-SHOPPE
|
|
" rises around you. \"Your quest is over" ,ADVENTURER
|
|
". The moon is set, and " D ,CHAOS " is no more. ">
|
|
<THANKS-ANYWAY>
|
|
<BAD-ENDING>)
|
|
(<ZERO? ,MOVES>
|
|
<SET H <- 6 ,SCORE>>
|
|
<SAY-HURRY>
|
|
<TELL "You've only got ">
|
|
<COND (<1? .H>
|
|
<TELL "one more hour">)
|
|
(T
|
|
<TELL N .H " hours">)>
|
|
<TELL " before the " D ,MOON " sets!)" CR>)>>
|
|
|
|
<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
|
|
"(You won't see the \"What next?\" prompt any more.)">
|
|
; <COND (<VERB? WAIT-FOR ;WAIT ;WAIT-UNTIL>
|
|
<CRLF>)>
|
|
<DISABLE <INT I-PROMPT-2>>
|
|
<RFALSE>)>>
|
|
|
|
<GLOBAL NO-LUCK? <>>
|
|
|
|
<ROUTINE I-LUCK ("OPTIONAL" (SHUTOFF? <>))
|
|
<COND (,NO-LUCK?
|
|
<RTRUE>)>
|
|
<COND (<AND <IN? ,SHOE ,PROTAGONIST>
|
|
<IN? ,WISHBRINGER ,PROTAGONIST>
|
|
<FSET? ,WISHBRINGER ,ONBIT>
|
|
<NOT .SHUTOFF?>>
|
|
<COND (<NOT ,LUCKY?>
|
|
<FSET ,SHOE ,ONBIT>
|
|
<THIS-IS-IT ,SHOE>
|
|
<SETG LUCKY? T>
|
|
<CRLF>
|
|
<SAY-THE ,SHOE>
|
|
<TELL " is twinkling again." CR>)>)
|
|
(T
|
|
<COND (,LUCKY?
|
|
<COND (<VISIBLE? ,SHOE>
|
|
<THIS-IS-IT ,SHOE>
|
|
<CRLF>
|
|
<SAY-THE ,SHOE>
|
|
<TELL " isn't twinkling any more." CR>)>
|
|
<FCLEAR ,SHOE ,ONBIT>
|
|
<SETG LUCKY? <>>)>)>
|
|
<COND (.SHUTOFF?
|
|
<SETG NO-LUCK? T>)>>
|
|
|
|
<ROUTINE I-GLOW ()
|
|
<COND (,ECLIPSE?
|
|
<RFALSE>)
|
|
(<IN? ,WISHBRINGER ,PROTAGONIST>
|
|
<COND (<FSET? ,WISHBRINGER ,TOOLBIT> ; "1st touch?"
|
|
<FCLEAR ,WISHBRINGER ,TOOLBIT>
|
|
<TELL CR
|
|
"As your fingers close around the " D ,WISHBRINGER " it begins to glow">
|
|
<SAY-GLOW>)
|
|
(<FSET? ,WISHBRINGER ,RMUNGBIT>
|
|
<CRLF>
|
|
<SAY-THE ,WISHBRINGER>
|
|
<TELL " begins to glow again." CR>)
|
|
(T
|
|
<RFALSE>)>
|
|
<FSET ,WISHBRINGER ,ONBIT>
|
|
<FCLEAR ,WISHBRINGER ,RMUNGBIT>
|
|
<COND (<NOT ,LIT>
|
|
<SETG LIT T>
|
|
<CRLF>
|
|
<V-LOOK>)>
|
|
<COND (<AND <FSET? ,LUCK ,TOUCHBIT>
|
|
<IN? ,SHOE ,PROTAGONIST>>
|
|
<I-LUCK>)>)
|
|
(<NOT <FSET? ,WISHBRINGER ,RMUNGBIT>>
|
|
<FSET ,WISHBRINGER ,RMUNGBIT> ; "Not being held"
|
|
<FCLEAR ,WISHBRINGER ,ONBIT>
|
|
<COND (<VISIBLE? ,WISHBRINGER>
|
|
<CRLF>
|
|
<SAY-THE ,WISHBRINGER>
|
|
<TELL " stops glowing." CR>)>
|
|
<SAY-IF-NOT-LIT>)
|
|
(T
|
|
<RFALSE>)>>
|
|
|
|
<GLOBAL SHELL-SCRIPT 5>
|
|
|
|
<ROUTINE I-SHELL-TALK ()
|
|
<SETG SHELL-SCRIPT <- ,SHELL-SCRIPT 1>>
|
|
<COND (<OR <ZERO? ,SHELL-SCRIPT>
|
|
<NOT <IN? ,CONCH-SHELL ,PROTAGONIST>>
|
|
<NOT <IN? ,WISHBRINGER ,PROTAGONIST>>>
|
|
<DISABLE <INT I-SHELL-TALK>>
|
|
<COND (<AND <VISIBLE? ,CONCH-SHELL>
|
|
<L? ,SHELL-SCRIPT 4>>
|
|
<THIS-IS-IT ,CONCH-SHELL>
|
|
<TELL CR
|
|
"The buzzing sound in the " D ,CONCH-SHELL " stops." CR>)>)
|
|
(<EQUAL? ,SHELL-SCRIPT 4>
|
|
<THIS-IS-IT ,CONCH-SHELL>
|
|
<TELL CR ,YOU-HEAR "a faint buzzing sound, like an overheard telephone, coming from the " D ,CONCH-SHELL "." CR>)
|
|
(<EQUAL? ,SHELL-SCRIPT 2>
|
|
<THIS-IS-IT ,CONCH-SHELL>
|
|
<TELL CR "(">
|
|
<SAY-THE ,CONCH-SHELL>
|
|
<TELL
|
|
" is still buzzing. Maybe you should listen to it.)" CR>)>>
|
|
|
|
; "*** ATARI: MAKE THIS TABLE PURE FOR NON-ATARI ZIPS"
|
|
|
|
<GLOBAL BOOT-PATH
|
|
<PTABLE FESTERON-POINT ; "0"
|
|
ROCKY-PATH ; "1"
|
|
SOUTH-OF-BRIDGE ; "2"
|
|
RIVER-OUTLET ; "3"
|
|
LOOKOUT-HILL ; "4"
|
|
RIVER-OUTLET ; "5"
|
|
EDGE-OF-LAKE ; "6"
|
|
ROTARY-WEST ; "7"
|
|
ROTARY-SOUTH ; "8"
|
|
ROTARY-EAST ; "9"
|
|
PLEASURE-WHARF ; "10"
|
|
WHARF ; "11"
|
|
PLEASURE-WHARF ; "12"
|
|
ROTARY-EAST ; "13"
|
|
PARK ; "14"
|
|
ROTARY-WEST ; "15"
|
|
ROTARY-NORTH ; "16"
|
|
SOUTH-OF-BRIDGE ; "17"
|
|
ROCKY-PATH ; "18"
|
|
FESTERON-POINT>>
|
|
|
|
<CONSTANT BOOT-MAX 18> ; "LENGTH OF BOOT-PATH"
|
|
<CONSTANT DIR-MAX 6> ; "MAXIMUM DIRECTION INDEX"
|
|
|
|
; "The following is a table of tables, one for each boot room.
|
|
Entries are in N-S-E-W-U-D-OUT order. All entries zero-aligned.
|
|
A room name in a slot indicates that you can see boots in that direction
|
|
when the boots are in the room corresponding to that table.
|
|
For example, if the boots are at South Of Bridge (Boot Room #2) and you
|
|
are at Rotary North, you can hear boots to the north. So the NORTH (#0)
|
|
entry for Boot Room #2 contains Rotary North (your location). Got it?"
|
|
|
|
; "*** ATARI: IMPURE TABLE (SEE PURE BELOW)"
|
|
|
|
; <GLOBAL DIRECTION-TABLES
|
|
<TABLE
|
|
; "0" <TABLE <> <> ROCKY-PATH <> <> <> <>>
|
|
; "1" <TABLE WEST-OF-HOUSE <> SOUTH-OF-BRIDGE FESTERON-POINT <> <> <>>
|
|
; "2" <TABLE ROTARY-NORTH ON-BRIDGE RIVER-OUTLET ROCKY-PATH <> <> <>>
|
|
; "3" <TABLE EDGE-OF-LAKE <> <> SOUTH-OF-BRIDGE <> LOOKOUT-HILL <>>
|
|
; "4" <TABLE <> <> <> <> RIVER-OUTLET <> UNDER-HILL>
|
|
; "5" <TABLE EDGE-OF-LAKE <> <> SOUTH-OF-BRIDGE <> LOOKOUT-HILL <>>
|
|
; "6" <TABLE TWILIGHT-GLEN RIVER-OUTLET <> ROTARY-WEST <> <> <>>
|
|
; "7" <TABLE <> <> EDGE-OF-LAKE PARK <> <> INSIDE-POLICE-STATION>
|
|
; "8" <TABLE OUTSIDE-COTTAGE PARK <> <> <> <> CIRCULATION-DESK>
|
|
; "9" <TABLE <> <> PARK PLEASURE-WHARF <> <> LOBBY>
|
|
; "10" <TABLE VIDEO-ARCADE <> ROTARY-EAST WHARF <> <> <>>
|
|
; "11" <TABLE <> <> PLEASURE-WHARF <> <> <> <>>
|
|
; "12" <TABLE VIDEO-ARCADE <> ROTARY-EAST WHARF <> <> <>>
|
|
; "13" <TABLE <> <> PARK PLEASURE-WHARF <> <> LOBBY>
|
|
; "14" <TABLE ROTARY-SOUTH ROTARY-NORTH ROTARY-WEST ROTARY-EAST <> <> <>>
|
|
; "15" <TABLE <> <> EDGE-OF-LAKE PARK <> <> INSIDE-POLICE-STATION>
|
|
; "16" <TABLE PARK SOUTH-OF-BRIDGE <> <> <> <> INSIDE-CHURCH>
|
|
; "17" <TABLE ROTARY-NORTH ON-BRIDGE RIVER-OUTLET ROCKY-PATH <> <> <>>
|
|
; "18" <TABLE WEST-OF-HOUSE <> SOUTH-OF-BRIDGE FESTERON-POINT <> <> <>>>>
|
|
|
|
; "*** ATARI: PURE VERSION FOR NON-ATARI ZIPS"
|
|
|
|
<GLOBAL DIRECTION-TABLES
|
|
<PTABLE
|
|
; "0" <PTABLE <> <> ROCKY-PATH <> <> <> <>>
|
|
; "1" <PTABLE WEST-OF-HOUSE <> SOUTH-OF-BRIDGE FESTERON-POINT <> <> <>>
|
|
; "2" <PTABLE ROTARY-NORTH ON-BRIDGE RIVER-OUTLET ROCKY-PATH <> <> <>>
|
|
; "3" <PTABLE EDGE-OF-LAKE <> <> SOUTH-OF-BRIDGE <> LOOKOUT-HILL <>>
|
|
; "4" <PTABLE <> <> <> <> RIVER-OUTLET <> UNDER-HILL>
|
|
; "5" <PTABLE EDGE-OF-LAKE <> <> SOUTH-OF-BRIDGE <> LOOKOUT-HILL <>>
|
|
; "6" <PTABLE TWILIGHT-GLEN RIVER-OUTLET <> ROTARY-WEST <> <> <>>
|
|
; "7" <PTABLE <> <> EDGE-OF-LAKE PARK <> <> INSIDE-POLICE-STATION>
|
|
; "8" <PTABLE OUTSIDE-COTTAGE PARK <> <> <> <> CIRCULATION-DESK>
|
|
; "9" <PTABLE <> <> PARK PLEASURE-WHARF <> <> LOBBY>
|
|
; "10" <PTABLE VIDEO-ARCADE <> ROTARY-EAST WHARF <> <> <>>
|
|
; "11" <PTABLE <> <> PLEASURE-WHARF <> <> <> <>>
|
|
; "12" <PTABLE VIDEO-ARCADE <> ROTARY-EAST WHARF <> <> <>>
|
|
; "13" <PTABLE <> <> PARK PLEASURE-WHARF <> <> LOBBY>
|
|
; "14" <PTABLE ROTARY-SOUTH ROTARY-NORTH ROTARY-WEST ROTARY-EAST <> <> <>>
|
|
; "15" <PTABLE <> <> EDGE-OF-LAKE PARK <> <> INSIDE-POLICE-STATION>
|
|
; "16" <PTABLE PARK SOUTH-OF-BRIDGE <> <> <> <> INSIDE-CHURCH>
|
|
; "17" <PTABLE ROTARY-NORTH ON-BRIDGE RIVER-OUTLET ROCKY-PATH <> <> <>>
|
|
; "18" <PTABLE WEST-OF-HOUSE <> SOUTH-OF-BRIDGE FESTERON-POINT <> <> <>>>>
|
|
|
|
<ROUTINE TO-N ()
|
|
<RETURN <GET ,DIR-NAMES 0>>>
|
|
|
|
<ROUTINE TO-S ()
|
|
<RETURN <GET ,DIR-NAMES 1>>>
|
|
|
|
<ROUTINE TO-E ()
|
|
<RETURN <GET ,DIR-NAMES 2>>>
|
|
|
|
<GLOBAL DIR-NAMES
|
|
<PTABLE
|
|
"to the north" ; "0"
|
|
"to the south" ; "1"
|
|
"to the east" ; "2"
|
|
"to the west" ; "3"
|
|
"on the summit of Lookout Hill" ; "4"
|
|
"at the bottom of the hill" ; "5"
|
|
"outside">> ; "6"
|
|
|
|
<GLOBAL BOOT-LOC 0>
|
|
<GLOBAL LAST-PLACE CLIFF-EDGE>
|
|
|
|
<ROUTINE I-BOOT-PATROL ("AUX" DIR-INDEX DIR-TABLE PLACE WHERE-BOOTS)
|
|
<COND (,ECLIPSE?
|
|
<RTRUE>)> ; "Abort if dark"
|
|
|
|
; "Move the boots only if the player has NOT moved"
|
|
|
|
<COND (<EQUAL? ,LAST-PLACE ,HERE>
|
|
|
|
; "Calc next boot location and move the boots"
|
|
|
|
<SET WHERE-BOOTS <LOC ,BOOTS>>
|
|
<COND (<AND ,FUZZY?
|
|
<EQUAL? ,FUZZY-FROM .WHERE-BOOTS>>
|
|
<TELL CR "The fuzzy">
|
|
<TRAMP>
|
|
<TELL "fades away." CR>)>
|
|
<SETG BOOT-LOC <+ ,BOOT-LOC 1>>
|
|
<COND (<G? ,BOOT-LOC ,BOOT-MAX>
|
|
<SETG BOOT-LOC 0>)>
|
|
<SET WHERE-BOOTS <GET ,BOOT-PATH ,BOOT-LOC>>
|
|
<MOVE ,BOOTS .WHERE-BOOTS>)
|
|
|
|
; "Update LAST-HERE if player moved"
|
|
|
|
(T
|
|
<SET WHERE-BOOTS <LOC ,BOOTS>>
|
|
<SETG LAST-PLACE ,HERE>)>
|
|
|
|
; "Check for boot collision"
|
|
|
|
<COND (<AND ,FUZZY?
|
|
<EQUAL? ,FUZZY-FROM .WHERE-BOOTS>>
|
|
<TELL CR ,YOU-HEAR "the">
|
|
<TRAMP>
|
|
<TELL
|
|
"all around you. But the sound is fuzzy and oddly distant." CR>
|
|
<RTRUE>)>
|
|
|
|
<COND (<EQUAL? ,HERE .WHERE-BOOTS>
|
|
<DEPOSIT-BRANCH>
|
|
|
|
; "Generic boot approach"
|
|
|
|
<TELL CR "The night is filled with rhythmic thunder, and a platoon of gigantic leather army " D ,BOOTS " marches into view. It's the Boot Patrol">
|
|
<COND (<NOT <ZERO? ,JAIL-VISITS>>
|
|
<TELL " again">)>
|
|
<TELL "!|
|
|
|
|
|
You're immediately surrounded, tied, gagged and dragged before an especially tall Boot. ">
|
|
|
|
; "Filter response according to JAIL-VISITS"
|
|
|
|
<COND (<ZERO? ,JAIL-VISITS>
|
|
<TELL
|
|
"\"What have we here?\" he hisses. \"Out after curfew? Tsk, tsk, tsk. I wonder what " D ,MACGUFFIN " will say about this.\"">)
|
|
|
|
(<EQUAL? ,JAIL-VISITS 1>
|
|
<TELL
|
|
"\"What!\" he cries. \"I thought you were locked up with " D ,MACGUFFIN ". Tsk, tsk.\"">)
|
|
|
|
(T ; "Last visit"
|
|
<TELL
|
|
"\"Escaped again!\" He looks around at the silent platoon. \"We don't want to bother " D ,MACGUFFIN>
|
|
<SHARK-SNACK>)>
|
|
|
|
<THROWN-OVER-SHOULDER> ; "Generic carry-away"
|
|
|
|
; "Handle 1st and 2nd JAIL-VISITS"
|
|
|
|
<COND (<EQUAL? ,JAIL-VISITS 0 1>
|
|
<TELL
|
|
"the " D ,GLOBBY " of the " D ,INSIDE-POLICE-STATION "." CR CR D ,MACGUFFIN
|
|
" glares at you as the " D ,BOOTS " dump you on the floor. ">
|
|
|
|
; "1st visit"
|
|
|
|
<COND (<ZERO? ,JAIL-VISITS>
|
|
<TELL
|
|
"\"What's this?\" he demands impatiently.|
|
|
|
|
|
\"A nightcrawler,\" hisses the Tall Boot, giving you a vicious little kick. \"Outside after curfew. Shall I feed it to the " D ,SHARKS "?\"" CR CR
|
|
D ,MACGUFFIN " shakes his head. \"Later. The Tower wants all prisoners held for questioning.\" He turns back to his work. \"Cell Three.\"">)
|
|
|
|
; "2nd visit"
|
|
|
|
(T
|
|
<TELL
|
|
"His eyes narrow when he sees you. ">
|
|
<JAIL-AGAIN>)>
|
|
|
|
; "1st and 2nd visit"
|
|
|
|
<TO-JAIL>)
|
|
|
|
; "Handle last visit"
|
|
|
|
(T
|
|
<INTO-BAY>)>
|
|
<RTRUE>)>
|
|
|
|
; "If no collision, scan for nearby boots"
|
|
|
|
<SET DIR-INDEX 0>
|
|
<SET DIR-TABLE <GET ,DIRECTION-TABLES ,BOOT-LOC>>
|
|
<REPEAT ()
|
|
<COND (<G? .DIR-INDEX ,DIR-MAX>
|
|
<RETURN>)>
|
|
<SET PLACE <GET .DIR-TABLE .DIR-INDEX>>
|
|
|
|
; "The following clause fixes the rotary problem"
|
|
|
|
<COND (<EQUAL? .PLACE ,PARK>
|
|
<COND (<AND <EQUAL? .DIR-INDEX 0 1>
|
|
<EQUAL? ,HERE ,ROTARY-WEST
|
|
,ROTARY-EAST>>
|
|
<SET PLACE ,HERE>)
|
|
(<AND <EQUAL? .DIR-INDEX 2 3>
|
|
<EQUAL? ,HERE ,ROTARY-NORTH
|
|
,ROTARY-SOUTH>>
|
|
<SET PLACE ,HERE>)>)>
|
|
|
|
<COND (<EQUAL? ,HERE .PLACE>
|
|
<THIS-IS-IT ,BOOTS>
|
|
<TELL CR ,YOU-HEAR "the">
|
|
<TRAMP>
|
|
<TELL <GET ,DIR-NAMES .DIR-INDEX> ".">
|
|
<COND (<EQUAL? ,HERE <GET ,BOOT-PATH <+ ,BOOT-LOC 1>>>
|
|
<COMING-THIS-WAY>)>
|
|
<CRLF>
|
|
<RETURN>)>
|
|
<SET DIR-INDEX <+ .DIR-INDEX 1>>>>
|
|
|
|
<GLOBAL JAIL-SCRIPT 24> ; "# turns for first jail visit"
|
|
|
|
<ROUTINE I-JAIL ()
|
|
<COND (<OR ,FUZZY? ,ECLIPSE?>
|
|
<RTRUE>)
|
|
(<EQUAL? ,HERE ,JAIL-CELL>
|
|
<SETG JAIL-SCRIPT <- ,JAIL-SCRIPT 1>>
|
|
<COND (<EQUAL? ,JAIL-SCRIPT 8>
|
|
<TELL CR ,YOU-HEAR>
|
|
<EVIL-VOICES>
|
|
<TELL "." CR>)
|
|
|
|
(<EQUAL? ,JAIL-SCRIPT 6 3>
|
|
<TELL CR "The ">
|
|
<EVIL-VOICES>
|
|
<TELL " laugh among themselves." CR>)
|
|
|
|
(<EQUAL? ,JAIL-SCRIPT 5>
|
|
<TELL CR "One of the ">
|
|
<EVIL-VOICES>
|
|
<TELL " just mentioned your name!" CR>)
|
|
|
|
(<EQUAL? ,JAIL-SCRIPT 2>
|
|
<TELL CR ,YOU-HEAR "the">
|
|
<TRAMP>
|
|
<TELL "in the " D ,CORRIDOR " outside.">
|
|
<COMING-THIS-WAY>
|
|
<CRLF>)
|
|
|
|
(<EQUAL? ,JAIL-SCRIPT 1>
|
|
<TELL CR
|
|
"Uh-oh. Somebody's unlocking your " D ,CELL-DOOR "!" CR>)
|
|
|
|
(<ZERO? ,JAIL-SCRIPT>
|
|
<TELL CR "The door flies open, and a dozen giant army boots stride into your cell.">
|
|
<THROWN-OVER-SHOULDER>
|
|
<TORTURE-ENDING>)
|
|
|
|
(<OR <EQUAL? ,JAIL-SCRIPT 7 4>
|
|
<PROB 10>>
|
|
<CRLF>
|
|
<HEAR-WAILS>)>)>>
|
|
|
|
<ROUTINE I-SMOKE ()
|
|
<COND (<EQUAL? ,HERE ,VIDEO-ARCADE>
|
|
<DISABLE <INT I-SMOKE>>
|
|
<TELL CR "A vague electrical smell quickly fades." CR>)>> |