1794 lines
53 KiB
Plaintext
1794 lines
53 KiB
Plaintext
"PARSER for
|
||
The Lurking Horror
|
||
(c) Copyright 1986 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 WINNER <>> ;"agent of the action"
|
||
<GLOBAL PRSA <>> ;"the verb"
|
||
<GLOBAL PRSO <>> ;"the first object"
|
||
<GLOBAL PRSI <>> ;"the second object"
|
||
|
||
"useful globals"
|
||
|
||
<GLOBAL P-IT-OBJECT <>>
|
||
|
||
<GLOBAL P-HIM-OBJECT <>>
|
||
|
||
<GLOBAL LAST-PSEUDO-LOC <>>
|
||
|
||
<GLOBAL P-ACT <>> ;"gets action associated with the verb"
|
||
|
||
<GLOBAL P-NAME <>>
|
||
|
||
<GLOBAL P-OFLAG <>> ;"T if last input was an orphan"
|
||
|
||
<GLOBAL P-MERGED <>> ;"T if this input was merged with an orphan"
|
||
|
||
<GLOBAL P-ACLAUSE <>>
|
||
|
||
<GLOBAL P-NCN 0> ;"how many noun clauses we've seen"
|
||
|
||
<GLOBAL QUOTE-FLAG <>> ;"T if we're in quoted text (or winner,verb)"
|
||
|
||
<GLOBAL P-END-ON-PREP <>> ;"T if the sentence ended on a prep."
|
||
|
||
<GLOBAL P-AND <>> ;"T if seen an AND in a noun clause"
|
||
|
||
<GLOBAL P-ONEOBJ <>>
|
||
|
||
|
||
|
||
"tables and globals for looking at the input"
|
||
|
||
<GLOBAL P-CONT <>> ;"offset of more to parse, <> if done"
|
||
<GLOBAL P-LEN 0> ;"saves number of words left to be examined"
|
||
|
||
<CONSTANT P-LEXWORDS 1> ;"Byte offset to # of entries in LEXV"
|
||
<CONSTANT P-LEXSTART 1> ;"Word offset to start of LEXV entries"
|
||
<CONSTANT P-LEXELEN 2> ;"Number of words per LEXV entry"
|
||
<CONSTANT P-WORDLEN 4> ;"number of bytes per LEXV entry"
|
||
|
||
<GLOBAL P-LEXV
|
||
<ITABLE 59 (LEXV) 0 #BYTE 0 #BYTE 0>>
|
||
<GLOBAL AGAIN-LEXV
|
||
<ITABLE 59 (LEXV) 0 #BYTE 0 #BYTE 0>>
|
||
<GLOBAL RESERVE-LEXV
|
||
<ITABLE 59 (LEXV) 0 #BYTE 0 #BYTE 0>>
|
||
<GLOBAL RESERVE-PTR <>>
|
||
|
||
<GLOBAL P-INBUF
|
||
<ITABLE 120 (BYTE LENGTH) 0>> ;"INBUF - Input buffer for READ"
|
||
<GLOBAL OOPS-INBUF
|
||
<ITABLE 120 (BYTE LENGTH) 0>>
|
||
|
||
"table and offsets for oops info"
|
||
|
||
<GLOBAL OOPS-TABLE <TABLE <> <> <> <>>>
|
||
<CONSTANT O-PTR 0> ;"word pointer to unknown token in P-LEXV"
|
||
<CONSTANT O-START 1> ;"word pointer to sentence start in P-LEXV"
|
||
<CONSTANT O-LENGTH 2> ;"byte length of unparsed tokens in P-LEXV"
|
||
<CONSTANT O-END 3> ;"byte pointer to first free byte in OOPS-INBUF"
|
||
|
||
"offsets in words"
|
||
|
||
<CONSTANT P-PSOFF 4> ;"Offset to parts of speech byte"
|
||
<CONSTANT P-P1OFF 5> ;"Offset to first part of speech"
|
||
|
||
<CONSTANT P-P1BITS 3> ;"First part of speech bit mask in PSOFF byte"
|
||
|
||
"p-itbl -- state of the parse is stored here"
|
||
|
||
<GLOBAL P-ITBL <TABLE 0 0 0 0 0 0 0 0 0 0>>
|
||
<GLOBAL P-VTBL <TABLE 0 #BYTE 0 #BYTE 0>>
|
||
|
||
"p-otbl -- just like p-itbl, for saving orphaned parses"
|
||
|
||
<GLOBAL P-OTBL <TABLE 0 0 0 0 0 0 0 0 0 0>>
|
||
<GLOBAL P-OVTBL <TABLE 0 #BYTE 0 #BYTE 0>>
|
||
|
||
"offsets in p-itbl and p-otbl"
|
||
|
||
<CONSTANT P-ITBLLEN 9> ;"length of p-itbl in words"
|
||
<CONSTANT P-VERB 0> ;"the action (act?foo)"
|
||
<CONSTANT P-VERBN 1> ;"lexv entries for it"
|
||
<CONSTANT P-PREP1 2> ;"first noun clause preposition"
|
||
<CONSTANT P-PREP1N 3> ;"word for it"
|
||
<CONSTANT P-PREP2 4> ;"second noun clause preposition"
|
||
<CONSTANT P-PREP2N 5> ;"word for it"
|
||
<CONSTANT P-NC1 6> ;"start of first noun clause"
|
||
<CONSTANT P-NC1L 7> ;"end of first noun clause"
|
||
<CONSTANT P-NC2 8> ;"start of second noun clause"
|
||
<CONSTANT P-NC2L 9> ;"end of second noun clause"
|
||
|
||
|
||
|
||
"PARSER -- 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 <>) (OF-FLAG <>)
|
||
OWINNER OMERGED LEN (DIR <>) (NW 0) (LW 0) (CNT -1))
|
||
<REPEAT ()
|
||
<COND (<G? <SET CNT <+ .CNT 1>> ,P-ITBLLEN> <RETURN>)
|
||
(T
|
||
<COND (<NOT ,P-OFLAG>
|
||
<PUT ,P-OTBL .CNT <GET ,P-ITBL .CNT>>)>
|
||
<PUT ,P-ITBL .CNT 0>)>>
|
||
<SET OWINNER ,WINNER>
|
||
<SET OMERGED ,P-MERGED>
|
||
<SETG P-ADVERB <>>
|
||
<SETG P-MERGED <>>
|
||
<SETG P-END-ON-PREP <>>
|
||
<PUT ,P-PRSO ,P-MATCHLEN 0>
|
||
<PUT ,P-PRSI ,P-MATCHLEN 0>
|
||
<PUT ,P-BUTS ,P-MATCHLEN 0>
|
||
<COND (<AND <NOT ,QUOTE-FLAG> <N==? ,WINNER ,PLAYER>>
|
||
<SETG WINNER ,PLAYER>
|
||
<COND (<NOT <FSET? <LOC ,WINNER> ,VEHBIT>>
|
||
<SETG HERE <LOC ,WINNER>>)>
|
||
<SETG LIT <LIT? ,HERE>>)>
|
||
<COND (,RESERVE-PTR
|
||
<SET PTR ,RESERVE-PTR>
|
||
<STUFF ,RESERVE-LEXV ,P-LEXV>
|
||
<COND (<AND ,VERBOSITY <EQUAL? ,PLAYER ,WINNER>>
|
||
<CRLF>)>
|
||
<SETG RESERVE-PTR <>>
|
||
<SETG P-CONT <>>)
|
||
(,P-CONT
|
||
<SET PTR ,P-CONT>
|
||
<COND (<AND ,VERBOSITY <EQUAL? ,PLAYER ,WINNER>>
|
||
<CRLF>)>
|
||
<SETG P-CONT <>>)
|
||
(T
|
||
<SETG WINNER ,PLAYER>
|
||
<SETG QUOTE-FLAG <>>
|
||
<COND (<NOT <FSET? <LOC ,WINNER> ,VEHBIT>>
|
||
<SETG HERE <LOC ,WINNER>>)>
|
||
<SETG LIT <LIT? ,HERE>>
|
||
<COND (,VERBOSITY <CRLF>)>
|
||
<TELL ">">
|
||
<READ ,P-INBUF ,P-LEXV>)>
|
||
<SETG P-LEN <GETB ,P-LEXV ,P-LEXWORDS>>
|
||
<COND (<ZERO? ,P-LEN>
|
||
<BEG-PARDON>
|
||
<RFALSE>)>
|
||
<COND (<EQUAL? <SET WRD <GET ,P-LEXV .PTR>> ,W?OOPS ,W?O>
|
||
<COND (<EQUAL? <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>
|
||
,W?PERIOD ,W?COMMA>
|
||
<SET PTR <+ .PTR ,P-LEXELEN>>
|
||
<SETG P-LEN <- ,P-LEN 1>>)>
|
||
<COND (<NOT <G? ,P-LEN 1>>
|
||
<TELL "I can't help your clumsiness." CR>
|
||
<RFALSE>)
|
||
(<GET ,OOPS-TABLE ,O-PTR>
|
||
<COND (<AND <G? ,P-LEN 2>
|
||
<EQUAL? <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>
|
||
,W?QUOTE>>
|
||
<TELL
|
||
"Sorry, you can't correct mistakes in quoted text." CR>
|
||
<RFALSE>)
|
||
(<G? ,P-LEN 2>
|
||
<TELL
|
||
"Warning: only the first word after OOPS is used." CR>)>
|
||
<PUT ,AGAIN-LEXV <GET ,OOPS-TABLE ,O-PTR>
|
||
<GET ,P-LEXV <+ .PTR ,P-LEXELEN>>>
|
||
<SETG WINNER .OWINNER> ;"maybe fix oops vs. chars.?"
|
||
<INBUF-ADD <GETB ,P-LEXV <+ <* .PTR ,P-LEXELEN> 6>>
|
||
<GETB ,P-LEXV <+ <* .PTR ,P-LEXELEN> 7>>
|
||
<+ <* <GET ,OOPS-TABLE ,O-PTR> ,P-LEXELEN> 3>>
|
||
<STUFF ,AGAIN-LEXV ,P-LEXV>
|
||
<SETG P-LEN <GETB ,P-LEXV ,P-LEXWORDS>>
|
||
<SET PTR <GET ,OOPS-TABLE ,O-START>>
|
||
<INBUF-STUFF ,OOPS-INBUF ,P-INBUF>)
|
||
(T
|
||
<PUT ,OOPS-TABLE ,O-END <>>
|
||
<TELL "There was no word to replace!" CR>
|
||
<RFALSE>)>)
|
||
(T
|
||
<COND (<NOT <EQUAL? .WRD ,W?AGAIN ,W?G>>
|
||
<SETG P-NUMBER 0>)>
|
||
<PUT ,OOPS-TABLE ,O-END <>>)>
|
||
<COND (<EQUAL? <GET ,P-LEXV .PTR> ,W?AGAIN ,W?G>
|
||
<COND (<ZERO? <GETB ,OOPS-INBUF 1>>
|
||
<BEG-PARDON>
|
||
<RFALSE>)
|
||
(,P-OFLAG
|
||
<TELL "It's difficult to repeat fragments." CR>
|
||
<RFALSE>)
|
||
(<NOT ,P-WON>
|
||
<TELL "That would just repeat a mistake." CR>
|
||
<RFALSE>)
|
||
(<G? ,P-LEN 1>
|
||
<COND (<OR <EQUAL? <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>
|
||
,W?PERIOD ,W?COMMA ,W?THEN>
|
||
<EQUAL? <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>
|
||
,W?AND>>
|
||
<SET PTR <+ .PTR <* 2 ,P-LEXELEN>>>
|
||
<PUTB ,P-LEXV ,P-LEXWORDS
|
||
<- <GETB ,P-LEXV ,P-LEXWORDS> 2>>)
|
||
(T
|
||
<TELL "I couldn't understand that sentence." CR>
|
||
<RFALSE>)>)
|
||
(T
|
||
<SET PTR <+ .PTR ,P-LEXELEN>>
|
||
<PUTB ,P-LEXV ,P-LEXWORDS
|
||
<- <GETB ,P-LEXV ,P-LEXWORDS> 1>>)>
|
||
<COND (<G? <GETB ,P-LEXV ,P-LEXWORDS> 0>
|
||
<STUFF ,P-LEXV ,RESERVE-LEXV>
|
||
<SETG RESERVE-PTR .PTR>)
|
||
(T
|
||
<SETG RESERVE-PTR <>>)>
|
||
;<SETG P-LEN <GETB ,AGAIN-LEXV ,P-LEXWORDS>>
|
||
<SETG WINNER .OWINNER>
|
||
<SETG P-MERGED .OMERGED>
|
||
<INBUF-STUFF ,OOPS-INBUF ,P-INBUF>
|
||
<STUFF ,AGAIN-LEXV ,P-LEXV>
|
||
<SET CNT -1>
|
||
<SET DIR ,AGAIN-DIR>
|
||
<REPEAT ()
|
||
<COND (<IGRTR? CNT ,P-ITBLLEN> <RETURN>)
|
||
(T <PUT ,P-ITBL .CNT <GET ,P-OTBL .CNT>>)>>)
|
||
(T
|
||
<STUFF ,P-LEXV ,AGAIN-LEXV>
|
||
<INBUF-STUFF ,P-INBUF ,OOPS-INBUF>
|
||
<PUT ,OOPS-TABLE ,O-START .PTR>
|
||
<PUT ,OOPS-TABLE ,O-LENGTH <* 4 ,P-LEN>>
|
||
<SET LEN
|
||
<* 2 <+ .PTR <* ,P-LEXELEN <GETB ,P-LEXV ,P-LEXWORDS>>>>>
|
||
<PUT ,OOPS-TABLE ,O-END <+ <GETB ,P-LEXV <- .LEN 1>>
|
||
<GETB ,P-LEXV <- .LEN 2>>>>
|
||
<SETG RESERVE-PTR <>>
|
||
<SET LEN ,P-LEN>
|
||
;<SETG P-DIR <>>
|
||
<SETG P-NCN 0>
|
||
<SETG P-GETFLAGS 0>
|
||
<REPEAT ()
|
||
<COND (<L? <SETG P-LEN <- ,P-LEN 1>> 0>
|
||
<SETG QUOTE-FLAG <>>
|
||
<RETURN>)
|
||
(<SET WRD <KNOWN-WORD? .PTR .VERB>>
|
||
<COND (<ZERO? ,P-LEN> <SET NW 0>)
|
||
(T <SET NW <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>>)>
|
||
<COND (<AND <EQUAL? .WRD ,W?TO>
|
||
<EQUAL? .VERB ,ACT?TELL ,ACT?ASK>
|
||
;"next clause added 8/20/84 by JW to
|
||
enable TELL MY NAME TO BEAST"
|
||
<NOT <ZERO?
|
||
<WT? .NW ,PS?VERB ,P1?VERB>>>>
|
||
<PUT ,P-ITBL ,P-VERB ,ACT?TELL>
|
||
<SET WRD ,W?QUOTE>)
|
||
(<AND <EQUAL? .WRD ,W?THEN>
|
||
<G? ,P-LEN 0>
|
||
<NOT .VERB>
|
||
<NOT ,QUOTE-FLAG>>
|
||
<COND (<EQUAL? .LW 0 ,W?PERIOD>
|
||
<SET WRD ,W?THE>)
|
||
(ELSE
|
||
<PUT ,P-ITBL ,P-VERB ,ACT?TELL>
|
||
<PUT ,P-ITBL ,P-VERBN 0>
|
||
<SET WRD ,W?QUOTE>)>)>
|
||
<COND (<EQUAL? .WRD ,W?THEN ,W?PERIOD ,W?QUOTE>
|
||
<COND (<EQUAL? .WRD ,W?QUOTE>
|
||
<COND ;"Following clause added for
|
||
WRITE 'FOO' ON CUBE"
|
||
(<AND <EQUAL? <GET ,P-LEXV .PTR>
|
||
,W?QUOTE>
|
||
<OR <NOT <EQUAL?
|
||
.VERB
|
||
,ACT?TELL
|
||
,ACT?SAY>>
|
||
<NOT <EQUAL? ,WINNER
|
||
,PLAYER>>>>
|
||
<YOU-CANT-X-THAT "use quotes like">
|
||
<RFALSE>)
|
||
(,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>)>
|
||
<COND (<AND ,P-OFLAG
|
||
<ZERO? .VERB>
|
||
<EQUAL? .WRD ,W?UP ,W?DOWN>
|
||
<EQUAL? <GET ,P-OTBL ,P-VERB>
|
||
,ACT?PUSH>
|
||
<EQUAL? <GET <GET ,P-OTBL ,P-NC1> 0>
|
||
,W?CALL ,W?BUTTON ,W?ARROW>>
|
||
<COND (<EQUAL? .WRD ,W?UP>
|
||
<SET WRD ,W?UP-ARROW>)
|
||
(<EQUAL? .WRD ,W?DOWN>
|
||
<SET WRD ,W?DOWN-ARROW>)>
|
||
<CHANGE-LEXV .PTR .WRD>)>
|
||
<COND (<AND <NOT <ZERO? <SET VAL
|
||
<WT? .WRD
|
||
,PS?DIRECTION
|
||
,P1?DIRECTION>>>>
|
||
<EQUAL? .VERB <> ,ACT?WALK ;,ACT?FLY>
|
||
<OR <EQUAL? .LEN 1>
|
||
<AND <EQUAL? .LEN 2>
|
||
<EQUAL? .VERB ,ACT?WALK ;,ACT?FLY>>
|
||
<AND <EQUAL? .NW
|
||
,W?THEN
|
||
,W?PERIOD
|
||
,W?QUOTE>
|
||
<NOT <L? .LEN 2>>>
|
||
<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>
|
||
<CHANGE-LEXV <+ .PTR ,P-LEXELEN>
|
||
,W?THEN>)>
|
||
<COND (<NOT <G? .LEN 2>>
|
||
<SETG QUOTE-FLAG <>>
|
||
<RETURN>)>)
|
||
(<AND <NOT <ZERO?
|
||
<SET VAL <WT? .WRD
|
||
,PS?VERB ,P1?VERB>>>>
|
||
<NOT .VERB>>
|
||
<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 CNT
|
||
<+ <* .PTR 2> 2>>>>
|
||
<PUTB ,P-VTBL 3 <GETB ,P-LEXV <+ .CNT 1>>>)
|
||
(<OR <NOT <ZERO? <SET VAL <WT? .WRD ,PS?PREPOSITION 0>>>>
|
||
<EQUAL? .WRD ,W?ALL ,W?ONE ,W?BOTH>
|
||
<NOT <ZERO? <WT? .WRD ,PS?ADJECTIVE>>>
|
||
<NOT <ZERO? <WT? .WRD ,PS?OBJECT>>>>
|
||
<COND (<AND <G? ,P-LEN 1>
|
||
<EQUAL? .NW ,W?OF>
|
||
<ZERO? .VAL>
|
||
<NOT <EQUAL? .WRD
|
||
,W?ALL ,W?ONE ,W?A>>
|
||
<NOT <EQUAL? .WRD
|
||
,W?BOTH>>>
|
||
<SET OF-FLAG T>)
|
||
(<AND <NOT <ZERO? .VAL>>
|
||
<OR <ZERO? ,P-LEN>
|
||
<EQUAL? .NW ,W?THEN ,W?PERIOD>>>
|
||
<SETG P-END-ON-PREP T>
|
||
<COND (<L? ,P-NCN 2>
|
||
<PUT ,P-ITBL ,P-PREP1 .VAL>
|
||
<PUT ,P-ITBL ,P-PREP1N .WRD>)>)
|
||
(<EQUAL? ,P-NCN 2>
|
||
<TELL
|
||
"There were too many nouns in that sentence." CR>
|
||
<RFALSE>)
|
||
(T
|
||
<COND (<AND <NOT <ZERO? .VAL>>
|
||
<EQUAL? .WRD
|
||
,W?UP ,W?DOWN ,W?U
|
||
,W?D>
|
||
<EQUAL? .NW
|
||
,W?BUTTON ,W?ARROW>>
|
||
<SET VAL <>>)>
|
||
<SETG P-NCN <+ ,P-NCN 1>>
|
||
<SETG P-ACT .VERB>
|
||
<OR <SET PTR <CLAUSE .PTR .VAL .WRD>>
|
||
<RFALSE>>
|
||
<COND (<L? .PTR 0>
|
||
<SETG QUOTE-FLAG <>>
|
||
<RETURN>)>)>)
|
||
(<EQUAL? .WRD ,W?OF>
|
||
<COND (<OR <NOT .OF-FLAG>
|
||
<EQUAL? .NW ,W?PERIOD ,W?THEN>>
|
||
<CANT-USE .PTR>
|
||
<RFALSE>)
|
||
(T
|
||
<SET OF-FLAG <>>)>)
|
||
(<NOT <ZERO? <WT? .WRD ,PS?BUZZ-WORD>>>)
|
||
(<AND <EQUAL? .VERB ,ACT?TELL>
|
||
<NOT <ZERO? <WT? .WRD ,PS?VERB ,P1?VERB>>>
|
||
;"Next expr added to fix FORD, TELL ME WHY"
|
||
;"NOT taken out of said expr to fix fix"
|
||
<EQUAL? ,WINNER ,PLAYER>>
|
||
<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>>>)>
|
||
<PUT ,OOPS-TABLE ,O-PTR <>>
|
||
<COND (.DIR
|
||
<SETG PRSA ,V?WALK>
|
||
<SETG PRSO .DIR>
|
||
<SETG P-OFLAG <>>
|
||
<SETG P-WALK-DIR .DIR>
|
||
<SETG AGAIN-DIR .DIR>)
|
||
(ELSE
|
||
<COND (,P-OFLAG <ORPHAN-MERGE>)>
|
||
<SETG P-WALK-DIR <>>
|
||
<SETG AGAIN-DIR <>>
|
||
<COND (<AND <SYNTAX-CHECK>
|
||
<SNARF-OBJECTS>
|
||
<MANY-CHECK>
|
||
<TAKE-CHECK>>
|
||
T)>)>>
|
||
|
||
<ROUTINE BEG-PARDON ()
|
||
<TELL "I beg your pardon?" CR>>
|
||
|
||
<ROUTINE KNOWN-WORD? (PTR "OPTIONAL" (VERB <>) "AUX" (WRD <>) (NWRD <>))
|
||
<COND (<SET WRD <GET ,P-LEXV .PTR>>
|
||
<COND ;(<EQUAL? .WRD ,W?XYZZY ,W?PLUGH>
|
||
<SETG P-NAME .WRD>
|
||
<SET NWRD ,W?INTNAME>)
|
||
(<EQUAL? .WRD ,W?EVERYTHING ,W?BOTH>
|
||
<SET NWRD ,W?ALL>)
|
||
(<EQUAL? .WRD ,W?A>
|
||
<SET NWRD ,W?ONE>)>)
|
||
(<OR <SET WRD <INPUT-EQUAL? .PTR ,LOGIN-ID ,W?XYZZY>>
|
||
<SET WRD <INPUT-EQUAL? .PTR ,PASSWORD-STRING ,W?PLUGH>>>
|
||
<SETG P-NAME .WRD>
|
||
<SET NWRD ,W?INTNAME>)
|
||
(<SET NWRD <NUMBER? .PTR>>)
|
||
(<EQUAL? .VERB ,ACT?TYPE ,ACT?LOGIN ,ACT?PASSWORD>
|
||
<SETG P-NAME .WRD>
|
||
<SET NWRD ,W?INTNAME>)>
|
||
<COND (.NWRD
|
||
<CHANGE-LEXV .PTR .NWRD>
|
||
<SET WRD .NWRD>)>
|
||
.WRD>
|
||
|
||
<ROUTINE INPUT-EQUAL? (PTR TBL WRD "AUX" LEX LPTR (CNT 0) CMAX)
|
||
<SET LEX <REST ,P-LEXV <* .PTR 2>>>
|
||
<SET CMAX <GETB .TBL 0>>
|
||
<COND (<EQUAL? .CMAX <GETB .LEX 2>>
|
||
<SET LPTR <GETB .LEX 3>>
|
||
<REPEAT ()
|
||
<COND (<IGRTR? CNT .CMAX> <RETURN .WRD>)
|
||
(<EQUAL? <GETB ,P-INBUF .LPTR>
|
||
<GETB .TBL .CNT>>
|
||
<SET LPTR <+ .LPTR 1>>)
|
||
(ELSE <RFALSE>)>>)>>
|
||
|
||
<CONSTANT LOGIN-ID <TABLE (PURE LENGTH STRING) "872325412">>
|
||
<CONSTANT PASSWORD-STRING <TABLE (PURE LENGTH STRING) "uhlersoth">>
|
||
|
||
<ROUTINE CHANGE-LEXV (PTR WRD)
|
||
<PUT ,P-LEXV .PTR .WRD>
|
||
<PUT ,AGAIN-LEXV .PTR .WRD>>
|
||
|
||
<GLOBAL P-WALK-DIR <>>
|
||
<GLOBAL AGAIN-DIR <>>
|
||
|
||
"For AGAIN purposes, put contents of one LEXV table into another."
|
||
|
||
<ROUTINE STUFF (SRC DEST "OPTIONAL" (MAX 29) "AUX" (PTR ,P-LEXSTART) (CTR 1)
|
||
BPTR)
|
||
<PUTB .DEST 0 <GETB .SRC 0>>
|
||
<PUTB .DEST 1 <GETB .SRC 1>>
|
||
<REPEAT ()
|
||
<PUT .DEST .PTR <GET .SRC .PTR>>
|
||
<SET BPTR <+ <* .PTR 2> 2>>
|
||
<PUTB .DEST .BPTR <GETB .SRC .BPTR>>
|
||
<SET BPTR <+ <* .PTR 2> 3>>
|
||
<PUTB .DEST .BPTR <GETB .SRC .BPTR>>
|
||
<SET PTR <+ .PTR ,P-LEXELEN>>
|
||
<COND (<IGRTR? CTR .MAX>
|
||
<RETURN>)>>>
|
||
|
||
"Put contents of one INBUF into another"
|
||
<ROUTINE INBUF-STUFF (SRC DEST "AUX" CNT)
|
||
<SET CNT <- <GETB .SRC 0> 1>>
|
||
<REPEAT ()
|
||
<PUTB .DEST .CNT <GETB .SRC .CNT>>
|
||
<COND (<DLESS? CNT 0> <RETURN>)>>>
|
||
|
||
"Put the word in the positions specified from P-INBUF to the end of
|
||
OOPS-INBUF, leaving the appropriate pointers in AGAIN-LEXV"
|
||
|
||
<ROUTINE INBUF-ADD (LEN BEG SLOT "AUX" DBEG (CTR 0) TMP)
|
||
<COND (<SET TMP <GET ,OOPS-TABLE ,O-END>>
|
||
<SET DBEG .TMP>)
|
||
(T
|
||
<SET DBEG <+ <GETB ,AGAIN-LEXV
|
||
<SET TMP <GET ,OOPS-TABLE ,O-LENGTH>>>
|
||
<GETB ,AGAIN-LEXV <+ .TMP 1>>>>)>
|
||
<PUT ,OOPS-TABLE ,O-END <+ .DBEG .LEN>>
|
||
<REPEAT ()
|
||
<PUTB ,OOPS-INBUF
|
||
<+ .DBEG .CTR>
|
||
<GETB ,P-INBUF <+ .BEG .CTR>>>
|
||
<SET CTR <+ .CTR 1>>
|
||
<COND (<EQUAL? .CTR .LEN> <RETURN>)>>
|
||
<PUTB ,AGAIN-LEXV .SLOT .DBEG>
|
||
<PUTB ,AGAIN-LEXV <- .SLOT 1> .LEN>>
|
||
|
||
"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>)
|
||
(<EQUAL? .BIT ,PS?OBJECT> 1)
|
||
(T
|
||
<SET TYP <BAND .TYP ,P-P1BITS>>
|
||
<COND (<NOT <EQUAL? .TYP .B1>> <SET OFFS <+ .OFFS 1>>)>
|
||
<GETB .PTR .OFFS>)>)
|
||
(<EQUAL? .BIT ,PS?ADJECTIVE>
|
||
<COND (<EQUAL? .PTR ,W?UP ,W?U>
|
||
<WT? ,W?UP-ARROW ,PS?ADJECTIVE .B1>)
|
||
(<EQUAL? .PTR ,W?DOWN ,W?D>
|
||
<WT? ,W?DOWN-ARROW ,PS?ADJECTIVE .B1>)
|
||
(ELSE <RFALSE>)>)>>
|
||
|
||
"Scan through a noun clause, leave a pointer to its starting location"
|
||
|
||
<ROUTINE CLAUSE (PTR VAL WRD "AUX" OFF NUM (ANDFLG <>) (1ST? 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 (<SET WRD <KNOWN-WORD? .PTR>>
|
||
<COND (<ZERO? ,P-LEN> <SET NW 0>)
|
||
(T <SET NW <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>>)>
|
||
<COND (<AND <EQUAL? .WRD ,W?QUOTE>
|
||
<NOT <EQUAL? ,P-ACT ,ACT?TELL ,ACT?SAY>>>
|
||
<COND ;(<QUOTED-PHRASE .PTR ,P-ACT>
|
||
<SET PTR <+ .PTR ,P-LEXELEN>>
|
||
<AGAIN>)
|
||
(ELSE <RFALSE>)>)
|
||
(<EQUAL? .WRD ,W?AND ,W?COMMA>
|
||
<SET ANDFLG .WRD>)
|
||
(<EQUAL? .WRD ,W?ALL ,W?ONE ,W?BOTH>
|
||
<COND (<EQUAL? .NW ,W?OF>
|
||
<SETG P-LEN <- ,P-LEN 1>>
|
||
<SET PTR <+ .PTR ,P-LEXELEN>>)>)
|
||
(<OR <EQUAL? .WRD ,W?THEN ,W?PERIOD>
|
||
<AND <NOT <ZERO? <WT? .WRD ,PS?PREPOSITION>>>
|
||
<GET ,P-ITBL ,P-VERB>
|
||
;"ADDED 4/27 FOR TURTLE,UP"
|
||
<NOT .1ST?>>>
|
||
<SETG P-LEN <+ ,P-LEN 1>>
|
||
<PUT ,P-ITBL
|
||
<+ .NUM 1>
|
||
<REST ,P-LEXV <* .PTR 2>>>
|
||
<RETURN <- .PTR ,P-LEXELEN>>)
|
||
;"This next clause was 2 clauses further down"
|
||
;"This attempts to fix EDDIE, TURN ON COMPUTER"
|
||
(<AND <EQUAL? .ANDFLG ,W?COMMA>
|
||
<EQUAL? <GET ,P-ITBL ,P-VERB> 0>>
|
||
<SET PTR <- .PTR 4>>
|
||
<CHANGE-LEXV <+ .PTR 2> ,W?THEN>
|
||
<SETG P-LEN <+ ,P-LEN 2>>)
|
||
(<NOT <ZERO? <WT? .WRD ,PS?OBJECT>>>
|
||
<COND ;"First clause added 1/10/84 to fix
|
||
'verb AT synonym OF synonym' bug"
|
||
(<AND <G? ,P-LEN 0>
|
||
<EQUAL? .NW ,W?OF>
|
||
<NOT <EQUAL? .WRD ,W?ALL ,W?ONE>>>
|
||
T)
|
||
;"next clause makes 'give troll red book'
|
||
have only one noun clause. careful!"
|
||
(<AND <NOT <ZERO? <WT? .WRD
|
||
,PS?ADJECTIVE
|
||
,P1?ADJECTIVE>>>
|
||
<NOT <EQUAL? .NW 0>>
|
||
<OR <WT? .NW ,PS?OBJECT>
|
||
<WT? .NW ,PS?ADJECTIVE>>>)
|
||
(<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 on from games
|
||
with characters"
|
||
;(<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 <NOT <ZERO? <WT? .WRD ,PS?ADJECTIVE>>>
|
||
<NOT <ZERO? <WT? .WRD ,PS?BUZZ-WORD>>>>)
|
||
(<NOT <ZERO? <WT? .WRD ,PS?PREPOSITION>>> T)
|
||
(T
|
||
<CANT-USE .PTR>
|
||
<RFALSE>)>)
|
||
(T <UNKNOWN-WORD .PTR> <RFALSE>)>
|
||
<SET LW .WRD>
|
||
<SET 1ST? <>>
|
||
<SET PTR <+ .PTR ,P-LEXELEN>>>>
|
||
|
||
<ROUTINE NUMBER? (PTR "AUX" CNT BPTR CHR (SUM 0))
|
||
<SETG P-TIME? <>>
|
||
<SETG P-MINUTES 0>
|
||
<SET CNT <GETB <REST ,P-LEXV <* .PTR 2>> 2>>
|
||
<SET BPTR <GETB <REST ,P-LEXV <* .PTR 2>> 3>>
|
||
<REPEAT ()
|
||
<COND (<L? <SET CNT <- .CNT 1>> 0> <RETURN>)
|
||
(T
|
||
<SET CHR <GETB ,P-INBUF .BPTR>>
|
||
<COND (<EQUAL? .CHR %<ASCII !\:>>
|
||
<SETG P-TIME? T>
|
||
<SETG P-MINUTES <* .SUM 60>>
|
||
<SET SUM 0>)
|
||
(<AND <L? .CHR 58> <G? .CHR 47>>
|
||
<COND (<G? .SUM 6553>
|
||
<SET SUM 10000>
|
||
<RETURN>)>
|
||
<SET SUM <+ <* .SUM 10> <- .CHR 48>>>)
|
||
(T <RFALSE>)>
|
||
<SET BPTR <+ .BPTR 1>>)>>
|
||
<SETG P-NUMBER .SUM>
|
||
<COND (,P-TIME?
|
||
<SETG P-NUMBER <+ ,P-MINUTES ,P-NUMBER>>)>
|
||
,W?INTNUM>
|
||
|
||
<GLOBAL P-TIME? <>> ;"t if reading a time"
|
||
<GLOBAL P-MINUTES 0> ;"number to left of : in a time"
|
||
<GLOBAL P-NUMBER 0> ;"actual number found (NUMBER? substitutes INTNUM)"
|
||
|
||
|
||
|
||
<ROUTINE ORPHAN-MERGE ("AUX" (CNT -1) TEMP VERB BEG END
|
||
(ADJ <>) (ADJB <>) (VRB <>) (NOUN <>) ADJE WRD)
|
||
<SETG P-OFLAG <>>
|
||
<COND (<SET WRD <GET <GET ,P-ITBL ,P-VERBN> 0>>
|
||
<COND (<EQUAL? <WT? .WRD ,PS?VERB ,P1?VERB>
|
||
<GET ,P-OTBL ,P-VERB>>
|
||
<SET VRB T>)>
|
||
<COND (<WT? .WRD ,PS?ADJECTIVE>
|
||
<SET ADJ T>)>
|
||
<COND (<WT? .WRD ,PS?OBJECT>
|
||
<SET NOUN T>)>)>
|
||
<COND (<AND <NOT .VRB> ;"convert apparent verb into noun clause"
|
||
<NOT .ADJ>
|
||
<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 .VRB>
|
||
<NOT <EQUAL? .VERB <GET ,P-OTBL ,P-VERB>>>>
|
||
<RFALSE>)
|
||
(<EQUAL? ,P-NCN 2> <RFALSE>)
|
||
(<EQUAL? <GET ,P-OTBL ,P-NC1> 1>
|
||
<COND (<EQUAL? <GET ,P-ITBL ,P-PREP1>
|
||
0
|
||
<GET ,P-OTBL ,P-PREP1>>
|
||
<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>>)>
|
||
<COND (<ZERO? ,P-NCN> <SETG P-NCN 1>)>)>
|
||
<PUT ,P-OTBL ,P-NC1 <GET ,P-ITBL ,P-NC1>>
|
||
<PUT ,P-OTBL ,P-NC1L <GET ,P-ITBL ,P-NC1L>>)
|
||
(T <RFALSE>)>)
|
||
(<EQUAL? <GET ,P-OTBL ,P-NC2> 1>
|
||
<COND (<EQUAL? <GET ,P-ITBL ,P-PREP1>
|
||
<>
|
||
<GET ,P-OTBL ,P-PREP2>>
|
||
<COND (<OR .ADJ
|
||
<AND <ZERO? ,P-NCN> .NOUN>>
|
||
<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>>
|
||
<PUT ,P-ITBL ,P-NC1 .BEG>
|
||
<SET ADJ <>>)>
|
||
<SET END <GET ,P-ITBL ,P-NC1L>>
|
||
<REPEAT ()
|
||
<COND (<EQUAL? .BEG .END>
|
||
<COND (.ADJB <CLAUSE-WIN .ADJB .ADJE> <RETURN>)
|
||
(T
|
||
<SETG P-ACLAUSE <>>
|
||
<RFALSE>)>)>
|
||
<SET WRD <GET .BEG 0>>
|
||
<COND (<OR <EQUAL? .WRD ,W?ALL ,W?ONE>
|
||
<BTST <GETB .WRD ,P-PSOFF> ,PS?ADJECTIVE>>
|
||
<COND (<NOT .ADJB> <SET ADJB .BEG>)>
|
||
<SET ADJE <REST .BEG ,P-WORDLEN>>)
|
||
(<AND <BTST <GETB .WRD ,P-PSOFF> ,PS?OBJECT>
|
||
<EQUAL? <+ .BEG ,P-WORDLEN> .END>>
|
||
<COND (<AND ,P-ANAM
|
||
<NOT <EQUAL? .WRD ,P-ANAM>>>
|
||
<SETG P-ANAM <>>
|
||
<SET ADJB <GET ,P-ITBL ,P-NC1>>
|
||
<SET ADJE .END>)>)>
|
||
<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>
|
||
|
||
<ROUTINE CLAUSE-WIN ("OPT" (ADJB <>) (ADJE <>))
|
||
<COND (.ADJB
|
||
<PUT ,P-ITBL ,P-VERB <GET ,P-OTBL ,P-VERB>>)>
|
||
<PUT ,P-CCTBL ,CC-BEG ,P-ACLAUSE>
|
||
<PUT ,P-CCTBL ,CC-END <+ ,P-ACLAUSE 1>>
|
||
<PUT ,P-CCTBL ,CC-IBEG .ADJB>
|
||
<PUT ,P-CCTBL ,CC-IEND .ADJE>
|
||
<COND (<EQUAL? ,P-ACLAUSE ,P-NC1>
|
||
<PUT ,P-CCTBL ,CC-CLAUSE ,P-OCL1>)
|
||
(ELSE
|
||
<PUT ,P-CCTBL ,CC-CLAUSE ,P-OCL2>)>
|
||
<CLAUSE-COPY ,P-OTBL ,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)
|
||
<REPEAT ()
|
||
<COND (<DLESS? CNT 0> <RETURN>)
|
||
(ELSE
|
||
<PRINTC <GETB ,P-INBUF .BUF>>
|
||
<SET BUF <+ .BUF 1>>)>>>
|
||
|
||
<ROUTINE UNKNOWN-WORD (PTR "AUX" BUF)
|
||
<PUT ,OOPS-TABLE ,O-PTR .PTR>
|
||
<TELL "I don't know the word \"">
|
||
<WORD-PRINT <GETB <REST ,P-LEXV <SET BUF <* .PTR 2>>> 2>
|
||
<GETB <REST ,P-LEXV .BUF> 3>>
|
||
<TELL ".\"" CR>
|
||
<SETG QUOTE-FLAG <>>
|
||
<SETG P-OFLAG <>>>
|
||
|
||
<ROUTINE CANT-USE (PTR "AUX" BUF)
|
||
<TELL "You used the word \"">
|
||
<WORD-PRINT <GETB <REST ,P-LEXV <SET BUF <* .PTR 2>>> 2>
|
||
<GETB <REST ,P-LEXV .BUF> 3>>
|
||
<TELL "\" in a way that I don't understand." CR>
|
||
<SETG QUOTE-FLAG <>>
|
||
<SETG P-OFLAG <>>>
|
||
|
||
" 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-SYNTAX 0> ;"where the actual syntax found is saved"
|
||
<GLOBAL P-SLOCBITS 0> ;"location bits (where to look)"
|
||
|
||
"definition of a syntax"
|
||
|
||
<CONSTANT P-SYNLEN 8> ;"length in bytes"
|
||
<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 TMP)
|
||
<COND (<ZERO? <SET VERB <GET ,P-ITBL ,P-VERB>>>
|
||
<TELL "There was no verb in that sentence!" CR>
|
||
<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)
|
||
(<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
|
||
<TELL ,NOT-RECOGNIZED CR>
|
||
<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 "I can't answer that question." CR>
|
||
<RFALSE>)
|
||
(<NOT <EQUAL? ,WINNER ,PLAYER>>
|
||
<TELL
|
||
"I don't understand. What are you referring to?" CR>
|
||
<RFALSE>)
|
||
(T
|
||
<ORPHAN .DRIVE1 .DRIVE2>
|
||
<TELL ,WHAT-DO-YOU-WANT-TO>
|
||
<SET TMP <GET ,P-OTBL ,P-VERBN>>
|
||
<COND (<EQUAL? .TMP 0>
|
||
<TELL "tell">)
|
||
(<ZERO? <GETB ,P-VTBL 2>>
|
||
<PRINTB <GET .TMP 0>>)
|
||
(T
|
||
<WORD-PRINT <GETB .TMP 2> <GETB .TMP 3>>
|
||
<PUTB ,P-VTBL 2 0>)>
|
||
<COND (.DRIVE2
|
||
<TELL " ">
|
||
<THING-PRINT T T>)>
|
||
<SETG P-OFLAG T>
|
||
<PREP-PRINT <COND (.DRIVE1 <GETB .DRIVE1 ,P-SPREP1>)
|
||
(T <GETB .DRIVE2 ,P-SPREP2>)>>
|
||
<TELL "?" CR>
|
||
<RFALSE>)>>
|
||
|
||
<GLOBAL NOT-RECOGNIZED "That sentence isn't one I recognize.">
|
||
|
||
|
||
<ROUTINE ORPHAN (D1 D2 "AUX" (CNT -1))
|
||
<COND (<NOT ,P-MERGED>
|
||
<PUT ,P-OCL1 ,P-MATCHLEN 0>
|
||
<PUT ,P-OCL2 ,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-BEG ,P-NC2>
|
||
<PUT ,P-CCTBL ,CC-END ,P-NC2L>
|
||
<PUT ,P-CCTBL ,CC-CLAUSE ,P-OCL2>
|
||
<PUT ,P-CCTBL ,CC-IBEG <>>
|
||
<PUT ,P-CCTBL ,CC-IEND <>>
|
||
<CLAUSE-COPY ,P-ITBL ,P-OTBL>)>
|
||
<COND (<NOT <L? ,P-NCN 1>>
|
||
<PUT ,P-CCTBL ,CC-BEG ,P-NC1>
|
||
<PUT ,P-CCTBL ,CC-END ,P-NC1L>
|
||
<PUT ,P-CCTBL ,CC-CLAUSE ,P-OCL1>
|
||
<PUT ,P-CCTBL ,CC-IBEG <>>
|
||
<PUT ,P-CCTBL ,CC-IEND <>>
|
||
<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 ORPHAN-VERB (WRD ACT)
|
||
<PUT ,P-VTBL 0 .WRD>
|
||
<PUT ,P-OTBL ,P-VERB .ACT>
|
||
<PUT ,P-OTBL ,P-VERBN ,P-VTBL>
|
||
<PUT ,P-OTBL ,P-PREP1 0>
|
||
<PUT ,P-OTBL ,P-PREP1N 0>
|
||
<PUT ,P-OTBL ,P-PREP2 0>
|
||
<PUT ,P-OTBL 5 0>
|
||
<PUT ,P-OTBL ,P-NC1 1>
|
||
<PUT ,P-OTBL ,P-NC1L 0>
|
||
<PUT ,P-OTBL ,P-NC2 0>
|
||
<PUT ,P-OTBL ,P-NC2L 0>
|
||
<SETG P-OFLAG T>>
|
||
|
||
<ROUTINE THING-PRINT (PRSO? "OPTIONAL" (THE? <>) "AUX" BEG END)
|
||
<COND (.PRSO?
|
||
<SET BEG <GET ,P-ITBL ,P-NC1>>
|
||
<SET END <GET ,P-ITBL ,P-NC1L>>)
|
||
(ELSE
|
||
<SET BEG <GET ,P-ITBL ,P-NC2>>
|
||
<SET END <GET ,P-ITBL ,P-NC2L>>)>
|
||
<BUFFER-PRINT .BEG .END .THE?>>
|
||
|
||
<ROUTINE BUFFER-PRINT (BEG END CP "AUX" (NOSP T) WRD (1ST? T) (PN <>) (Q? <>))
|
||
<REPEAT ()
|
||
<COND (<EQUAL? .BEG .END> <RETURN>)
|
||
(T
|
||
<SET WRD <GET .BEG 0>>
|
||
<COND (<EQUAL? .WRD ,W?COMMA>
|
||
<TELL ", ">)
|
||
(.NOSP <SET NOSP <>>)
|
||
(ELSE <TELL " ">)>
|
||
<COND (<EQUAL? .WRD ,W?PERIOD ,W?COMMA>
|
||
<SET NOSP T>)
|
||
(<EQUAL? .WRD ,W?ME>
|
||
<PRINTD ,ME>
|
||
<SET PN T>)
|
||
(<EQUAL? .WRD ,W?INTNUM>
|
||
<PRINTN ,P-NUMBER>
|
||
<SET PN T>)
|
||
(T
|
||
<COND (<AND .1ST? <NOT .PN> .CP>
|
||
<TELL "the ">)>
|
||
<COND (<OR ,P-OFLAG ,P-MERGED>
|
||
<PRINTB .WRD>)
|
||
(<AND <EQUAL? .WRD ,W?IT>
|
||
<ACCESSIBLE? ,P-IT-OBJECT>>
|
||
<PRINTD ,P-IT-OBJECT>)
|
||
(<AND <EQUAL? .WRD ,W?HIM>
|
||
<ACCESSIBLE? ,P-HIM-OBJECT>>
|
||
<PRINTD ,P-HIM-OBJECT>)
|
||
(T
|
||
<WORD-PRINT <GETB .BEG 2>
|
||
<GETB .BEG 3>>)>
|
||
<SET 1ST? <>>)>)>
|
||
<SET BEG <REST .BEG ,P-WORDLEN>>>>
|
||
|
||
;<ROUTINE PRINTW (WRD "AUX" TBL)
|
||
<COND (<SET TBL <ZMEMQ .WRD ,LONG-WORD-TABLE>>
|
||
<TELL <GET .TBL 1>>)
|
||
(ELSE <PRINTB .WRD>)>>
|
||
|
||
;<ROUTINE CAPITALIZE (PTR)
|
||
<COND (<OR ,P-OFLAG ,P-MERGED>
|
||
<PRINTW <GET .PTR 0>>)
|
||
(T
|
||
<PRINTC <- <GETB ,P-INBUF <GETB .PTR 3>> 32>>
|
||
<WORD-PRINT <- <GETB .PTR 2> 1> <+ <GETB .PTR 3> 1>>)>>
|
||
|
||
<ROUTINE PREP-PRINT (PREP "AUX" WRD)
|
||
<COND (<NOT <ZERO? .PREP>>
|
||
<TELL " ">
|
||
<COND (<EQUAL? .PREP ,PR?THROUGH>
|
||
<TELL "through">)
|
||
(T
|
||
<SET WRD <PREP-TO-WORD .PREP>>
|
||
<PRINTB .WRD>)>)>>
|
||
|
||
|
||
"CLAUSE-COPY"
|
||
|
||
<GLOBAL P-CCTBL <TABLE 0 0 0 0 0>>
|
||
|
||
;"pointers used by CLAUSE-COPY (source/destination beginning/end pointers)"
|
||
<CONSTANT CC-BEG 0> ;"slot in source to start from"
|
||
<CONSTANT CC-END 1> ;"slot in source to end at"
|
||
<CONSTANT CC-CLAUSE 2> ;"which orphan table to use"
|
||
<CONSTANT CC-IBEG 3> ;"insertion beginning (from lexv)"
|
||
<CONSTANT CC-IEND 4> ;"insertion ending"
|
||
|
||
"do something about duplicate words in clause?"
|
||
|
||
<ROUTINE CLAUSE-COPY (SRC DEST
|
||
"AUX" (IBEG <>) IEND OCL BEG END BB EE OBEG CNT B E)
|
||
<SET BB <GET ,P-CCTBL ,CC-BEG>>
|
||
<SET EE <GET ,P-CCTBL ,CC-END>>
|
||
<SET OCL <GET ,P-CCTBL ,CC-CLAUSE>>
|
||
<SET IBEG <GET ,P-CCTBL ,CC-IBEG>>
|
||
<SET IEND <GET ,P-CCTBL ,CC-IEND>>
|
||
<SET BEG <GET .SRC .BB>>
|
||
<SET END <GET .SRC .EE>>
|
||
<SET OBEG <GET .OCL ,P-MATCHLEN>>
|
||
<REPEAT ()
|
||
<COND (<EQUAL? .BEG .END>
|
||
<COND (<AND .IBEG <NOT ,P-ANAM>>
|
||
<CLAUSE-SUBSTRUC .IBEG .IEND>)>
|
||
<RETURN>)>
|
||
<COND (<AND .IBEG
|
||
<EQUAL? ,P-ANAM <GET .BEG 0>>>
|
||
<CLAUSE-SUBSTRUC .IBEG .IEND>)>
|
||
<CLAUSE-ADD <GET .BEG 0>>
|
||
<SET BEG <REST .BEG ,P-WORDLEN>>>
|
||
<COND (<AND <G? .OBEG 0>
|
||
<G? <SET CNT <- <GET .OCL ,P-MATCHLEN> .OBEG>> 0>>
|
||
<PUT .OCL ,P-MATCHLEN 0>
|
||
<SET OBEG <+ .OBEG 1>>
|
||
<REPEAT ()
|
||
<CLAUSE-ADD <GET .OCL .OBEG> T>
|
||
<COND (<ZERO? <SET CNT <- .CNT 2>>>
|
||
<RETURN>)>
|
||
<SET OBEG <+ .OBEG 2>>>
|
||
<SET OBEG 0>)>
|
||
<PUT .DEST
|
||
.BB
|
||
<REST .OCL <+ <* .OBEG ,P-LEXELEN> 2>>>
|
||
<PUT .DEST
|
||
.EE
|
||
<REST .OCL
|
||
<+ <* <GET .OCL ,P-MATCHLEN> ,P-LEXELEN> 2>>>>
|
||
|
||
<ROUTINE CLAUSE-SUBSTRUC (B E)
|
||
<REPEAT ()
|
||
<COND (<EQUAL? .B .E> <RETURN>)>
|
||
<CLAUSE-ADD <GET .B 0>>
|
||
<SET B <REST .B ,P-WORDLEN>>>>
|
||
|
||
<ROUTINE CLAUSE-ADD (WRD "OPT" (CHECK? <>) "AUX" OCL PTR)
|
||
<SET OCL <GET ,P-CCTBL ,CC-CLAUSE>>
|
||
<SET PTR <GET .OCL ,P-MATCHLEN>>
|
||
<COND (<AND .CHECK? <NOT <ZERO? .PTR>> <ZMEMQ .WRD .OCL>>
|
||
<RFALSE>)
|
||
(ELSE
|
||
<SET PTR <+ .PTR 2>>
|
||
<PUT .OCL <- .PTR 1> .WRD>
|
||
<PUT .OCL .PTR 0>
|
||
<PUT .OCL ,P-MATCHLEN .PTR>)>>
|
||
|
||
|
||
|
||
<ROUTINE PREP-TO-WORD (PREP "AUX" (CNT 2) SIZE)
|
||
<SET SIZE <GET ,PREPOSITIONS 0>>
|
||
<REPEAT ()
|
||
<COND (<DLESS? SIZE 0> <RFALSE>)
|
||
(<EQUAL? <GET ,PREPOSITIONS .CNT> .PREP>
|
||
<RETURN <GET ,PREPOSITIONS <- .CNT 1>>>)
|
||
(ELSE
|
||
<SET CNT <+ .CNT 2>>)>>>
|
||
|
||
<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)
|
||
<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 (<AND <NOT <ZERO? .PREP>>
|
||
<NOT ,P-END-ON-PREP>>
|
||
<PRINTB <SET PREP <PREP-TO-WORD .PREP>>>
|
||
<COND (<EQUAL? .PREP ,W?OUT>
|
||
<TELL " of">)>
|
||
<TELL " ">
|
||
<COND (<EQUAL? .OBJ ,HANDS>
|
||
<TELL D .OBJ>)
|
||
(ELSE
|
||
<TELL THE .OBJ>)>
|
||
<TELL ")" CR>)
|
||
(ELSE
|
||
<TELL D .OBJ ")" CR>)>
|
||
.OBJ)>)
|
||
(T <SETG P-GWIMBIT 0> <RFALSE>)>>
|
||
|
||
<ROUTINE SNARF-OBJECTS ("AUX" OPTR IPTR L)
|
||
<PUT ,P-BUTS ,P-MATCHLEN 0>
|
||
<COND (<NOT <EQUAL? <SET IPTR <GET ,P-ITBL ,P-NC2>> 0>>
|
||
<SETG P-SLOCBITS <GETB ,P-SYNTAX ,P-SLOC2>>
|
||
<OR <SNARFEM .IPTR <GET ,P-ITBL ,P-NC2L> ,P-PRSI> <RFALSE>>)>
|
||
<COND (<NOT <EQUAL? <SET OPTR <GET ,P-ITBL ,P-NC1>> 0>>
|
||
<SETG P-SLOCBITS <GETB ,P-SYNTAX ,P-SLOC1>>
|
||
<OR <SNARFEM .OPTR <GET ,P-ITBL ,P-NC1L> ,P-PRSO> <RFALSE>>)>
|
||
<COND (<NOT <ZERO? <GET ,P-BUTS ,P-MATCHLEN>>>
|
||
<SET L <GET ,P-PRSO ,P-MATCHLEN>>
|
||
<COND (.OPTR <SETG P-PRSO <BUT-MERGE ,P-PRSO>>)>
|
||
<COND (<AND .IPTR
|
||
<OR <NOT .OPTR>
|
||
<EQUAL? .L <GET ,P-PRSO ,P-MATCHLEN>>>>
|
||
<SETG P-PRSI <BUT-MERGE ,P-PRSI>>)>)>
|
||
<RTRUE>>
|
||
|
||
%<DEBUG-CODE
|
||
<ROUTINE TELL-LIST (TBL NUM "AUX" (CNT 1))
|
||
<COND (<ZERO? .NUM> <TELL "<>">)
|
||
(ELSE
|
||
<REPEAT ()
|
||
<PRINTD <GET .TBL .CNT>>
|
||
<SET CNT <+ .CNT 1>>
|
||
<COND (<G? .CNT .NUM> <RETURN>)>
|
||
<PRINTI ", ">>)>>>
|
||
|
||
|
||
<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>
|
||
|
||
"ADJ/NOUN COMBINATION"
|
||
|
||
<GLOBAL P-NAM <>>
|
||
<GLOBAL P-ADJT <ITABLE 5 0>>
|
||
<GLOBAL P-ADJNT <ITABLE 5 0>>
|
||
|
||
"AMBIGUOUS ADJ/NOUN COMBINATION"
|
||
|
||
<GLOBAL P-ANAM <>>
|
||
;<GLOBAL P-AADJNT <ITABLE 5 0>>
|
||
|
||
"PSEUDO-OBJECT ADJ-NOUN COMBINATION"
|
||
|
||
<GLOBAL P-PNAM <>>
|
||
;<GLOBAL P-PADJNT <ITABLE 5 0>>
|
||
|
||
<GLOBAL P-ADVERB <>>
|
||
|
||
<GLOBAL P-PRSO <ITABLE 80 <>>>
|
||
|
||
<GLOBAL P-PRSI <ITABLE 80 <>>>
|
||
|
||
<GLOBAL P-BUTS <ITABLE 80 <>>>
|
||
|
||
<GLOBAL P-MERGE <ITABLE 80 <>>>
|
||
|
||
<GLOBAL P-OCL1 <ITABLE NONE 40>>
|
||
<GLOBAL P-OCL2 <ITABLE NONE 40>>
|
||
|
||
<GLOBAL P-MATCHLEN 0>
|
||
|
||
<GLOBAL P-GETFLAGS 0>
|
||
|
||
<CONSTANT P-ALL 1>
|
||
|
||
<CONSTANT P-ONE 2>
|
||
|
||
<CONSTANT P-INHIBIT 4>
|
||
|
||
|
||
<ROUTINE SNARFEM (PTR EPTR TBL "AUX" (BUT <>) LEN WV WRD NW (WAS-ALL <>))
|
||
<SETG P-AND <>>
|
||
<COND (<EQUAL? ,P-GETFLAGS ,P-ALL>
|
||
<SET WAS-ALL T>)>
|
||
<SETG P-GETFLAGS 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
|
||
<COND (<==? .EPTR <REST .PTR ,P-WORDLEN>>
|
||
<SET NW 0>)
|
||
(T <SET NW <GET .PTR ,P-LEXELEN>>)>
|
||
<COND (<EQUAL? .WRD ,W?ALL ,W?BOTH>
|
||
<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>)
|
||
(<EQUAL? .WRD ,W?A ,W?ONE>
|
||
<COND (<ZERO? <GET ,P-ADJT 0>> ;<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>>>
|
||
<SETG P-AND T>
|
||
<OR <GET-OBJECT <OR .BUT .TBL>> <RFALSE>>
|
||
T)
|
||
(<NOT <ZERO? <WT? .WRD ,PS?BUZZ-WORD>>>)
|
||
(<EQUAL? .WRD ,W?AND ,W?COMMA>)
|
||
(<EQUAL? .WRD ,W?OF>
|
||
<COND (<ZERO? ,P-GETFLAGS>
|
||
<SETG P-GETFLAGS ,P-INHIBIT>)>)
|
||
(<NOT <ZERO?
|
||
<SET WV
|
||
<WT? .WRD
|
||
,PS?ADJECTIVE ,P1?ADJECTIVE>>>>
|
||
<NEW-ADJ .WV .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>)>>>
|
||
|
||
"add an adjective value and name to the adjective table"
|
||
|
||
<ROUTINE NEW-ADJ ("OPT" (WV <>) (WRD <>) "AUX" N)
|
||
<COND (<NOT .WV>
|
||
<SETG P-NAM <>>
|
||
<PUT ,P-ADJT 0 0>
|
||
<PUT ,P-ADJNT 0 0>)
|
||
(ELSE
|
||
<SET N <GET ,P-ADJT 0>>
|
||
<COND (<L? .N 4> <SET N <+ .N 1>>)>
|
||
<PUT ,P-ADJT 0 .N>
|
||
<PUT ,P-ADJT .N .WV>
|
||
<PUT ,P-ADJNT 0 .N>
|
||
<PUT ,P-ADJNT .N .WRD>)>>
|
||
|
||
<ROUTINE COPY-ADJ (SRC DST "AUX" N)
|
||
<SET N <GET .SRC 0>>
|
||
<REPEAT ()
|
||
<PUT .DST .N <GET .SRC .N>>
|
||
<COND (<L? <SET N <- .N 1>> 0>
|
||
<RTRUE>)>>>
|
||
|
||
"magic bits for syntaxes"
|
||
|
||
<CONSTANT SH 128> ;"HELD"
|
||
<CONSTANT SC 64> ;"CARRIED"
|
||
<CONSTANT SIR 32> ;"IN-ROOM"
|
||
<CONSTANT SOG 16> ;"ON-GROUND"
|
||
<CONSTANT STAKE 8> ;"TAKE"
|
||
<CONSTANT SMANY 4> ;"MANY"
|
||
<CONSTANT SHAVE 2> ;"HAVE"
|
||
|
||
<GLOBAL NOUN-MISSING "There seems to be a noun missing in that sentence.">
|
||
|
||
<ROUTINE SEARCH-CONTENTS? (OBJ)
|
||
<COND (<FSET? .OBJ ,INVISIBLE> <RFALSE>)
|
||
(<AND <FSET? .OBJ ,SEARCHBIT>
|
||
<OR <FSET? .OBJ ,OPENBIT>
|
||
<FSET? .OBJ ,TRANSBIT>>>
|
||
<RTRUE>)
|
||
(<FSET? .OBJ ,SURFACEBIT>
|
||
<RTRUE>)>>
|
||
|
||
<ROUTINE GET-OBJECT (TBL "OPTIONAL" (VRB T)
|
||
"AUX" GEN BITS LEN XBITS TLEN (GCHECK <>) (OLEN 0) OBJ)
|
||
<SET XBITS ,P-SLOCBITS>
|
||
<SET TLEN <GET .TBL ,P-MATCHLEN>>
|
||
<COND (<BTST ,P-GETFLAGS ,P-INHIBIT> <RTRUE>)>
|
||
<COND (<AND <NOT ,P-NAM>
|
||
<NOT <ZERO? <SET LEN <GET ,P-ADJNT 0>>>>>
|
||
<COND (<NOT <ZERO? <WT? <GET ,P-ADJNT .LEN>
|
||
,PS?OBJECT ,P1?OBJECT>>>
|
||
<SETG P-NAM <GET ,P-ADJNT <GET ,P-ADJNT 0>>>
|
||
<PUT ,P-ADJT 0 <- .LEN 1>>
|
||
<PUT ,P-ADJNT 0 <- .LEN 1>>)
|
||
(<AND <EQUAL? .LEN 1>
|
||
<SET BITS
|
||
<WT? <GET ,P-ADJNT 1>
|
||
,PS?DIRECTION
|
||
,P1?DIRECTION>>>
|
||
<PUT ,P-ADJT 0 0>
|
||
<PUT ,P-ADJNT 0 0>
|
||
<PUT .TBL ,P-MATCHLEN 1>
|
||
<PUT .TBL 1 ,INTDIR>
|
||
<SETG P-DIRECTION .BITS>
|
||
<RTRUE>)>)>
|
||
<COND (<AND <NOT ,P-NAM>
|
||
<ZERO? <GET ,P-ADJT 0>>
|
||
<NOT <EQUAL? ,P-GETFLAGS ,P-ALL>>
|
||
<ZERO? ,P-GWIMBIT>>
|
||
<COND (.VRB
|
||
<TELL ,NOUN-MISSING CR>)>
|
||
<RFALSE>)>
|
||
<COND (<OR <NOT <EQUAL? ,P-GETFLAGS ,P-ALL>> <ZERO? ,P-SLOCBITS>>
|
||
<SETG P-SLOCBITS -1>)>
|
||
<SETG P-TABLE .TBL>
|
||
<PROG ()
|
||
<COND (.GCHECK <GLOBAL-CHECK .TBL>)
|
||
(T
|
||
<COND (,LIT
|
||
<DO-SL ,HERE ,SOG ,SIR>
|
||
<COND (<AND <FSET? <LOC ,PLAYER> ,VEHBIT>
|
||
<NOT <SEARCH-CONTENTS?
|
||
<LOC ,PLAYER>>>>
|
||
<DO-SL <LOC ,PLAYER> ,SOG ,SIR>)>)>
|
||
<DO-SL ,PLAYER ,SH ,SC>)>
|
||
<SET LEN <- <GET .TBL ,P-MATCHLEN> .TLEN>>
|
||
<COND (<BTST ,P-GETFLAGS ,P-ALL> ;<AND * <NOT <EQUAL? .LEN 0>>>)
|
||
(<AND <BTST ,P-GETFLAGS ,P-ONE>
|
||
<NOT <ZERO? .LEN>>>
|
||
<COND (<NOT <EQUAL? .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 <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 <G? .LEN 1>
|
||
<SET GEN <GENERIC? .TBL .LEN>>>
|
||
<PUT .TBL
|
||
,P-MATCHLEN
|
||
<SET LEN <+ .TLEN 1>>>
|
||
<PUT .TBL .LEN .GEN>
|
||
<SETUP-XADJ>
|
||
<RTRUE>)
|
||
(<AND .VRB ;".VRB added 8/14/84 by JW"
|
||
<NOT <EQUAL? ,WINNER ,PLAYER>>>
|
||
<WHICH-PRINT .TLEN .LEN .TBL>)
|
||
(<AND .VRB
|
||
<OR ,P-NAM
|
||
<NOT <ZERO? <GET ,P-ADJT 0>>>>>
|
||
<WHICH-PRINT .TLEN .LEN .TBL>
|
||
<SETG P-ACLAUSE
|
||
<COND (<EQUAL? .TBL ,P-PRSO> ,P-NC1)
|
||
(T ,P-NC2)>>
|
||
;<COPY-ADJ ,P-ADJNT ,P-AADJNT>
|
||
;<SETG P-AADJ ,P-ADJ>
|
||
<SETG P-ANAM ,P-NAM>
|
||
<ORPHAN <> <>>
|
||
<SETG P-OFLAG T>)
|
||
(.VRB
|
||
<TELL ,NOUN-MISSING CR>)>
|
||
<NEW-ADJ>
|
||
<RFALSE>)>)>
|
||
<COND (<AND <ZERO? .LEN> .GCHECK>
|
||
<COND (.VRB
|
||
<SETG P-SLOCBITS .XBITS>
|
||
<COND (<OR ,LIT
|
||
<AND <EQUAL? .TBL ,P-PRSO>
|
||
<VERB? TELL WHERE WHAT WHO
|
||
FOLLOW WAIT-FOR>>
|
||
<AND <EQUAL? .TBL ,P-PRSI>
|
||
<VERB? ASK-ABOUT ASK-FOR
|
||
TELL-ABOUT>>>
|
||
;"Changed 6/10/83 - MARC"
|
||
<OBJ-FOUND ,NOT-HERE-OBJECT .TBL>
|
||
<SETUP-XADJ>
|
||
<RTRUE>)
|
||
(T
|
||
<TELL ,TOO-DARK>)>)>
|
||
<NEW-ADJ>
|
||
<RFALSE>)
|
||
(<ZERO? .LEN> <SET GCHECK T> <AGAIN>)>
|
||
<SETG P-SLOCBITS .XBITS>
|
||
<NEW-ADJ>
|
||
<RTRUE>>>
|
||
|
||
<ROUTINE SETUP-XADJ ()
|
||
<SETG P-XNAM ,P-NAM>
|
||
<COPY-ADJ ,P-ADJT ,P-XADJT>
|
||
<COPY-ADJ ,P-ADJNT ,P-XADJNT>
|
||
<NEW-ADJ>>
|
||
|
||
<ROUTINE MOBY-FIND (TBL "AUX" FOO LEN GEN)
|
||
<SETG P-MOBY-FLAG T>
|
||
<SETG P-SLOCBITS -1>
|
||
<SETG P-TABLE .TBL>
|
||
<SETG P-NAM ,P-XNAM>
|
||
<COPY-ADJ ,P-XADJT ,P-ADJT> ;<SETG P-ADJ ,P-XADJ>
|
||
<PUT .TBL ,P-MATCHLEN 0>
|
||
<SET FOO <FIRST? ,ROOMS>>
|
||
<REPEAT ()
|
||
<COND (<NOT .FOO> <RETURN>)
|
||
(T
|
||
<SEARCH-LIST .FOO .TBL ,P-SRCALL>
|
||
<SET FOO <NEXT? .FOO>>)>>
|
||
<DO-SL ,LOCAL-GLOBALS 1 1>
|
||
<SEARCH-LIST ,ROOMS .TBL ,P-SRCTOP>
|
||
<COND (<EQUAL? <SET LEN <GET .TBL ,P-MATCHLEN>> 1>
|
||
<SETG P-MOBY-FOUND <GET .TBL 1>>)
|
||
(<AND <G? .LEN 1>
|
||
<SET GEN <GENERIC? .TBL .LEN>>>
|
||
<SET LEN 1>
|
||
<SETG P-MOBY-FOUND .GEN>)>
|
||
<SETG P-MOBY-FLAG <>>
|
||
<NEW-ADJ>
|
||
.LEN>
|
||
|
||
<GLOBAL P-MOBY-FOUND <>>
|
||
<GLOBAL P-MOBY-FLAG <>>
|
||
|
||
<GLOBAL P-XNAM <>>
|
||
<GLOBAL P-XADJT <ITABLE 5 0>>
|
||
<GLOBAL P-XADJNT <ITABLE 5 0>>
|
||
|
||
<ROUTINE GENERIC? (TBL LEN "AUX" (GEN <>) G (N 0))
|
||
<COND (<G? .LEN 1>
|
||
<REPEAT ()
|
||
<COND (<G? <SET N <+ .N 1>> .LEN>
|
||
<RETURN <APPLY .GEN>>)
|
||
(ELSE
|
||
<SET G <GETP <GET .TBL .N> ,P?GENERIC>>
|
||
<COND (<NOT .GEN> <SET GEN .G>)
|
||
(<NOT <EQUAL? .GEN .G>>
|
||
<RFALSE>)>)>>)>>
|
||
|
||
<ROUTINE WHICH-PRINT (TLEN LEN TBL "AUX" OBJ RLEN)
|
||
<COND (<ZERO? .LEN>
|
||
<TELL ,REFERRING CR>
|
||
<RTRUE>)>
|
||
<SET RLEN .LEN>
|
||
<COND (<NOT <==? ,WINNER ,PLAYER>>
|
||
<TELL "\"I don't understand if you mean ">)
|
||
(T
|
||
<TELL "Which ">
|
||
<COND (<OR ,P-OFLAG ,P-MERGED ,P-AND>
|
||
<COND (<PRINT-ADJT ,P-ADJNT>
|
||
<COND (,P-NAM <TELL " "> <PRINTB ,P-NAM>)>)
|
||
(,P-NAM <PRINTB ,P-NAM>)
|
||
(ELSE <PRINTB ,W?ONE>)>)
|
||
(ELSE
|
||
<THING-PRINT <EQUAL? .TBL ,P-PRSO>>)>
|
||
<TELL " do you mean, ">)>
|
||
<REPEAT ()
|
||
<SET TLEN <+ .TLEN 1>>
|
||
<SET OBJ <GET .TBL .TLEN>>
|
||
<COND (<EQUAL? .OBJ ,FLOOR-BUTTON>
|
||
<TELL "the 1 button, the 2 button, the 3 button">)
|
||
(ELSE
|
||
<TELL THE .OBJ>)>
|
||
<COND (<EQUAL? .LEN 2>
|
||
<COND (<NOT <EQUAL? .RLEN 2>>
|
||
<TELL ",">)>
|
||
<TELL " or ">)
|
||
(<G? .LEN 2>
|
||
<TELL ", ">)>
|
||
<COND (<L? <SET LEN <- .LEN 1>> 1>
|
||
<RETURN>)>>
|
||
<COND (<NOT <==? ,WINNER ,PLAYER>>
|
||
<TELL ".\"" CR>)
|
||
(T
|
||
<TELL "?" CR>)>>
|
||
|
||
<ROUTINE PRINT-ADJT (TBL "AUX" N (CNT 0))
|
||
<COND (<NOT <ZERO? <SET N <GET .TBL 0>>>>
|
||
<REPEAT ()
|
||
<PRINTB <GET .TBL .N>>
|
||
<COND (<ZERO? <SET N <- .N 1>>>
|
||
<RTRUE>)>
|
||
<TELL " ">>)>>
|
||
|
||
|
||
|
||
<ROUTINE GLOBAL-CHECK (TBL "AUX" LEN RMG RMGL (CNT 0) OBJ OBITS FOO NOBJ)
|
||
<SET LEN <GET .TBL ,P-MATCHLEN>>
|
||
<SET OBITS ,P-SLOCBITS>
|
||
<COND (<SET RMG <GETPT ,HERE ,P?GLOBAL>>
|
||
<SET RMGL <- <PTSIZE .RMG> 1>>
|
||
<REPEAT ()
|
||
<COND (<SET OBJ <GETB .RMG .CNT>>
|
||
<COND (<THIS-IT? .OBJ .TBL>
|
||
<OBJ-FOUND .OBJ .TBL>)>
|
||
<COND (<AND <SEARCH-CONTENTS? .OBJ>
|
||
<SET NOBJ <FIRST? .OBJ>>>
|
||
<SEARCH-LIST .OBJ .TBL ,P-SRCALL>)>)>
|
||
<COND (<IGRTR? CNT .RMGL> <RETURN>)>>)>
|
||
<COND (<SET RMG <GETP ,HERE ,P?THINGS>>
|
||
<SET RMGL <GET .RMG 0>>
|
||
<SET CNT 0>
|
||
<REPEAT ()
|
||
<COND (<AND <EQUAL? ,P-NAM <GET .RMG <+ .CNT 2>>>
|
||
<OR <ZERO? <GET ,P-ADJT 0>>
|
||
<ZMEMQ <GET .RMG <+ .CNT 1>>
|
||
,P-ADJNT>
|
||
;<EQUAL? ,P-ADJN
|
||
<GET .RMG <+ .CNT 2>>>>>
|
||
<SETG P-PNAM ,P-NAM>
|
||
;<COND (<NOT <ZERO? <GET ,P-ADJT 0>>>
|
||
<COPY-ADJ ,P-ADJNT ,P-PADJNT>
|
||
;<SETG P-PADJNT ,P-ADJNT>)
|
||
(ELSE
|
||
<PUT ,P-PADJNT 0 0>
|
||
;<SETG P-PADJN <>>)>
|
||
<SETG LAST-PSEUDO-LOC ,HERE>
|
||
<PUTP ,PSEUDO-OBJECT
|
||
,P?ACTION
|
||
,RANDOM-PSEUDO ;<GET .RMG <+ .CNT 2>>>
|
||
<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>)>
|
||
<SET CNT <+ .CNT 2>>
|
||
<COND (<NOT <L? .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 (<AND <ZERO? <GET .TBL ,P-MATCHLEN>>
|
||
<EQUAL? ,PRSA ,V?LOOK-INSIDE ,V?SEARCH ,V?EXAMINE>>
|
||
<DO-SL ,ROOMS 1 1>)>)>>
|
||
|
||
<GLOBAL P-TABLE <>> ;"DO-SL outputs stuff to this table"
|
||
|
||
<CONSTANT P-SRCBOT 2>
|
||
<CONSTANT P-SRCALL 1>
|
||
<CONSTANT P-SRCTOP 0>
|
||
|
||
<ROUTINE DO-SL (OBJ BIT1 BIT2 "AUX" BTS)
|
||
<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>)>)>>
|
||
|
||
<ROUTINE SEARCH-LIST (OBJ TBL LVL "AUX" ROBJ)
|
||
<COND (<SET OBJ <FIRST? .OBJ>>
|
||
<REPEAT ()
|
||
<COND (<AND <NOT <EQUAL? .LVL ,P-SRCBOT>>
|
||
<GETPT .OBJ ,P?SYNONYM>
|
||
<THIS-IT? .OBJ .TBL>>
|
||
<OBJ-FOUND .OBJ .TBL>)>
|
||
<COND (<EQUAL? .OBJ ,ELEVATOR-DOOR>
|
||
<SET ROBJ <DOOR-AT-ELEVATOR>>)
|
||
(ELSE
|
||
<SET ROBJ .OBJ>)>
|
||
<COND (<AND <FIRST? .ROBJ>
|
||
<SEARCH-CONTENTS? .ROBJ>
|
||
<OR <NOT <EQUAL? .LVL ,P-SRCTOP>>
|
||
,P-MOBY-FLAG>>
|
||
<SEARCH-LIST
|
||
.ROBJ
|
||
.TBL
|
||
<COND (<OR ,P-MOBY-FLAG
|
||
<FSET? .ROBJ ,SURFACEBIT>
|
||
<FSET? .ROBJ ,SEARCHBIT>>
|
||
,P-SRCALL)
|
||
(T ,P-SRCTOP)>>)>
|
||
<COND (<NOT <SET OBJ <NEXT? .OBJ>>>
|
||
<RETURN>)>>)>>
|
||
|
||
<GLOBAL P-NAMW <TABLE 0 0>> ;"table of actual noun used by player"
|
||
<GLOBAL P-ADJW <TABLE 0 0>> ;"table of actual adj used by player"
|
||
|
||
<ROUTINE OBJ-FOUND (OBJ TBL "AUX" PTR)
|
||
<COND (<EQUAL? .TBL ,P-PRSO>
|
||
<PUT ,P-NAMW 0 ,P-NAM>
|
||
<PUT ,P-ADJW 0 <GET ,P-ADJNT 1>>)
|
||
(<EQUAL? .TBL ,P-PRSI>
|
||
<PUT ,P-NAMW 1 ,P-NAM>
|
||
<PUT ,P-ADJW 1 <GET ,P-ADJNT 1>>)>
|
||
<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 IBITS "AUX" PTR OBJ TAKEN)
|
||
<COND (<AND <SET PTR <GET .TBL ,P-MATCHLEN>>
|
||
<OR <BTST .IBITS ,SHAVE>
|
||
<BTST .IBITS ,STAKE>>>
|
||
<REPEAT ()
|
||
<COND (<L? <SET PTR <- .PTR 1>> 0>
|
||
<RETURN>)
|
||
(T
|
||
<SET OBJ <GET .TBL <+ .PTR 1>>>
|
||
<COND (<EQUAL? .OBJ ,IT>
|
||
<COND (<NOT ,P-IT-OBJECT>
|
||
<TELL ,REFERRING CR>)
|
||
(<NOT <ACCESSIBLE? ,P-IT-OBJECT>>
|
||
<TELL
|
||
"I don't see " THE ,P-IT-OBJECT " here." CR>
|
||
<RFALSE>)
|
||
(T
|
||
<SET OBJ ,P-IT-OBJECT>)>)
|
||
(<EQUAL? .OBJ ,HIM>
|
||
<COND (<NOT ,P-HIM-OBJECT>
|
||
<TELL ,REFERRING CR>)
|
||
(<NOT <ACCESSIBLE? ,P-HIM-OBJECT>>
|
||
<TELL
|
||
"I don't see " THE ,P-HIM-OBJECT " here." CR>
|
||
<RFALSE>)
|
||
(T
|
||
<SET OBJ ,P-HIM-OBJECT>)>)>
|
||
<COND (<OR <HELD? .OBJ ,WINNER>
|
||
<INTRINSIC? .OBJ>
|
||
<IN? ,WINNER .OBJ>>
|
||
T)
|
||
(T
|
||
<SETG PRSO .OBJ>
|
||
<SET TAKEN T>
|
||
<COND (<FSET? .OBJ ,TRYTAKEBIT>
|
||
<SET TAKEN <>>)
|
||
(<NOT <EQUAL? ,WINNER ,PLAYER>>)
|
||
(<AND <BTST .IBITS ,STAKE>
|
||
<EQUAL? <ITAKE <>> T>>)
|
||
(T
|
||
<SET TAKEN <>>)>
|
||
<COND (<AND <NOT .TAKEN> <BTST .IBITS ,SHAVE>>
|
||
<COND (<L? 1 <GET .TBL ,P-MATCHLEN>>
|
||
<TELL
|
||
,YOU-ARENT "holding all those things!" CR>
|
||
<RFALSE>)
|
||
(<EQUAL? .OBJ ,NOT-HERE-OBJECT>
|
||
<TELL ,YOU-CANT-SEE "that here!" CR>
|
||
<RFALSE>)
|
||
(<EQUAL? ,WINNER ,PLAYER>
|
||
<TELL ,YOU-ARENT>)
|
||
(T
|
||
<TELL S "It doesn't look like ">
|
||
<TELL THE ,WINNER " is ">)>
|
||
<TELL "holding ">
|
||
<COND (<EQUAL? .OBJ ,PSEUDO-OBJECT>
|
||
<TELL "that">)
|
||
(ELSE
|
||
<TELL THE .OBJ>)>
|
||
<THIS-IS-IT .OBJ>
|
||
<TELL ,PERIOD>
|
||
<RFALSE>)
|
||
(<AND .TAKEN
|
||
<EQUAL? ,WINNER ,PLAYER>
|
||
<NOT <PRSO? ,INTNUM>>>
|
||
<TAKING-FIRST .OBJ>)>)>)>>)
|
||
(T)>>
|
||
|
||
<ROUTINE TAKING-FIRST (OBJ)
|
||
<TELL
|
||
"(Taking " THE .OBJ " first)" CR>>
|
||
|
||
<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 ,YOU-CANT "use multiple ">
|
||
<COND (<EQUAL? .LOSS 2>
|
||
<TELL "in">)>
|
||
<TELL "direct objects 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)>>
|
||
|
||
<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>>
|
||
<RETURN <REST .TBL <* .CNT 2>>>)
|
||
(<IGRTR? CNT .SIZE> <RFALSE>)>>>
|
||
|
||
<ROUTINE ZMEMQB (ITM TBL SIZE "AUX" (CNT 0))
|
||
<REPEAT ()
|
||
<COND (<EQUAL? .ITM <GETB .TBL .CNT>>
|
||
<RTRUE>)
|
||
(<IGRTR? CNT .SIZE>
|
||
<RFALSE>)>>>
|
||
|
||
<ROUTINE LIT? (RM "OPTIONAL" (RMBIT T) "AUX" OHERE (LIT <>))
|
||
<SETG P-GWIMBIT ,ONBIT>
|
||
<SET OHERE ,HERE>
|
||
<SETG HERE .RM>
|
||
<COND (<AND .RMBIT
|
||
<FSET? .RM ,ONBIT>>
|
||
<SET LIT ,HERE>)
|
||
(<AND <HERE? ,ELEVATOR-PIT>
|
||
<OR <FSET? ,ELEVATOR-DOOR-B ,OPENBIT>
|
||
<FSET? ,ELEVATOR-DOOR-1 ,OPENBIT>>>
|
||
<SET LIT ,CS-BASEMENT>)
|
||
(<AND <HERE? ,UNDER-ALCHEMY-LAB>
|
||
<FSET? ,ALCHEMY-TRAP-DOOR ,OPENBIT>
|
||
<FSET? ,ALCHEMY-LAB ,ONBIT>>
|
||
<SET LIT ,ALCHEMY-LAB>)
|
||
(<AND <FSET? ,WINNER ,ONBIT>
|
||
<HELD? ,WINNER .RM>>
|
||
<SET LIT ,WINNER>)
|
||
(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 ,PLAYER>>
|
||
<IN? ,PLAYER .RM>>
|
||
<DO-SL ,PLAYER 1 1>)>)>
|
||
<COND (<AND <FSET? <LOC ,WINNER> ,VEHBIT>
|
||
<NOT <FSET? <LOC ,WINNER> ,OPENBIT>>>
|
||
<DO-SL <LOC ,WINNER> 1 1>)>
|
||
<DO-SL .RM 1 1>
|
||
<COND (<G? <GET ,P-TABLE ,P-MATCHLEN> 0>
|
||
<SET LIT <GET ,P-TABLE 1>>)>)>
|
||
<SETG HERE .OHERE>
|
||
<SETG P-GWIMBIT 0>
|
||
.LIT>
|
||
|
||
;"former CRUFTY.ZIL routine"
|
||
|
||
<ROUTINE THIS-IT? (OBJ TBL "AUX" SYNS ACNT)
|
||
<COND (<FSET? .OBJ ,INVISIBLE> <RFALSE>)
|
||
(<AND ,P-NAM
|
||
<NOT <ZMEMQ ,P-NAM
|
||
<SET SYNS <GETPT .OBJ ,P?SYNONYM>>
|
||
<- </ <PTSIZE .SYNS> 2> 1>>>>
|
||
<RFALSE>)
|
||
(<AND <NOT <ZERO? <SET ACNT <GET ,P-ADJT 0>>>>
|
||
<NOT <SET SYNS <GETPT .OBJ ,P?ADJECTIVE>>>>
|
||
<RFALSE>)
|
||
(ELSE
|
||
<COND (<NOT <ZERO? .ACNT>>
|
||
<REPEAT ()
|
||
<COND (<NOT <ZMEMQB <GET ,P-ADJT .ACNT>
|
||
.SYNS
|
||
<- <PTSIZE .SYNS> 1>>>
|
||
<RFALSE>)>
|
||
<COND (<ZERO? <SET ACNT <- .ACNT 1>>>
|
||
<RETURN>)>>)>
|
||
<COND (<AND <NOT <ZERO? ,P-GWIMBIT>>
|
||
<NOT <FSET? .OBJ ,P-GWIMBIT>>>
|
||
<RFALSE>)>)>
|
||
<RTRUE>>
|
||
|
||
<ROUTINE END-QUOTE ()
|
||
<SETG QUOTE-FLAG <>>
|
||
<SETG P-CONT <>>
|
||
<RFATAL>>
|