historicalsource/beyondzork
1
0
Fork 0
mirror of https://github.com/historicalsource/beyondzork synced 2024-04-24 21:29:44 +03:00
Code Issues Releases Wiki Activity
beyondzork/parser.zil
historicalsource 78ec79974c Final Revision
2019-04-14 00:49:43 -04:00

3398 lines
93 KiB
Plaintext
Raw Permalink Blame History

"PARSER for BEYOND ZORK:
Copyright (C)1987 Infocom, Inc. All rights reserved."
<SETG SIBREAKS ".,\"!?">
<GLOBAL NOW-PRSI?:FLAG <>>
<GLOBAL LIT?:FLAG T>
<GLOBAL ALWAYS-LIT?:FLAG <>>
<GLOBAL PRSA:VERB 0>
<GLOBAL PRSI:OBJECT 0>
<GLOBAL PRSO:OBJECT 0>
<GLOBAL P-TABLE:NUMBER 0>
<GLOBAL P-SYNTAX:NUMBER 0>
<GLOBAL P-LEN:NUMBER 0>
<GLOBAL P-DIR:NUMBER 0>
<GLOBAL HERE:OBJECT 0>
; <GLOBAL LAST-PLAYER-LOC 0>
<CONSTANT LEXMAX 59>
<CONSTANT P-LEXV-LENGTH %<+ <* ,LEXMAX 4> 2>>
<GLOBAL P-LEXV:TABLE <ITABLE ,P-LEXV-LENGTH (BYTE) 0>>
<GLOBAL AGAIN-LEXV:TABLE <ITABLE ,P-LEXV-LENGTH (BYTE) 0>>
<GLOBAL RESERVE-LEXV:TABLE <ITABLE ,P-LEXV-LENGTH (BYTE) 0>>
<GLOBAL RESERVE-PTR:FLAG <>>
<CONSTANT P-INBUF-LENGTH 82>
<GLOBAL P-INBUF:TABLE <ITABLE ,P-INBUF-LENGTH (BYTE) 0>>
<GLOBAL RESERVE-INBUF:TABLE <ITABLE ,P-INBUF-LENGTH (BYTE) 0>> "FIX #36"
<GLOBAL OOPS-INBUF:TABLE <ITABLE ,P-INBUF-LENGTH (BYTE) 0>>
<GLOBAL P-NUMBER:NUMBER -1>
<GLOBAL P-EXCHANGE:NUMBER 0>
<GLOBAL P-DIRECTION 0>
<GLOBAL P-LASTADJ:WORD <>>
<GLOBAL P-GWIMBIT 0>
<GLOBAL P-NAM <>>
<GLOBAL P-XNAM <>>
<GLOBAL P-NAMW:TABLE <TABLE 0 0>>
<GLOBAL P-ADJ <>>
<GLOBAL P-XADJ <>>
<GLOBAL P-ADJW:TABLE <TABLE 0 0>>
<GLOBAL P-PHR 0> "Which noun phrase is being parsed?"
<GLOBAL P-OFW:TABLE <TABLE 0 0>>
<GLOBAL P-PRSO:TABLE <ITABLE NONE 48>>
<GLOBAL P-PRSI:TABLE <ITABLE NONE 48>>
<GLOBAL P-BUTS:TABLE <ITABLE NONE 48>>
<GLOBAL P-MERGE:TABLE <ITABLE NONE 48>>
<GLOBAL P-OCL1 <ITABLE NONE 48>>
<GLOBAL P-OCL2 <ITABLE NONE 48>>
<GLOBAL P-GETFLAGS 0>
<GLOBAL P-AND <>>
<CONSTANT P-MATCHLEN 0>
<CONSTANT P-ALL 1>
<CONSTANT P-ONE 2>
<CONSTANT P-INHIBIT 4>
<GLOBAL P-CONT:FLAG <>> "Parse-continue flag."
<GLOBAL P-IT-OBJECT:OBJECT <>>
<GLOBAL P-HER-OBJECT:OBJECT <>>
<GLOBAL P-HIM-OBJECT:OBJECT <>>
<GLOBAL P-THEM-OBJECT:OBJECT <>>
<GLOBAL QCONTEXT:OBJECT <>>
<GLOBAL QCONTEXT-ROOM:OBJECT <>>
"Orphan flag"
<GLOBAL P-OFLAG:FLAG <>>
<GLOBAL P-MERGED <>>
<GLOBAL P-ACLAUSE <>>
<GLOBAL P-ANAM <>>
; <GLOBAL P-AADJ <>>
"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 6>
"Offset to first part of speech"
<CONSTANT P-P1OFF 7>
"First part of speech bit mask in PSOFF byte"
<CONSTANT P-P1BITS 3>
<CONSTANT P-ITBLLEN 20> "In bytes (for COPYT)."
<GLOBAL P-ITBL:TABLE <TABLE 0 0 0 0 0 0 0 0 0 0>>
<GLOBAL P-OTBL:TABLE <TABLE 0 0 0 0 0 0 0 0 0 0>>
<GLOBAL P-VTBL:TABLE <TABLE 0 0 0 0>>
<GLOBAL P-OVTBL:TABLE <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:FLAG <>>
<GLOBAL P-WON:FLAG <>>
<CONSTANT M-FATAL 2>
<CONSTANT M-BEG 1>
<CONSTANT M-ENTERING 2>
<CONSTANT M-LOOK 3>
<CONSTANT M-ENTERED 4>
<CONSTANT M-OBJDESC 5>
<CONSTANT M-END 6>
<CONSTANT M-CONT 7>
<CONSTANT M-WINNER 8>
<CONSTANT M-EXIT 9>
<GLOBAL P-WALK-DIR:DIRECTION <>>
<GLOBAL P-END-ON-PREP <>>
<GLOBAL OOPS-TABLE:TABLE <TABLE <> <> <> <>>>
<GLOBAL AGAIN-DIR:DIRECTION <>> ; "FIX #44"
<CONSTANT O-PTR 0>
<CONSTANT O-START 1>
<CONSTANT O-LENGTH 2>
<CONSTANT O-END 3>
<GLOBAL P-PRSA-WORD:WORD <>>
<GLOBAL P-DIR-WORD:WORD <>>
<GLOBAL P-SLOCBITS 0>
" 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) (VAL 0) (VERB <>) (OF-FLAG <>)
(LEN 0) (DIR <>) (NW 0) (LW 0) OWINNER OMERGED WRD X)
<REPEAT ()
<COND (<ZERO? ,P-OFLAG>
<COPYT ,P-ITBL ,P-OTBL ,P-ITBLLEN>)>
<COPYT ,P-ITBL 0 ,P-ITBLLEN>
<SETG P-NAM <>>
<SETG P-ADJ <>>
<SETG P-XNAM <>>
<SETG P-XADJ <>>
<SETG P-DIR-WORD <>>
<SETG P-PNAM <>>
<SETG P-PADJN <>>
<COND (<ZERO? ,P-OFLAG>
<SETG P-ACT <>>
<SETG P-QWORD <>>
<SETG P-LASTADJ <>>
<PUT ,P-NAMW 0 <>>
<PUT ,P-NAMW 1 <>>
<PUT ,P-ADJW 0 <>>
<PUT ,P-ADJW 1 <>>
<PUT ,P-OFW 0 <>>
<PUT ,P-OFW 1 <>>)>
<SET OMERGED ,P-MERGED>
<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>
<SET OWINNER ,WINNER>
<COND (<AND <ZERO? ,QUOTE-FLAG>
<NOT <EQUAL? ,WINNER ,PLAYER>>>
<SETG WINNER ,PLAYER>
<COND (<NOT <IS? <LOC ,WINNER> ,VEHICLE>>
<SETG HERE <LOC ,WINNER>>)>
<SETG LIT? <IS-LIT?>>)>
<COND (<T? ,RESERVE-PTR>
<SET PTR ,RESERVE-PTR>
<COPYT ,RESERVE-LEXV ,P-LEXV ,P-LEXV-LENGTH>
<COPYT ,RESERVE-INBUF ,P-INBUF ,P-INBUF-LENGTH> ; "FIX #36"
<COND (<AND <T? ,VERBOSITY>
<EQUAL? ,PLAYER ,WINNER>>
<CRLF>)>
<SETG RESERVE-PTR <>>
<SETG P-CONT <>>)
(<T? ,P-CONT>
<SET PTR ,P-CONT>
<SETG P-CONT <>>
<COND (<AND <T? ,VERBOSITY>
<EQUAL? ,PLAYER ,WINNER>>
<CRLF>)>)
(T
<SETG WINNER ,PLAYER>
<SETG QUOTE-FLAG <>>
<COND (<NOT <IS? <LOC ,WINNER> ,VEHICLE>>
<SETG HERE <LOC ,WINNER>>)>
<SETG LIT? <IS-LIT?>>
<COND (<BTST <LOWCORE FLAGS> 4>
<V-REFRESH>)>
<COND (<HERE? OLD-HERE>)
(<OR <ZERO? ,DMODE>
<EQUAL? ,IN-DBOX ,SHOWING-STATS>
<EQUAL? ,PRIOR ,SHOWING-INV ,SHOWING-STATS>>
<V-LOOK>)
(T
<DISPLAY-PLACE>)>
<COND (<ZERO? ,DMODE>)
(<ZERO? ,AUTO>)
(<ZERO? ,NEW-DBOX>)
(<AND <EQUAL? ,IN-DBOX ,SHOWING-ROOM>
<EQUAL? ,PRIOR 0 ,SHOWING-ROOM>>
<COND (<BTST ,NEW-DBOX ,SHOWING-ROOM>
<SET X ,P-IT-OBJECT>
<UPDATE-ROOMDESC>
<THIS-IS-IT .X>)>)
(<AND <EQUAL? ,IN-DBOX ,SHOWING-INV>
<EQUAL? ,PRIOR 0 ,SHOWING-INV>>
<COND (<BTST ,NEW-DBOX ,SHOWING-INV>
<SET X ,P-IT-OBJECT>
<UPDATE-INVENTORY>
<THIS-IS-IT .X>)>)
(<AND <EQUAL? ,IN-DBOX ,SHOWING-STATS>
<EQUAL? ,PRIOR 0 ,SHOWING-STATS>>
<COND (<BTST ,NEW-DBOX ,SHOWING-STATS>
<SET X ,ENDURANCE>
<TO-TOP-WINDOW>
<REPEAT ()
<APPLY ,STAT-ROUTINE .X <GET ,STATS .X>>
<COND (<IGRTR? X ,LUCK>
<RETURN>)>>
<TO-BOTTOM-WINDOW>)>)>
<COND (<T? ,VERBOSITY>
<CRLF>)>
<TELL ">">
<READ-LEXV>)>
<SETG P-LEN <GETB ,P-LEXV ,P-LEXWORDS>>
<COND (<EQUAL? <GET ,P-LEXV .PTR> ,W?QUOTE> ; "Quote first token?"
<SET PTR <+ .PTR ,P-LEXELEN>> ; "If so, ignore it."
<SETG P-LEN <- ,P-LEN 1>>)>
<COND (<EQUAL? <GET ,P-LEXV .PTR> ,W?THEN ,W?PLEASE ,W?SO>
<SET PTR <+ .PTR ,P-LEXELEN>> ; "Ignore boring 1st words."
<SETG P-LEN <- ,P-LEN 1>>)>
<COND (<AND <L? 1 ,P-LEN>
<EQUAL? <GET ,P-LEXV .PTR> ,W?GO> ; "GO first 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 "[What?]" CR>
<RFALSE>)>
<SET WRD <GET ,P-LEXV .PTR>>
<COND (<EQUAL? .WRD ,W?UNDO>
<V-UNDO>
<RFALSE>)>
<SETG CAN-UNDO <ISAVE>>
<COND (<NOT <EQUAL? ,CAN-UNDO 2>>
<RETURN>)>
<V-REFRESH>
<COMPLETED "UNDO">
<COND (<OR <ZERO? ,DMODE>
<NOT <EQUAL? ,PRIOR 0 ,SHOWING-ROOM>>>
<CRLF>)>>
<COND (<EQUAL? .WRD ,W?OOPS>
<COND (<EQUAL? <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>
,W?PERIOD ,W?COMMA>
<SET PTR <+ .PTR ,P-LEXELEN>>
<SETG P-LEN <- ,P-LEN 1>>)> ; "FIX #38"
<COND (<NOT <G? ,P-LEN 1>>
<PRINTC %<ASCII !\[>>
<TELL ,CANT "use OOPS that way.]" CR>
<RFALSE>)
(<GET ,OOPS-TABLE ,O-PTR>
<COND (<G? ,P-LEN 2> ; "FIX #39"
<COND (<EQUAL? <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>
,W?QUOTE>
<TELL
"[Sorry. " ,CANT "correct mistakes in quoted text.]" CR>
<RFALSE>)>
<TELL
"[NOTE: Only the first word after OOPS is used.]" CR ,TAB>)>
<PUT ,AGAIN-LEXV <GET ,OOPS-TABLE ,O-PTR>
<GET ,P-LEXV <+ .PTR ,P-LEXELEN>>>
<SETG WINNER .OWINNER> ;"Fixes OOPS w/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>>
<COPYT ,AGAIN-LEXV ,P-LEXV ,P-LEXV-LENGTH>
<SETG P-LEN <GETB ,P-LEXV ,P-LEXWORDS>>
<SET PTR <GET ,OOPS-TABLE ,O-START>>
<COPYT ,OOPS-INBUF ,P-INBUF ,P-INBUF-LENGTH>)
(T
<PUT ,OOPS-TABLE ,O-END <>>
<TELL
"[There was no word to replace in that sentence.]" CR>
<RFALSE>)>)
(T
<COND (<NOT <EQUAL? .WRD ,W?AGAIN ,W?G>>
<SETG P-QWORD <>>
<SETG P-NUMBER -1>)>
<PUT ,OOPS-TABLE ,O-END <>>)>
<COND (<EQUAL? <GET ,P-LEXV .PTR> ,W?AGAIN ,W?G>
<COND (<OR <T? ,P-OFLAG>
<ZERO? ,P-WON>
<ZERO? <GETB ,OOPS-INBUF 1>>> ; "FIX #50"
<PRINTC %<ASCII !\[>>
<TELL ,CANT "use AGAIN that way.]" 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
<DONT-UNDERSTAND>
<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>
<COPYT ,P-LEXV ,RESERVE-LEXV ,P-LEXV-LENGTH>
; <STUFF ,RESERVE-LEXV ,P-LEXV>
<COPYT ,P-INBUF ,RESERVE-INBUF ,P-INBUF-LENGTH>
; <INBUF-STUFF ,RESERVE-INBUF ,P-INBUF> ; "FIX #36"
<SETG RESERVE-PTR .PTR>)
(T
<SETG RESERVE-PTR <>>)>
; <SETG P-LEN <GETB ,AGAIN-LEXV ,P-LEXWORDS>>
<SETG WINNER .OWINNER>
<SETG P-MERGED .OMERGED>
<COPYT ,OOPS-INBUF ,P-INBUF ,P-INBUF-LENGTH>
; <INBUF-STUFF ,P-INBUF ,OOPS-INBUF>
<COPYT ,AGAIN-LEXV ,P-LEXV ,P-LEXV-LENGTH>
; <STUFF ,P-LEXV ,AGAIN-LEXV>
<SET DIR ,AGAIN-DIR> ; "FIX #44"
<COPYT ,P-OTBL ,P-ITBL ,P-ITBLLEN>
; <SET CNT -1>
; <REPEAT ()
<COND (<IGRTR? CNT ,P-ITBLLEN>
<RETURN>)
(T
<PUT ,P-ITBL .CNT <GET ,P-OTBL .CNT>>)>>)
(T
<SETG P-NUMBER -1> ; "Fixed BM 2/28/86"
<COPYT ,P-LEXV ,AGAIN-LEXV ,P-LEXV-LENGTH>
; <STUFF ,AGAIN-LEXV ,P-LEXV>
<COPYT ,P-INBUF ,OOPS-INBUF ,P-INBUF-LENGTH>
; <INBUF-STUFF ,OOPS-INBUF ,P-INBUF>
<PUT ,OOPS-TABLE ,O-START .PTR>
<PUT ,OOPS-TABLE ,O-LENGTH <* 4 ,P-LEN>> ; "FIX #37"
<SET LEN ; "FIX #43"
<* 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>
<PUT ,P-ITBL ,P-VERBN 0>
<REPEAT ()
<COND (<DLESS? P-LEN 0>
<SETG QUOTE-FLAG <>>
<RETURN>)>
<SET WRD <GET ,P-LEXV .PTR>>
<COND (<BUZZER-WORD? .WRD>
<RFALSE>)
(<OR <T? .WRD>
<SET WRD <QUOTED-WORD? .PTR .VERB>>
<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?TO>
<EQUAL? .VERB ,ACT?TELL ,ACT?ASK>>
<PUT ,P-ITBL ,P-VERB ,ACT?TELL>
; <SET VERB ,ACT?TELL>
<SET WRD ,W?QUOTE>)
(<AND <EQUAL? .WRD ,W?THEN ; ,W?PERIOD>
; <NOT <EQUAL? .NW ,W?THEN ,W?PERIOD>>
<G? ,P-LEN 0> ; "FIX #40"
<ZERO? .VERB>
<ZERO? ,QUOTE-FLAG>>
<PUT ,P-ITBL ,P-VERB ,ACT?TELL>
<PUT ,P-ITBL ,P-VERBN 0>
<SET WRD ,W?QUOTE>)
(<AND <EQUAL? .WRD ,W?PERIOD>
<EQUAL? .LW ,W?MR ,W?MRS ; ,W?DR>>
<SETG P-NCN <- ,P-NCN 1>>
<CHANGE-LEXV .PTR .LW T>
<SET WRD .LW>
<SET LW 0>)> ; "FIX #40"
<COND ; (<AND <EQUAL? .WRD ,W?PERIOD>
<EQUAL? .LW ,W?MR ,W?MRS ; ,W?DR>>
<SET LW 0>)
(<EQUAL? .WRD ,W?THEN ,W?PERIOD ,W?QUOTE>
<COND (<EQUAL? .WRD ,W?QUOTE>
<COND (<AND <EQUAL? <GET ,P-LEXV .PTR>
,W?QUOTE>
<OR <NOT <EQUAL? .VERB
,ACT?TELL
,ACT?SAY
; ,ACT?NAME>>
<NOT <EQUAL? ,WINNER
,PLAYER>>>>
<COND (<QUOTED-PHRASE? .PTR .VERB>
<SET PTR
<+ .PTR ,P-LEXELEN>>
<AGAIN>)
(T
<RFALSE>)>)
(<T? ,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 ,ACT?GO>
<OR <EQUAL? .LEN 1>
<AND <EQUAL? .LEN 2>
<EQUAL? .VERB ,ACT?WALK ,ACT?GO>>
<AND <EQUAL? .NW ,W?THEN ,W?PERIOD
,W?QUOTE>
<G? .LEN 1 ;2>>
; <AND <EQUAL? .NW ,W?PERIOD>
<G? .LEN 1>>
<AND <T? ,QUOTE-FLAG>
<EQUAL? .LEN 2>
<EQUAL? .NW ,W?QUOTE>>
<AND <G? .LEN 2>
<EQUAL? .NW ,W?COMMA ,W?AND>>>>
<SET DIR .VAL>
<SETG P-DIR-WORD .WRD>
<COND (<EQUAL? .NW ,W?COMMA ,W?AND>
<CHANGE-LEXV <+ .PTR ,P-LEXELEN>
,W?THEN>)>
<COND (<NOT <G? .LEN 2>>
<SETG QUOTE-FLAG <>>
<RETURN>)>)
(<AND <SET VAL <WT? .WRD ,PS?VERB ,P1?VERB>>
<ZERO? .VERB>>
<SETG P-PRSA-WORD .WRD> ; "For RUN, etc."
<SET VERB .VAL>
<PUT ,P-ITBL ,P-VERB .VAL>
<PUT ,P-ITBL ,P-VERBN ,P-VTBL>
<PUT ,P-VTBL 0 .WRD>
<SET X <+ <* .PTR 2> 2>>
<PUTB ,P-VTBL 2 <GETB ,P-LEXV .X>>
<PUTB ,P-VTBL 3 <GETB ,P-LEXV <+ .X 1>>>)
(<OR <SET VAL <WT? .WRD ,PS?PREPOSITION 0>>
<EQUAL? .WRD ,W?ALL ,W?EVERYTHING>
<EQUAL? .WRD ,W?BOTH ,W?A>
<WT? .WRD ,PS?ADJECTIVE>
<WT? .WRD ,PS?OBJECT>>
; "Fix for new zilch, 3/12/87."
<COND (<AND <G? ,P-LEN 1> ; "1 IN RETROFIX #34"
<EQUAL? .NW ,W?OF>
<NOT <EQUAL? .VERB
;,ACT?MAKE ,ACT?TAKE>>
<ZERO? .VAL>
<NOT <EQUAL? .WRD ,W?A>>
<NOT <EQUAL? .WRD ,W?ALL ,W?BOTH
,W?EVERYTHING>>>
; <COND (<EQUAL? .WRD ,W?BOTTOM>
<SET BOTTOM T>)>
<PUT ,P-OFW ,P-NCN .WRD> ; "Save OF-word"
<SET OF-FLAG T>)
(<AND <T? .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 are too many nouns in that sentence.]" CR>
<RFALSE>)
(T
<SETG P-NCN <+ ,P-NCN 1>>
<SETG P-ACT .VERB>
<SET PTR <CLAUSE .PTR .VAL .WRD>>
<COND (<ZERO? .PTR>
<RFALSE>)
(<L? .PTR 0>
<SETG QUOTE-FLAG <>>
<RETURN>)>)>)
(<EQUAL? .WRD ,W?OF> ; "RETROFIX #34"
<COND (<OR <ZERO? .OF-FLAG>
<EQUAL? .NW ,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>>>)>
<PUT ,OOPS-TABLE ,O-PTR <>>
<COND (<T? .DIR>
<SETG PRSA ,V?WALK>
<SETG P-WALK-DIR .DIR>
<SETG AGAIN-DIR .DIR> ; "FIX #44"
<SETG PRSO .DIR>
<SETG P-OFLAG <>>
<RTRUE>)>
<SETG P-WALK-DIR <>>
<SETG AGAIN-DIR <>> ; "FIX #44"
<COND (<AND <T? ,P-OFLAG>
<ORPHAN-MERGE>>
<SETG WINNER .OWINNER>)
; (T
<SETG BOTTOM? .BOTTOM>)>
; <COND (<ZERO? <GET ,P-ITBL ,P-VERB>>
<PUT ,P-ITBL ,P-VERB ,ACT?TELL>)> ; "Why was this here?"
<COND (<AND <SYNTAX-CHECK>
<SNARF-OBJECTS>
<MANY-CHECK>
; <TAKE-CHECK>
<ITAKE-CHECK ,P-PRSO <GETB ,P-SYNTAX ,P-SLOC1>>
<ITAKE-CHECK ,P-PRSI <GETB ,P-SYNTAX ,P-SLOC2>>>
<RTRUE>)>
<RFALSE>>
<ROUTINE PCLEAR ()
<SETG P-CONT <>>
<SETG QUOTE-FLAG <>>
<RFALSE>>
<ROUTINE CHANGE-LEXV (PTR WRD "OPT" PTRS? "AUX" X Y Z)
<COND (<ASSIGNED? PTRS?>
<SET X <+ 2 <* 2 <- .PTR ,P-LEXELEN>>>>
<SET Y <GETB ,P-LEXV .X>>
<SET Z <+ 2 <* 2 .PTR>>>
<PUTB ,P-LEXV .Z .Y>
<PUTB ,AGAIN-LEXV .Z .Y>
<SET Y <GETB ,P-LEXV <+ 1 .X>>>
<SET Z <+ 3 <* 2 .PTR>>>
<PUTB ,P-LEXV .Z .Y>
<PUTB ,AGAIN-LEXV .Z .Y>)>
<PUT ,P-LEXV .PTR .WRD>
<PUT ,AGAIN-LEXV .PTR .WRD>
<RTRUE>>
"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 "OPT" (B1 5) "AUX" OFFS TYP)
<SET OFFS ,P-P1OFF>
<SET TYP <GETB .PTR ,P-PSOFF>>
<COND (<NOT <BTST .TYP .BIT>>
<RFALSE>)
(<G? .B1 4>
<RTRUE>)>
<SET TYP <BAND .TYP ,P-P1BITS>>
<COND (<NOT <EQUAL? .TYP .B1>>
<SET OFFS <+ .OFFS 1>>)>
<RETURN <GETB .PTR .OFFS>>>
; <ROUTINE WT? (PTR BIT "OPT" (B1 5) "AUX" OFFS TYP)
<SET OFFS ,P-P1OFF>
<SET TYP <GETB .PTR ,P-PSOFF>>
<COND (<BTST .TYP .BIT>
<COND (<G? .B1 4>
<RTRUE>)>
<SET TYP <BAND .TYP ,P-P1BITS>>
<COND (<NOT <EQUAL? .TYP .B1>>
<INC OFFS>)>
<RETURN <GETB .PTR .OFFS>>)
(T
<RFALSE>)>>
"Scan through a noun phrase, leaving a pointer to its starting location:"
<ROUTINE CLAUSE (PTR VAL WRD "AUX" (FIRST?? T) (ANDFLG <>) (LW 0)
OFF NUM NW)
<SET OFF <* <- ,P-NCN 1> 2>>
<COND (<T? .VAL>
<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 (<OR <EQUAL? <GET ,P-LEXV .PTR> ,W?THE ,W?A ,W?AN>
<EQUAL? <GET ,P-LEXV .PTR> ,W?$BUZZ>>
; <EQUAL? <GET ,P-LEXV .PTR> ,W?THE ,W?A ,W?AN>
<PUT ,P-ITBL .NUM <REST <GET ,P-ITBL .NUM> 4>>)>
<REPEAT ()
<COND (<DLESS? P-LEN 0>
<PUT ,P-ITBL <+ .NUM 1> <REST ,P-LEXV <* .PTR 2>>>
<RETURN -1>)>
<SET WRD <GET ,P-LEXV .PTR>>
<COND (<BUZZER-WORD? .WRD>
<RFALSE>)
(<OR <T? .WRD>
<SET WRD <QUOTED-WORD? .PTR>>
<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 (<ZERO? .NW> ; "FIX"
<SET NW
<NUMBER? <+ .PTR ,P-LEXELEN>>>)>)>
; <COND (<AND <EQUAL? .WRD ,W?OF>
<EQUAL? <GET ,P-ITBL ,P-VERB>
,ACT?MAKE ,ACT?TAKE>>
<CHANGE-LEXV .PTR ,W?WITH>
<SET WRD ,W?WITH>)>
<COND (<AND <EQUAL? .WRD ,W?QUOTE>
<NOT <EQUAL? ,P-ACT ,ACT?TELL ,ACT?SAY
,ACT?NAME>>>
<COND (<QUOTED-PHRASE? .PTR ,P-ACT>
<SET PTR <+ .PTR ,P-LEXELEN>>
<AGAIN>)
(T
<RFALSE>)>)
(<AND <EQUAL? .WRD ,W?PERIOD>
<EQUAL? .LW ,W?MR ,W?MRS ; ,W?DR>>
<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 <T? .ANDFLG>
<OR ;"3/25/83: next statement added."
<ZERO? <GET ,P-ITBL ,P-VERBN>>
;"10/26/84: next stmt changed"
<VERB-DIR-ONLY? .WRD>>>
<SET PTR <- .PTR 4>>
<CHANGE-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>>>
<PUT ,P-OFW <- ,P-NCN 1> .WRD>)
(<AND <WT? .WRD ,PS?ADJECTIVE
;,P1?ADJECTIVE>
<T? .NW>
<WT? .NW ,PS?OBJECT>>)
(<AND <ZERO? .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 <T? ,P-MERGED>
<T? ,P-OFLAG>
<T? <GET ,P-ITBL ,P-VERB>>>
<OR <WT? .WRD ,PS?ADJECTIVE>
<WT? .WRD ,PS?BUZZ-WORD>>>)
(<WT? .WRD ,PS?ADJECTIVE>)
(<WT? .WRD ,PS?BUZZ-WORD>)
(<AND <T? .ANDFLG>
<ZERO? <GET ,P-ITBL ,P-VERB>>>
<SET PTR <- .PTR 4>>
<CHANGE-LEXV <+ .PTR 2> ,W?THEN>
<SETG P-LEN <+ ,P-LEN 2>>)
(<WT? .WRD ,PS?PREPOSITION>)
(T
<CANT-USE .PTR>
<RFALSE>)>)
(T
<UNKNOWN-WORD .PTR>
<RFALSE>)>
<SET LW .WRD>
<SET FIRST?? <>>
<SET PTR <+ .PTR ,P-LEXELEN>>>>
<ROUTINE SPOKEN-TO (WHO)
<COND (<OR <NOT <EQUAL? .WHO ,QCONTEXT>>
<NOT <EQUAL? ,HERE ,QCONTEXT-ROOM>>>
<SEE-CHARACTER .WHO>
<TELL "[spoken to " THE .WHO ,BRACKET>)>
<RTRUE>>
<ROUTINE ANYONE-HERE? ("AUX" OBJ)
<SET OBJ <QCONTEXT-GOOD?>>
<COND (<AND <ZERO? .OBJ>
<SET OBJ <FIRST? ,HERE>>>
<REPEAT ()
<COND (<AND <IS? .OBJ ,PERSON>
<NOT <EQUAL? .OBJ ,PLAYER ,WINNER>>
<NOT <IS? .OBJ ,PLURAL>>>
<RETURN>)
(<NOT <SET OBJ <NEXT? .OBJ>>>
<RETURN>)>>)>
<RETURN .OBJ>>
<ROUTINE SEE-CHARACTER (OBJ)
<COND (<IS? .OBJ ,FEMALE>
<SETG P-HER-OBJECT .OBJ>)
(T
<SETG P-HIM-OBJECT .OBJ>)>
<SETG QCONTEXT .OBJ>
<SETG QCONTEXT-ROOM <LOC .OBJ>>
<RFALSE>>
<ROUTINE QCONTEXT-GOOD? ()
<COND (<AND <T? ,QCONTEXT>
<IS? ,QCONTEXT ,PERSON>
<HERE? ,QCONTEXT-ROOM>
<VISIBLE? ,QCONTEXT>>
<RETURN ,QCONTEXT>)>
<RFALSE>>
<ROUTINE THIS-IS-IT (OBJ)
<COND (<OR <ZERO? .OBJ>
<EQUAL? .OBJ ,PLAYER ,ME ,INTNUM>
<EQUAL? .OBJ ,INTDIR ,LEFT ,RIGHT>>
<RFALSE>)
(<IS? .OBJ ,FEMALE>
<SETG P-HER-OBJECT .OBJ>
<RFALSE>)
(<IS? .OBJ ,PERSON>
<SETG P-HIM-OBJECT .OBJ>
<RFALSE>)
(<IS? .OBJ ,PLURAL>
<SETG P-THEM-OBJECT .OBJ>
<RFALSE>)
(T
<SETG P-IT-OBJECT .OBJ>
<RFALSE>)>>
<ROUTINE FAKE-ORPHAN ("AUX" TMP X)
<ORPHAN ,P-SYNTAX <>>
<BE-SPECIFIC>
<SET TMP <GET ,P-OTBL ,P-VERBN>>
<COND (<ZERO? .TMP>
<TELL B ,W?TELL>)
(<ZERO? <GETB ,P-VTBL 2>>
<PRINTB <GET .TMP 0>>)
(T
<SET X <GETB .TMP 2>>
<WORD-PRINT .X <GETB .TMP 3>>
<PUTB ,P-VTBL 2 0>)>
<SETG P-OFLAG T>
<SETG P-WON <>>
<TELL "?]" CR>
<RTRUE>>
<ROUTINE PERFORM (A "OPT" (O <>) (I <>)
"AUX" (V <>) (WHO <>) OA OO OI ONP X)
#DECL ((A) FIX (O) <OR FALSE OBJECT FIX> (I) <OR FALSE OBJECT>)
<COND (<AND <NOT <EQUAL? ,WINNER ,PLAYER>>
<NOT <IS? ,WINNER ,PERSON>>>
<NOT-LIKELY ,WINNER>
<PRINT " would respond.|">
<PCLEAR>
<RFATAL>)>
<SET OA ,PRSA>
<SET OO ,PRSO>
<SET OI ,PRSI>
<SET ONP ,NOW-PRSI?>
<SET WHO <ANYONE-HERE?>>
<SETG PRSA .A>
<COND (<AND <NOT <EQUAL? ,WINNER ,PLAYER>>
<SET X <GAMEVERB?>>>
<TELL "[" ,CANT "tell characters to do that.]" CR>
<RFATAL>)
(<AND <ZERO? ,LIT?>
<SET X <SEEING?>>>
<TOO-DARK>
<RFATAL>)
(<NOT <EQUAL? .A ,V?WALK>>
<COND (<AND <EQUAL? ,WINNER ,PLAYER>
<VERB? WHO WHAT WHERE>
<T? .WHO>>
<SETG WINNER .WHO>
<SPOKEN-TO .WHO>)
(<AND <EQUAL? ,WINNER ,PLAYER>
<EQUAL? .O ,ME>
<VERB? TELL TELL-ABOUT ASK-ABOUT ASK-FOR
QUESTION REPLY THANK YELL HELLO GOODBYE
SAY ALARM>>
<COND (<ZERO? .WHO>
<TALK-TO-SELF>
<RFATAL>)>
<SETG WINNER .WHO>
<SPOKEN-TO .WHO>)>
<COND (<EQUAL? ,YOU .I .O>
<COND (<EQUAL? ,WINNER ,PLAYER>
<COND (<ZERO? .WHO>
<TALK-TO-SELF>
<RFATAL>)
(T
<SETG WINNER .WHO>
<SPOKEN-TO .WHO>)>)
(T
<SEE-CHARACTER ,WINNER>
<SET WHO ,WINNER>)>
<COND (<EQUAL? .I ,YOU>
<SET I .WHO>)>
<COND (<EQUAL? .O ,YOU>
<SET O .WHO>)>)>
<COND (<AND <EQUAL? ,IT .I .O>
<NOT <ACCESSIBLE? ,P-IT-OBJECT>>>
<COND (<ZERO? .I>
<FAKE-ORPHAN>)
(T
<CANT-SEE-ANY ,P-IT-OBJECT>)>
<RFATAL>)>
<COND (<EQUAL? ,THEM .I .O>
<COND (<VISIBLE? ,P-THEM-OBJECT>
<COND (<EQUAL? ,THEM .O>
<SET O ,P-THEM-OBJECT>)>
<COND (<EQUAL? ,THEM .I>
<SET I ,P-THEM-OBJECT>)>)
(T
<COND (<ZERO? .I>
<FAKE-ORPHAN>)
(T
<CANT-SEE-ANY ,P-THEM-OBJECT>)>
<RFATAL>)>)>
<COND (<EQUAL? ,HER .I .O>
<COND (<VISIBLE? ,P-HER-OBJECT>
<COND (<AND <EQUAL? ,P-HER-OBJECT ,WINNER>
<NO-OTHER? T>>
<RFATAL>)>
<COND (<EQUAL? ,HER .O>
<SET O ,P-HER-OBJECT>)>
<COND (<EQUAL? ,HER .I>
<SET I ,P-HER-OBJECT>)>)
(T
<COND (<ZERO? .I>
<FAKE-ORPHAN>)
(T
<CANT-SEE-ANY ,P-HER-OBJECT>)>
<RFATAL>)>)>
<COND (<EQUAL? ,HIM .I .O>
<COND (<VISIBLE? ,P-HIM-OBJECT>
<COND (<AND <EQUAL? ,P-HIM-OBJECT ,WINNER>
<NO-OTHER?>>
<RFATAL>)>
<COND (<EQUAL? ,HIM .O>
<SET O ,P-HIM-OBJECT>)>
<COND (<EQUAL? ,HIM .I>
<SET I ,P-HIM-OBJECT>)>)
(T
<COND (<ZERO? .I>
<FAKE-ORPHAN>)
(T
<CANT-SEE-ANY ,P-HIM-OBJECT>)>
<RFATAL>)>)>
<COND (<EQUAL? .O ,IT>
<SET O ,P-IT-OBJECT>)>
<COND (<EQUAL? .I ,IT>
<SET I ,P-IT-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 (<T? .V>
<SETG P-WON <>>)>)>
<COND (<NOT <EQUAL? .A ,V?WALK>>
<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 (<T? .V>)
(<NOT <EQUAL? .A ,V?TELL-ABOUT ,V?ASK-ABOUT ,V?ASK-FOR>>
<SETG NOW-PRSI? T>
<COND (<ZERO? .I>)
(<AND <NOT <EQUAL? .A ,V?WALK>>
<LOC .I>>
<SET V <GETP <LOC .I> ,P?CONTFCN>>
<COND (<T? .V>
<SET V <APPLY .V ,M-CONT>>)>)>
<SETG NOW-PRSI? <>>
<COND (<T? .V>)
(<ZERO? .O>)
(<AND <NOT <EQUAL? .A ,V?WALK>>
<LOC .O>>
<SET V <GETP <LOC .O> ,P?CONTFCN>>
<COND (<T? .V>
<SET V <APPLY .V ,M-CONT>>)>)>
<SETG NOW-PRSI? T>
<COND (<T? .V>)
(<T? .I>
<SET V <APPLY <GETP .I ,P?ACTION>>>)>)>
<SETG NOW-PRSI? <>>
<COND (<T? .V>)
(<ZERO? .O>)
(<NOT <EQUAL? .A ,V?WALK>>
<SET V <APPLY <GETP .O ,P?ACTION>>>)>
<COND (<ZERO? .V>
<SET V <APPLY <GET ,ACTIONS .A>>>)>
<COND (<NOT <EQUAL? .V ,M-FATAL>>
<APPLY <GETP <LOC ,WINNER> ,P?ACTION> ,M-END>)>
<SETG PRSA .OA>
<SETG PRSO .OO>
<SETG PRSI .OI>
<SETG NOW-PRSI? .ONP>
<RETURN .V>>
<ROUTINE NO-OTHER? ("OPT" (FEMALE? <>) "AUX" OBJ)
<COND (<SET OBJ <FIRST? ,HERE>>
<REPEAT ()
<COND (<EQUAL? .OBJ ,WINNER>)
(<IS? .OBJ ,PERSON>
<COND (<T? .FEMALE?>
<COND (<IS? .OBJ ,FEMALE>
<RETURN>)>)
(<NOT <IS? .OBJ ,FEMALE>>
<RETURN>)>)>
<COND (<NOT <SET OBJ <NEXT? .OBJ>>>
<RETURN>)>>)>
<COND (<ZERO? .OBJ>
<PERPLEXED ,WINNER>
<TELL "Who are you talking about?\"" CR>
<RTRUE>)
(T
<RFALSE>)>>
<ROUTINE BUZZER-WORD? (WORD "AUX" TBL LEN X)
<SET LEN <GET ,Q-BUZZES 0>>
<COND (<SET TBL <INTBL? .WORD <REST ,Q-BUZZES 2> .LEN>>
<TO-DO-THING-USE "ask about" "ASK CHARACTER ABOUT">
<RTRUE>)>
<SET LEN <GET ,N-BUZZES 0>>
<COND (<SET TBL <INTBL? .WORD <REST ,N-BUZZES 2> .LEN>>
<NYMPH-APPEARS>
<TELL ,DONT "need to use that " 'INTNUM>
<TO-COMPLETE>
<RTRUE>)>
<SET LEN <GET ,SWEAR-WORDS 0>>
<COND (<SET TBL <INTBL? .WORD <REST ,SWEAR-WORDS 2> .LEN>>
<SET WORD <GET ,STATS ,INTELLIGENCE>>
<COND (<L? .WORD 1>
<TELL
"Such language betrays your low intelligence." CR>
<RTRUE>)>
<TELL "You suddenly feel less intelligent." CR>
<UPDATE-STAT -1 ,INTELLIGENCE T>
<RTRUE>)>
<COND (<NOT <SEE-COLOR?>>
<SET LEN <GET ,COLOR-WORDS 0>>
<COND (<SET TBL <INTBL? .WORD <REST ,COLOR-WORDS 2> .LEN>>
<TELL ,DONT "see the color " B .WORD
" here; or any other colors, for that matter." CR>
<RTRUE>)>)>
<SET LEN <GET ,MAGIC-WORDS 0>>
<REPEAT ()
<SET TBL <GET ,MAGIC-WORDS .LEN>>
<COND (<AND <EQUAL? .WORD <GET .TBL 0>>
<ZERO? <GET .TBL 2>>>
<TELL "[This story won't recognize the word \""
B .WORD ".\"]" CR>
<RTRUE>)>
<COND (<DLESS? LEN 2>
<RETURN>)>>
<COND (<OR <EQUAL? .WORD ,W?QUIETLY ,W?SLOWLY ,W?CAREFULLY>
<EQUAL? .WORD ,W?CLOSELY ,W?QUICKLY ,W?RAPIDLY>>
<NYMPH-APPEARS>
<TELL "Adverbs (such as \"" B .WORD "\") aren't needed">
<TO-COMPLETE>
<RTRUE>)>
<COND (<OR <EQUAL? .WORD ,W?XYZZY ,W?PLUGH ,W?PLOVER>
<EQUAL? .WORD ,W?YOHO ,W?ULYSSES ,W?ODYSSEUS>>
<PRINT "A hollow voice says, \"Fool!\"">
<CRLF>
<RTRUE>)>
<RFALSE>>
<ROUTINE VERB-DIR-ONLY? (WRD)
<COND (<AND <NOT <WT? .WRD ,PS?OBJECT>>
<NOT <WT? .WRD ,PS?ADJECTIVE>>
<OR <WT? .WRD ,PS?DIRECTION>
<WT? .WRD ,PS?VERB>>>
<RTRUE>)
(T
<RFALSE>)>>
<BUZZ AGAIN G OOPS>
"For AGAIN purposes, put contents of one LEXV table into another."
; <ROUTINE STUFF (DEST SRC "OPT" (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 (DEST SRC "AUX" CNT)
<SET CNT <- <GETB .SRC 0> 1>>
<REPEAT ()
<PUTB .DEST .CNT <GETB .SRC .CNT>>
<COND (<DLESS? CNT 0>
<RTRUE>)>>>
"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)
<SET TMP <GET ,OOPS-TABLE ,O-END>>
<COND (<T? .TMP>
<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>>>
<INC CTR>
<COND (<EQUAL? .CTR .LEN>
<RETURN>)>>
<PUTB ,AGAIN-LEXV .SLOT .DBEG>
<PUTB ,AGAIN-LEXV <- .SLOT 1> .LEN>
<RTRUE>>
; <GLOBAL P-DOLLAR-FLAG:FLAG <>>
<ROUTINE NUMBER? (PTR "AUX" (SUM 0) (TIM <>) (EXC <>) ; (DOLLAR 0)
CNT BPTR CHR CCTR TMP NW)
<SET TMP <REST ,P-LEXV <+ .PTR .PTR>>>
<SET BPTR <GETB .TMP 3>>
<SET CNT <GETB .TMP 2>>
<COND (<G? .CNT 3>
<SET CNT 3>)>
<REPEAT ()
<COND (<DLESS? CNT 0>
<RETURN>)>
<SET CHR <GETB ,P-INBUF .BPTR>>
<COND (<EQUAL? .CHR %<ASCII !\:>>
<COND (<T? .EXC>
<RFALSE>)>
<SET TIM .SUM>
<SET SUM 0>)
(<EQUAL? .CHR %<ASCII !\->>
<COND (<T? .TIM>
<RFALSE>)>
<SET EXC .SUM>
<SET SUM 0>)
(<G? .SUM 9999>
<RFALSE>)
; (<EQUAL? .CHR %<ASCII !\$>>
<SET DOLLAR T>)
(<AND <G? .CHR %<- <ASCII !\0> 1>>
<L? .CHR %<+ <ASCII !\9> 1>>>
<SET SUM <+ <* .SUM 10> <- .CHR %<ASCII !\0>>>>)
(T
<RFALSE>)>
<INC BPTR>>
<CHANGE-LEXV .PTR ,W?INTNUM>
<SET NW <GET ,P-LEXV <+ .PTR ,P-LEXELEN>>>
; <COND (<AND <T? .DOLLAR>
<EQUAL? .NW ,W?PERIOD>
<G? ,P-LEN 1>>
<SET TMP <CENTS-CHECK <+ .PTR <* ,P-LEXELEN 2>>>>
<COND (<T? .TMP>
<COND (<EQUAL? .TMP 100>
<SET TMP 0>)>
<SET SUM <+ <* 100 .SUM> .TMP>>
<SET CCTR <- ,P-LEN 2>>
<REPEAT ()
<COND (<DLESS? CCTR 0>
<RETURN>)>
<SET PTR <+ .PTR ,P-LEXELEN>>
<CHANGE-LEXV .PTR
<GET ,P-LEXV <+ .PTR <* 2 ,P-LEXELEN>>>>
<PUTB ,P-LEXV <+ <* .PTR 2> 2>
<GETB ,P-LEXV <+ <* <+ .PTR <* 2 ,P-LEXELEN>> 2> 2>>>
<PUTB ,P-LEXV <+ <* .PTR 2> 3>
<GETB ,P-LEXV <+ <* <+ .PTR <* 2 ,P-LEXELEN>> 2> 3>>>
<SETG P-LEN <- ,P-LEN 2>>
<PUTB ,P-LEXV ,P-LEXWORDS <- <GETB ,P-LEXV ,P-LEXWORDS> 2>>>)>)>
; <COND (<T? .DOLLAR>
<SET SUM <* .SUM 100>>)
(<EQUAL? .NW ,W?DOLLAR ,W?DOLLARS>
<SET DOLLAR T>
<SET SUM <* .SUM 100>>)
(<EQUAL? .NW ,W?CENT ,W?CENTS>
<SET DOLLAR T>)>
<COND (<G? .SUM 9999>
<RFALSE>)
(<T? .EXC>
<SETG P-EXCHANGE .EXC>)
(<T? .TIM>
<SETG P-EXCHANGE 0>
<COND (<G? .TIM 23>
<RFALSE>)
(<G? .TIM 19>)
(<G? .TIM 12>
<RFALSE>)
(<G? .TIM 7>)
(T
<SET TIM <+ 12 .TIM>>)>
<SET SUM <+ .SUM <* .TIM 60>>>)
(T
<SETG P-EXCHANGE 0>)>
; <SETG P-DOLLAR-FLAG .DOLLAR>
<SETG P-NUMBER .SUM>
; <COND (<AND <T? .DOLLAR>
<G? .SUM 0>>
<RETURN ,W?MONEY>)>
; <SETG P-DOLLAR-FLAG <>>
<RETURN ,W?INTNUM>>
; <ROUTINE CENTS-CHECK (PTR "AUX" (CCTR 0) (SUM 0) CNT BPTR CHR)
<SET CNT <GETB <REST ,P-LEXV <* .PTR 2>> 2>>
<SET BPTR <GETB <REST ,P-LEXV <* .PTR 2>> 3>>
<REPEAT ()
<COND (<DLESS? CNT 0>
<RETURN>)>
<SET CHR <GETB ,P-INBUF .BPTR>>
<COND (<IGRTR? CCTR 2>
<RFALSE>)>
<COND (<AND <L? .CHR 58>
<G? .CHR 47>>
<SET SUM <+ <* .SUM 10> <- .CHR 48>>>)
(T
<RFALSE>)>
<INC BPTR>>
<COND (<ZERO? .SUM>
<RETURN 100>)
(<EQUAL? .CCTR 1>
<RETURN <* 10 .SUM>>)>
<RETURN .SUM>>
"Old ORPHAN-MERGE."
; <ROUTINE ORPHAN-MERGE ("AUX" (CNT -1) TEMP VERB BEG END (ADJ <>) WRD)
<SETG P-OFLAG <>>
<COND (<OR <EQUAL? <WT? <SET WRD <GET <GET ,P-ITBL ,P-VERBN> 0>>
,PS?VERB ,P1?VERB>
<GET ,P-OTBL ,P-VERB>>
<WT? .WRD ,PS?ADJECTIVE>>
<SET ADJ T>) ; "FIX #45"
(<WT? <SET WRD <GET <GET ,P-ITBL ,P-VERBN> 0>>
,PS?ADJECTIVE ;,P1?ADJECTIVE>
<SET ADJ T>)
(<AND <WT? .WRD ,PS?OBJECT ; ,P1?OBJECT>
<ZERO? ,P-NCN>>
<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 <T? <SET VERB <GET ,P-ITBL ,P-VERB>>>
<ZERO? .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 (<T? .ADJ>
<PUT ,P-OTBL ,P-NC1 <REST ,P-LEXV 2>>
<COND (<ZERO? <GET ,P-ITBL ,P-NC1L>> ;"? DELETE?"
<PUT ,P-ITBL ,P-NC1L <REST ,P-LEXV 6>>)>
<COND (<ZERO? ,P-NCN> ;"? DELETE?"
<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 (<T? .ADJ>
<PUT ,P-ITBL ,P-NC1 <REST ,P-LEXV 2>>
<COND (<ZERO? <GET ,P-ITBL ,P-NC1L>> ;"? DELETE?"
<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>)>)
(<T? ,P-ACLAUSE>
<COND (<AND <NOT <EQUAL? ,P-NCN 1>> <NOT .ADJ>>
<SETG P-ACLAUSE <>>
<RFALSE>)
(T
<SET BEG <GET ,P-ITBL ,P-NC1>>
<COND (<T? .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 (<T? .ADJ>
<CLAUSE-WIN .ADJ>
; <ACLAUSE-WIN .ADJ>
<RETURN>)
(T
<SETG P-ACLAUSE <>>
<RFALSE>)>)
(<AND <ZERO? .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>
<CLAUSE-WIN .ADJ>
; <ACLAUSE-WIN .ADJ>
<RETURN>)
(<BTST <GETB .WRD ,P-PSOFF> ,PS?OBJECT>
<COND (<EQUAL? .WRD ,P-ANAM>
<CLAUSE-WIN .ADJ>
; <ACLAUSE-WIN .ADJ>)
(T
<CLAUSE-WIN>
; <NCLAUSE-WIN>)>
<RETURN>)>
<SET BEG <REST .BEG ,P-WORDLEN>>
<COND (<ZERO? .END>
<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 (<IGRTR? CNT ,P-ITBLLEN>
<SETG P-MERGED T>
<RTRUE>)>
<PUT ,P-ITBL .CNT <GET ,P-OTBL .CNT>>>>
"New ORPHAN-MERGE."
<ROUTINE ORPHAN-MERGE ("AUX" (WHICH 1) (ADJ <>) TEMP VERB BEG END WRD X)
<SETG P-OFLAG <>>
<SET WRD <GET <GET ,P-ITBL ,P-VERBN> 0>>
<SET X <GET ,P-OTBL ,P-VERB>>
<COND (<OR <EQUAL? <WT? .WRD ,PS?VERB ,P1?VERB> .X>
<WT? .WRD ,PS?ADJECTIVE>>
<SET ADJ T>)
(<AND <WT? .WRD ,PS?OBJECT ,P1?OBJECT>
<ZERO? ,P-NCN>>
<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>)>
<SET VERB <GET ,P-ITBL ,P-VERB>>
<COND (<AND <T? .VERB>
<ZERO? .ADJ>
<NOT <EQUAL? .VERB <GET ,P-OTBL ,P-VERB>>>>
<RFALSE>)
(<EQUAL? ,P-NCN 2>
<RFALSE>)
(<EQUAL? <GET ,P-OTBL ,P-NC1> 1>
<SET TEMP <GET ,P-ITBL ,P-PREP1>>
<COND (<OR <ZERO? .TEMP>
<EQUAL? .TEMP <GET ,P-OTBL ,P-PREP1>>>
<COND (<T? .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>>)
(T
<RFALSE>)>)
(<EQUAL? <GET ,P-OTBL ,P-NC2> 1>
<SET WHICH 2>
<SET TEMP <GET ,P-ITBL ,P-PREP1>>
<COND (<OR <ZERO? .TEMP>
<EQUAL? .TEMP <GET ,P-OTBL ,P-PREP2>>>
<COND (<T? .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>)>)
(<T? ,P-ACLAUSE>
<COND (<AND <NOT <EQUAL? ,P-NCN 1>>
<ZERO? .ADJ>>
<SETG P-ACLAUSE <>>
<RFALSE>)
(T
<COND (<NOT <EQUAL? ,P-ACLAUSE ,P-NC1>>
<SET WHICH 2>)>
<SET BEG <GET ,P-ITBL ,P-NC1>>
<COND (<T? .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 (<T? .ADJ>
<CLAUSE-WIN .ADJ>
<RETURN>)
(T
<SETG P-ACLAUSE <>>
<RFALSE>)>)
(<OR <EQUAL? .WRD ,W?ALL ,W?EVERYTHING ,W?ONE>
<EQUAL? .WRD ,W?BOTH>
<AND <BTST <GETB .WRD ,P-PSOFF>
,PS?ADJECTIVE> ;"same as WT?"
<ZERO? .ADJ>
; <ADJ-CHECK .WRD .ADJ .ADJ>>>
<SET ADJ .WRD>)
(<EQUAL? .WRD ,W?ONE>
<CLAUSE-WIN .ADJ>
<RETURN>)
(<AND <BTST <GETB .WRD ,P-PSOFF> ,PS?OBJECT>
<EQUAL? <REST .BEG ,P-WORDLEN> .END>>
<COND (<EQUAL? .WRD ,P-ANAM>
<CLAUSE-WIN .ADJ>)
(T
<CLAUSE-WIN>)>
<RETURN>)>
<SET BEG <REST .BEG ,P-WORDLEN>>
<COND (<ZERO? .END>
<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>>
; <SET CNT -1>
; <REPEAT ()
<COND (<IGRTR? CNT ,P-ITBLLEN>
<SETG P-MERGED T>
<RTRUE>)>
<PUT ,P-ITBL .CNT <GET ,P-OTBL .CNT>>>
<COPYT ,P-OTBL ,P-ITBL ,P-ITBLLEN>
<SETG P-MERGED .WHICH>
<RTRUE>>
"ACLAUSE- and NCLAUSE-WIN are replaced by CLAUSE-WIN."
; <ROUTINE ACLAUSE-WIN (ADJ "AUX" X)
<PUT ,P-ITBL ,P-VERB <GET ,P-OTBL ,P-VERB>>
<SET X <+ ,P-ACLAUSE 1>>
<CLAUSE-COPY ,P-OTBL ,P-OTBL ,P-ACLAUSE .X ,P-ACLAUSE .X .ADJ>
<AND <T? <GET ,P-OTBL ,P-NC2>> <SETG P-NCN 2>>
<SETG P-ACLAUSE <>>
<RTRUE>>
; <ROUTINE NCLAUSE-WIN ()
<CLAUSE-COPY ,P-ITBL ,P-OTBL ,P-NC1 ,P-NC1L
,P-ACLAUSE <+ ,P-ACLAUSE 1>>
<AND <T? <GET ,P-OTBL ,P-NC2>> <SETG P-NCN 2>>
<SETG P-ACLAUSE <>>
<RTRUE>>
<ROUTINE CLAUSE-WIN ("OPT" (ADJ <>) X)
<COND (<T? .ADJ>
<SETG P-LASTADJ .ADJ>
<PUT ,P-ITBL ,P-VERB <GET ,P-OTBL ,P-VERB>>)
(T
<SET ADJ T>)>
<SET X ,P-OCL2>
<COND (<EQUAL? ,P-ACLAUSE ,P-NC1>
<SET X ,P-OCL1>)>
<CLAUSE-COPY ,P-OTBL ,P-OTBL ,P-ACLAUSE <+ ,P-ACLAUSE 1> .X .ADJ>
; <CLAUSE-COPY ,P-OTBL ,P-OTBL ,P-ACLAUSE <+ ,P-ACLAUSE 1>
<COND (<EQUAL? ,P-ACLAUSE ,P-NC1> ,P-OCL1)
(T ,P-OCL2)> .ADJ>
<COND (<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? .BUF 1>
<REPEAT ()
<COND (<DLESS? CNT 0>
<RFALSE>)>
<PRINTC <GETB ,P-INBUF .BUF>>
<INC BUF>>)>
<RFALSE>>
<CONSTANT LAST-BAD-LEN 13>
<CONSTANT LAST-BAD <ITABLE ,LAST-BAD-LEN (BYTE) 0>>
<ROUTINE UNKNOWN-WORD (PTR "AUX" (CNT 0) MSG LEN OFFSET CHAR)
<PUT ,OOPS-TABLE ,O-PTR .PTR>
<SET MSG <PICK-NEXT ,UNKNOWN-MSGS>>
<TELL "[" <GET .MSG 0>>
<SET OFFSET <REST ,P-LEXV <* .PTR 2>>>
<SET LEN <GETB .OFFSET 2>> ; "Length of word typed."
<SET OFFSET <GETB .OFFSET 3>> ; "Starting offset into P-INBUF."
<COND (<G? .OFFSET 1>
<REPEAT ()
<COND (<DLESS? LEN 0>
<RETURN>)>
<SET CHAR <GETB ,P-INBUF .OFFSET>>
<PRINTC .CHAR>
<INC OFFSET>
<COND (<L? .CNT %<- ,LAST-BAD-LEN 1>>
<INC CNT>
<PUTB ,LAST-BAD .CNT .CHAR>)>>)>
<PUTB ,LAST-BAD 0 .CNT>
<SETG QUOTE-FLAG <>>
<SETG P-OFLAG <>>
<TELL <GET .MSG 1> "]" CR>
<RTRUE>>
" 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."
<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" (DRIVE1 <>) (DRIVE2 <>)
SYN LEN NUM OBJ PREP VERB X Y)
<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>>
<SET PREP <GET ,P-ITBL ,P-PREP1>>
<SET X <GETB .SYN ,P-SPREP1>>
<COND (<G? ,P-NCN .NUM>) ; "Added 4/27/83"
(<AND <NOT <L? .NUM 1>>
<ZERO? ,P-NCN>
<EQUAL? .PREP 0 .X>>
<SET DRIVE1 .SYN>)
(<EQUAL? .X <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>>
<SETG P-SYNTAX .SYN>
<SETG PRSA <GETB .SYN ,P-SACTION>>
<RTRUE>)>)>
<COND (<DLESS? LEN 1>
<COND (<OR <T? .DRIVE1>
<T? .DRIVE2>>
<RETURN>)>
<DONT-UNDERSTAND>
<RFALSE>)>
<SET SYN <REST .SYN ,P-SYNLEN>>>
<COND (<T? .DRIVE1>
<SET X <GETB .DRIVE1 ,P-SFWIM1>>
<SET Y <GETB .DRIVE1 ,P-SLOC1>>
<SET OBJ <GWIM .X .Y <GETB .DRIVE1 ,P-SPREP1>>>
<COND (<T? .OBJ>
<PUT ,P-PRSO ,P-MATCHLEN 1>
<PUT ,P-PRSO 1 .OBJ>
<SETG P-SYNTAX .DRIVE1>
<SETG PRSA <GETB .DRIVE1 ,P-SACTION>>
<RTRUE>)>)>
; <SET X <GETB .DRIVE1 ,P-SFWIM1>>
; <SET Y <GETB .DRIVE1 ,P-SLOC1>>
; <SET OBJ <GWIM .X .Y <GETB .DRIVE1 ,P-SPREP1>>>
; <COND (<AND <T? .DRIVE1>
<T? .OBJ>>
<PUT ,P-PRSO ,P-MATCHLEN 1>
<PUT ,P-PRSO 1 .OBJ>
<SETG P-SYNTAX .DRIVE1>
<SETG PRSA <GETB .DRIVE1 ,P-SACTION>>
<RTRUE>)>
; <SET OBJ <GWIM <GETB .DRIVE2 ,P-SFWIM2>
<GETB .DRIVE2 ,P-SLOC2>
<GETB .DRIVE2 ,P-SPREP2>>>
<COND (<T? .DRIVE2>
<SET X <GETB .DRIVE2 ,P-SFWIM2>>
<SET Y <GETB .DRIVE2 ,P-SLOC2>>
<SET OBJ <GWIM .X .Y <GETB .DRIVE2 ,P-SPREP2>>>
<COND (<T? .OBJ>
<PUT ,P-PRSI ,P-MATCHLEN 1>
<PUT ,P-PRSI 1 .OBJ>
<SETG P-SYNTAX .DRIVE2>
<SETG PRSA <GETB .DRIVE2 ,P-SACTION>>
<RTRUE>)>)
; (<AND <T? .DRIVE2>
<T? .OBJ>>
<PUT ,P-PRSI ,P-MATCHLEN 1>
<PUT ,P-PRSI 1 .OBJ>
<SETG P-SYNTAX .DRIVE2>
<SETG PRSA <GETB .DRIVE2 ,P-SACTION>>
<RTRUE>)
(<EQUAL? .VERB ,ACT?FIND ; ,ACT?WHAT>
<DO-IT-YOURSELF>
<RFALSE>)>
<COND (<EQUAL? ,WINNER ,PLAYER>
<ORPHAN .DRIVE1 .DRIVE2>
<TELL "[Wh">)
(T
<TELL
"[Your command wasn't complete. Next time, type wh">)>
<COND (<EQUAL? .VERB ,ACT?WALK ,ACT?GO>
<TELL "ere">)
(<OR <AND <T? .DRIVE1>
<EQUAL? <GETB .DRIVE1 ,P-SFWIM1> ,PERSON>>
<AND <T? .DRIVE2>
<EQUAL? <GETB .DRIVE2 ,P-SFWIM2> ,PERSON>>>
<TELL "om">)
(T
<TELL "at">)>
<COND (<EQUAL? ,WINNER ,PLAYER>
<TELL " do you want">)
(T
<TELL " you want " THE ,WINNER>)>
<TELL ,STO>
<VERB-PRINT>
<COND (<T? .DRIVE2>
<CLAUSE-PRINT ,P-NC1 ,P-NC1L>)>
<SETG P-END-ON-PREP <>>
<PREP-PRINT <COND (<T? .DRIVE1>
<GETB .DRIVE1 ,P-SPREP1>)
(T
<GETB .DRIVE2 ,P-SPREP2>)>>
<COND (<EQUAL? ,WINNER ,PLAYER>
<SETG P-OFLAG T>
<TELL "?]" CR>)
(T
<SETG P-OFLAG <>>
<TELL ".]" CR>)>
<RFALSE>>
<ROUTINE VERB-PRINT ("AUX" TMP X)
<SET TMP <GET ,P-ITBL ,P-VERBN>> ;"? ,P-OTBL?"
<COND (<ZERO? .TMP>
<TELL B ,W?TELL>)
(<ZERO? <GETB ,P-VTBL 2>>
<PRINTB <GET .TMP 0>>)
(T
<SET X <GETB .TMP 2>>
<WORD-PRINT .X <GETB .TMP 3>>
<PUTB ,P-VTBL 2 0>)>>
<ROUTINE ORPHAN (D1 D2)
<COND (<ZERO? ,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>>
; <SET CNT -1>
; <REPEAT ()
<COND (<IGRTR? CNT ,P-ITBLLEN>
<RETURN>)>
<PUT ,P-OTBL .CNT <GET ,P-ITBL .CNT>>>
<COPYT ,P-ITBL ,P-OTBL ,P-ITBLLEN>
<COND (<EQUAL? ,P-NCN 2>
<CLAUSE-COPY ,P-ITBL ,P-OTBL ,P-NC2 ,P-NC2L ,P-OCL2>)>
<COND (<NOT <L? ,P-NCN 1>>
<CLAUSE-COPY ,P-ITBL ,P-OTBL ,P-NC1 ,P-NC1L ,P-OCL1>)>
<COND (<T? .D1>
<PUT ,P-OTBL ,P-PREP1 <GETB .D1 ,P-SPREP1>>
<PUT ,P-OTBL ,P-NC1 1>)
(<T? .D2>
<PUT ,P-OTBL ,P-PREP2 <GETB .D2 ,P-SPREP2>>
<PUT ,P-OTBL ,P-NC2 1>)>
<RTRUE>>
<ROUTINE CLAUSE-PRINT (BPTR EPTR "OPT" (THE? T) "AUX" X)
<SET X <GET ,P-ITBL .BPTR>>
<BUFFER-PRINT .X <GET ,P-ITBL .EPTR> .THE?>
<RFALSE>>
<ROUTINE BUFFER-PRINT (BEG END CP
"AUX" (NOSP <>) WRD (FIRST?? T) (PN <>) LEN)
<REPEAT ()
<COND (<EQUAL? .BEG .END>
<RETURN>)>
<SET WRD <GET .BEG 0>>
<COND (<EQUAL? .WRD ,W?$BUZZ>)
(<EQUAL? .WRD ,W?COMMA>
<TELL ", ">)
(<T? .NOSP>
<SET NOSP <>>)
(T
<PRINTC ,SP>)>
<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>)>
<SET LEN <GET ,CAPS 0>>
<COND (<OR <EQUAL? .WRD ,W?PERIOD ,W?COMMA ,W?$BUZZ>
<AND <OR <WT? .WRD ,PS?BUZZ-WORD>
<WT? .WRD ,PS?PREPOSITION>>
<NOT <WT? .WRD ,PS?ADJECTIVE>>
<NOT <WT? .WRD ,PS?OBJECT>>>>
<SET NOSP T>)
(<EQUAL? .WRD ,W?ME>
<PRINT-TABLE ,CHARNAME>
<SET PN T>)
(<SET LEN <INTBL? .WRD <REST ,CAPS 2> .LEN>>
<CAPITALIZE .BEG>
<SET PN T>)
(T
<SET LEN <GETB .BEG 3>>
<COND (<AND <T? .FIRST??>
<ZERO? .PN>
<T? .CP>>
<TELL ,LTHE>)>
<COND (<OR <T? ,P-OFLAG>
<T? ,P-MERGED>>
<PRINTB .WRD>)
(<AND <EQUAL? .WRD ,W?IT>
<VISIBLE? ,P-IT-OBJECT>>
<TELL D ,P-IT-OBJECT>)
(<AND <EQUAL? .WRD ,W?HER>
<ZERO? .PN>>
<TELL D ,P-HER-OBJECT>)
(<AND <EQUAL? .WRD ,W?THEM>
<ZERO? .PN>>
<TELL D ,P-THEM-OBJECT>)
(<AND <EQUAL? .WRD ,W?HIM>
<ZERO? .PN>>
<TELL D ,P-HIM-OBJECT>)
(T
<WORD-PRINT <GETB .BEG 2> .LEN>)>
<SET FIRST?? <>>)>
<SET BEG <REST .BEG ,P-WORDLEN>>>>
<ROUTINE ADD-CAP? (WRD "AUX" X)
<SET X <GET ,CAPS 0>>
<COND (<SET X <INTBL? -1 <REST ,CAPS 2> .X>>
<PUT .X 0 .WRD>
<RTRUE>)>
<RFALSE>>
<ROUTINE CAPITALIZE (PTR)
<COND (<OR <T? ,P-OFLAG>
<T? ,P-MERGED>>
<PRINTB <GET .PTR 0>>)
(T
<PRINTC <- <GETB ,P-INBUF <GETB .PTR 3>> ,SP>>
<WORD-PRINT <- <GETB .PTR 2> 1> <+ <GETB .PTR 3> 1>>)>>
<ROUTINE PREP-PRINT (PREP "OPT" (SP? T) "AUX" WRD)
<COND (<AND <T? .PREP>
<ZERO? ,P-END-ON-PREP>>
<COND (<T? .SP?>
<TELL C ,SP>)>
<SET WRD <PREP-FIND .PREP>>
<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>)>>
"Old CLAUSE-COPY."
; <GLOBAL P-OCLAUSE:TABLE <ITABLE NONE 25>>
; <ROUTINE CLAUSE-COPY (SRC DEST SRCBEG SRCEND DESTBEG DESTEND
"OPT" (INSRT <>) "AUX" BEG END)
<SET BEG <GET .SRC .SRCBEG>>
<SET END <GET .SRC .SRCEND>>
<PUT .DEST .DESTBEG
<REST ,P-OCLAUSE
<+ <* <GET ,P-OCLAUSE ,P-MATCHLEN> ,P-LEXELEN> 2>>>
<REPEAT ()
<COND (<EQUAL? .BEG .END>
<PUT .DEST .DESTEND
<REST ,P-OCLAUSE
<+ 2 <* <GET ,P-OCLAUSE ,P-MATCHLEN> ,P-LEXELEN>>>>
<RETURN>)
(T
<COND (<AND <T? .INSRT>
<EQUAL? ,P-ANAM <GET .BEG 0>>>
<CLAUSE-ADD .INSRT>)>
<CLAUSE-ADD <GET .BEG 0>>)>
<SET BEG <REST .BEG ,P-WORDLEN>>>>
"Pointers used by CLAUSE-COPY (source/destination beginning/end pointers)."
; <CONSTANT CC-SBPTR 0>
; <CONSTANT CC-SEPTR 1>
; <CONSTANT CC-OCLAUSE 2>
; <GLOBAL P-CCTBL <TABLE 0 0 0 0 0>>
<ROUTINE CLAUSE-COPY (SRC DEST BB EE OCL "OPT" (INSRT <>)
"AUX" ; (FLG <>) BEG END OBEG CNT B E ; X)
<SET BEG <GET .SRC .BB>>
<SET END <GET .SRC .EE>>
<SET OBEG <GET .OCL ,P-MATCHLEN>>
; <COND (<AND <T? .INSRT>
<EQUAL? .BEG <REST .OCL 2>>>
<SET OBEG 0>
<SET FLG T>)>
<REPEAT ()
<COND (<EQUAL? .BEG .END>
<RETURN>)>
<COND (<AND <T? .INSRT>
<EQUAL? ,P-ANAM <GET .BEG 0>>>
; <SET B <GET ,P-ITBL ,P-NC1>>
; <SET E <GET ,P-ITBL ,P-NC1L>>
; <COND (<T? .FLG>
<REPEAT ()
<SET CNT 0>
<COND (<EQUAL? .INSRT T>
<PUT .BEG 0 <GET .B 0>>
<PUT .BEG 1 0>
<SET B <REST .B ,P-WORDLEN>>
<REPEAT ()
<COND (<EQUAL? .B .E>
<RETURN>)>
<SET B <REST .B ,P-WORDLEN>>
<SET CNT <+ .CNT 1>>>)
(T
<SET CNT 1>)>
<COND (<G? .CNT 0>
<SET X <* .CNT 2>>
<PUT .OCL ,P-MATCHLEN
<+ <GET .OCL ,P-MATCHLEN> .X>>
<COND (<AND <NOT <EQUAL? .BEG .END>>
<NOT <EQUAL?
<REST .BEG ,P-WORDLEN>
.END>>>
<SET B <BACK .END ,P-WORDLEN>>
<SET E <REST .END <* <- .CNT 1>
,P-WORDLEN>>>
<REPEAT ()
<PUT .E 0 <GET .B 0>>
<PUT .E 1 <GET .B 1>>
<COND (<EQUAL? .B .BEG>
<RETURN>)>
<SET B <BACK .B ,P-WORDLEN>>
<SET E <BACK .E ,P-WORDLEN>>
<COND (<EQUAL? .B .BEG>
<RETURN>)>>)>
<SET END <REST .END <* .CNT ,P-WORDLEN>>>
<SET B <GET ,P-ITBL ,P-NC1>>
<SET E <GET ,P-ITBL ,P-NC1L>>
<COND (<EQUAL? .INSRT T>
<SET B <REST .B ,P-WORDLEN>>
<SET BEG <REST .BEG ,P-WORDLEN>>
<REPEAT ()
<COND (<EQUAL? .B .E>
<RETURN>)>
<PUT .BEG 0 <GET .B 0>>
<PUT .BEG 1 0>
<SET B <REST .B ,P-WORDLEN>>
<SET BEG <REST .BEG ,P-WORDLEN>>>)
(T
<PUT .BEG ,P-LEXELEN ,P-ANAM>
<PUT .BEG <+ ,P-LEXELEN 1> 0>
<PUT .BEG 0 .INSRT>
<PUT .BEG 1 0>)>)>>
<RETURN>)
(<EQUAL? .INSRT T>
<REPEAT ()
<COND (<EQUAL? .B .E>
<RETURN>)>
<CLAUSE-ADD <GET .B 0> .OCL>
<SET B <REST .B ,P-WORDLEN>>>)
(T
<COND (<NOT <EQUAL? .INSRT <GET .OCL 1>>>
<CLAUSE-ADD .INSRT .OCL>)>
<CLAUSE-ADD ,P-ANAM .OCL>)>
<COND (<EQUAL? .INSRT T>
<SET B <GET ,P-ITBL ,P-NC1>>
<SET E <GET ,P-ITBL ,P-NC1L>>
<REPEAT ()
<COND (<EQUAL? .B .E>
<RETURN>)>
<CLAUSE-ADD <GET .B 0> .OCL>
<SET B <REST .B ,P-WORDLEN>>>)
(T
<COND (<NOT <EQUAL? .INSRT <GET .OCL 1>>>
<CLAUSE-ADD .INSRT .OCL>)>
<CLAUSE-ADD ,P-ANAM .OCL>)>)
; (<ZERO? .FLG>
<CLAUSE-ADD <ZGET .BEG 0> .OCL>)
(T
<CLAUSE-ADD <GET .BEG 0> .OCL>)>
<SET BEG <REST .BEG ,P-WORDLEN>>>
<SET CNT <- <GET .OCL ,P-MATCHLEN> .OBEG>>
<COND (<AND ;<EQUAL? .SRC .DEST>
; <ZERO? .FLG>
<G? .OBEG 0>
<T? .CNT>>
<PUT .OCL ,P-MATCHLEN 0>
<SET OBEG <+ .OBEG 1>>
<REPEAT ()
<CLAUSE-ADD <GET .OCL .OBEG> .OCL>
<SET CNT <- .CNT 2>>
<COND (<ZERO? .CNT>
<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>>>
<RTRUE>>
; <ROUTINE CLAUSE-ADD (WRD TBL "AUX" PTR)
<SET PTR <+ <GET .TBL ,P-MATCHLEN> 2>>
<PUT .TBL <- .PTR 1> .WRD>
<PUT .TBL .PTR 0>
<PUT .TBL ,P-MATCHLEN .PTR>
<RFALSE>>
<ROUTINE CLAUSE-ADD (WRD TBL "AUX" PTR)
<SET PTR <GET .TBL ,P-MATCHLEN>>
<INC PTR>
<PUT .TBL .PTR .WRD>
<INC PTR>
<PUT .TBL .PTR 0>
<PUT .TBL ,P-MATCHLEN .PTR>
<RFALSE>>
<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 GWIM (GBIT LBIT PREP "AUX" (OBJ <>))
<COND (<EQUAL? .GBIT ,LOCATION>
<RETURN ,ROOMS>)
(<AND <NOT <EQUAL? ,P-IT-OBJECT <> ,NOT-HERE-OBJECT>>
<IS? ,P-IT-OBJECT .GBIT>>
<COND (<AND <EQUAL? .GBIT ,TAKEABLE>
<IN? ,P-IT-OBJECT ,PLAYER>>)
(T
<SET OBJ ,P-IT-OBJECT>)>)
(<AND <NOT <EQUAL? ,P-HIM-OBJECT <> ,NOT-HERE-OBJECT>>
<IS? ,P-HIM-OBJECT .GBIT>>
<SET OBJ ,P-HIM-OBJECT>)
(<AND <NOT <EQUAL? ,P-HER-OBJECT <> ,NOT-HERE-OBJECT>>
<IS? ,P-HER-OBJECT .GBIT>>
<SET OBJ ,P-HER-OBJECT>)
(<AND <NOT <EQUAL? ,P-THEM-OBJECT <> ,NOT-HERE-OBJECT>>
<IS? ,P-THEM-OBJECT .GBIT>>
<SET OBJ ,P-THEM-OBJECT>)>
<COND (<T? .OBJ>
<TELL "[" THE .OBJ ,BRACKET>
<RETURN .OBJ>)>
<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>>
<COND (<AND <EQUAL? ,WINNER ,PLAYER>
<NOT <EQUAL? .OBJ ,HANDS>>>
<TELL "[">
<COND (<PREP-PRINT .PREP <>>
<PRINTC ,SP>)>
<TELL THE .OBJ ,BRACKET>)>
<RETURN .OBJ>)>
<RFALSE>)
(<EQUAL? .GBIT ,WIELDED>
<SETG P-GWIMBIT 0>
<RETURN ,HANDS>)
(T
<SETG P-GWIMBIT 0>
<RFALSE>)>>
<ROUTINE SNARF-OBJECTS ("AUX" PTR)
<SET PTR <GET ,P-ITBL ,P-NC1>>
<COND (<T? .PTR>
<SETG P-PHR 0>
<SETG P-SLOCBITS <GETB ,P-SYNTAX ,P-SLOC1>>
<COND (<NOT <SNARFEM .PTR <GET ,P-ITBL ,P-NC1L> ,P-PRSO>>
<RFALSE>)>
<COND (<GET ,P-BUTS ,P-MATCHLEN>
<SETG P-PRSO <BUT-MERGE ,P-PRSO>>)>)>
<SET PTR <GET ,P-ITBL ,P-NC2>>
<COND (<T? .PTR>
<SETG P-PHR 1>
<SETG P-SLOCBITS <GETB ,P-SYNTAX ,P-SLOC2>>
<COND (<NOT <SNARFEM .PTR <GET ,P-ITBL ,P-NC2L> ,P-PRSI>>
<RFALSE>)>
<COND (<GET ,P-BUTS ,P-MATCHLEN>
<COND (<EQUAL? <GET ,P-PRSI ,P-MATCHLEN> 1>
<SETG P-PRSO <BUT-MERGE ,P-PRSO>>
<RTRUE>)>
<SETG P-PRSI <BUT-MERGE ,P-PRSI>>)>)>
<RTRUE>>
<ROUTINE BUT-MERGE (TBL "AUX" LEN BUTLEN (CNT 1) (MATCHES 0) OBJ NTBL X)
<SET LEN <GET .TBL ,P-MATCHLEN>>
<PUT ,P-MERGE ,P-MATCHLEN 0>
<REPEAT ()
<COND (<DLESS? LEN 0>
<RETURN>)>
<SET OBJ <GET .TBL .CNT>>
<SET X <REST ,P-BUTS 2>>
<COND (<NOT <SET X <INTBL? .OBJ .X <GET ,P-BUTS 0>>>>
; <PUT ,P-MERGE <+ .MATCHES 1> .OBJ>
; <SET MATCHES <+ .MATCHES 1>>
<INC MATCHES>
<PUT ,P-MERGE .MATCHES .OBJ>)>
<INC CNT>>
<PUT ,P-MERGE ,P-MATCHLEN .MATCHES>
<SET NTBL ,P-MERGE>
<SETG P-MERGE .TBL>
<RETURN .NTBL>>
"Grabs the first adjective, unless it comes across a special-cased adjective."
; <ROUTINE ADJ-CHECK (WRD ADJ "OPT" (NW <>))
<COND (<ZERO? .ADJ>
<RTRUE>)
(<ZMEMQ .WRD ,CHAR-POSS-TABLE>
<RTRUE>)>>
<ROUTINE SNARFEM (PTR EPTR TBL "AUX" (BUT <>) LEN WV WRD NW (WAS-ALL? <>)
ONEOBJ)
;"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 (<T? .WAS-ALL?>
<SETG P-GETFLAGS ,P-ALL>)>
<RETURN .WV>)
(T
<COND (<EQUAL? .EPTR <REST .PTR ,P-WORDLEN>>
<SET NW 0>)
(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>
<COND (<NOT <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 (<ZERO? ,P-ADJ>
<SETG P-GETFLAGS ,P-ONE>
<COND (<EQUAL? .NW ,W?OF>
<SET PTR <REST .PTR ,P-WORDLEN>>)>)
(T
<SETG P-NAM .ONEOBJ>
<COND (<NOT <GET-OBJECT <OR .BUT .TBL>>>
<RFALSE>)>
<COND (<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>
<COND (<NOT <GET-OBJECT <OR .BUT .TBL>>>
<RFALSE>)>)
(<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 <WT? .WRD ,PS?ADJECTIVE>
<ZERO? ,P-ADJ>
<NOT <EQUAL? .NW ,W?OF>>> ; "FIX #41"
<SETG P-ADJ .WRD>)
(<WT? .WRD ,PS?OBJECT ;,P1?OBJECT>
<SETG P-NAM .WRD>
<SET 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 "OPT" (VRB T)
"AUX" (GCHECK <>) (OLEN 0)
BTS LEN XBITS TLEN OBJ ADJ X XTBL
TTBL TOBJ)
<SET XBITS ,P-SLOCBITS>
<SET TLEN <GET .TBL ,P-MATCHLEN>>
<COND (<BTST ,P-GETFLAGS ,P-INHIBIT>
<RTRUE>)>
<SET ADJ ,P-ADJ>
<COND (<AND <ZERO? ,P-NAM>
<T? ,P-ADJ>>
<COND (<WT? ,P-ADJ ,PS?OBJECT>
<SETG P-NAM ,P-ADJ>
<SETG P-ADJ <>>)
(<SET BTS <WT? ,P-ADJ ,PS?DIRECTION ,P1?DIRECTION>>
<SETG P-ADJ <>>
<PUT .TBL ,P-MATCHLEN 1>
<PUT .TBL 1 ,INTDIR>
<SETG P-DIRECTION .BTS>
<RTRUE>)>)>
<COND (<AND <ZERO? ,P-NAM>
<ZERO? ,P-ADJ>
<NOT <EQUAL? ,P-GETFLAGS ,P-ALL>>
<ZERO? ,P-GWIMBIT>>
<COND (<T? .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 (<T? .GCHECK>
<GLOBAL-CHECK .TBL>)
(T
<DO-SL ,HERE ,SOG ,SIR>
<DO-SL ,WINNER ,SH ,SC>)>
<SET LEN <- <GET .TBL ,P-MATCHLEN> .TLEN>>
<COND (<BTST ,P-GETFLAGS ,P-ALL>)
(<AND <T? .LEN>
<BTST ,P-GETFLAGS ,P-ONE>>
<COND (<G? .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
<PUT ,P-NAMW ,P-PHR ,P-NAM>
<PUT ,P-ADJW ,P-PHR ,P-ADJ>
<COND (<ZERO? .LEN>
<SET LEN .OLEN>)>
<COND (<AND <T? ,P-NAM>
<SET OBJ <GET .TBL <+ .TLEN 1>>>>
<SET TTBL <REST .TBL <* .TLEN 2>>>
<SET TOBJ <GET .TTBL 0>>
<PUT .TTBL 0 .LEN>
<SET OBJ <APPLY <GETP .OBJ ,P?GENERIC> .TTBL>>
<PUT .TTBL 0 .TOBJ>
<COND (<T? .OBJ>
<COND (<EQUAL? .OBJ ,NOT-HERE-OBJECT>
<RFALSE>)>
<SET X <+ .TLEN 1>>
<PUT .TBL .X ; <+ .TLEN 1> .OBJ>
<PUT .TBL ,P-MATCHLEN .X ; <+ .TLEN 1>>
<SETG P-NAM <>>
<SETG P-ADJ <>>
<RTRUE>)>)>
<COND (<AND <T? .VRB>
<NOT <EQUAL? ,WINNER ,PLAYER>>>
<DONT-UNDERSTAND>
<RFALSE>)
(<AND <T? .VRB>
<T? ,P-NAM>>
<SET XTBL ,P-OCL2>
<COND (<EQUAL? .TBL ,P-PRSO>
<SET XTBL ,P-OCL1>)>
<COND (<VERB? NAME>
<MORE-SPECIFIC>)
(<G? <GET .XTBL 0> 22>
<PUT .XTBL 0 0>
<NYMPH-APPEARS>
<TELL
"Parser overflow! Please try something else">
<PRINT
". Bye!\"| She disappears with a wink.|">)
(T
<WHICH-PRINT .TLEN .LEN .TBL>
<SETG P-ACLAUSE ,P-NC2>
<COND (<EQUAL? .TBL ,P-PRSO>
<SETG P-ACLAUSE ,P-NC1>)>
<SETG P-ANAM ,P-NAM>
<ORPHAN <> <>>
<SETG P-OFLAG T>)>)
(<T? .VRB>
<NOT-IN-SENTENCE "enough nouns">)>
<SETG P-NAM <>>
<SETG P-ADJ <>>
<RFALSE>)>)
(<T? ,P-OFLAG>
<RFALSE>)
(<AND <ZERO? .LEN>
<T? .GCHECK>>
<PUT ,P-NAMW ,P-PHR ,P-NAM>
<PUT ,P-ADJW ,P-PHR ,P-ADJ>
<COND (<T? .VRB>
<SETG P-SLOCBITS .XBITS> ; "RETROFIX #33"
<OBJ-FOUND ,NOT-HERE-OBJECT .TBL>
<SETG P-XNAM ,P-NAM>
<SETG P-NAM <>>
<SETG P-XADJ ,P-ADJ>
<SETG P-ADJ <>>
<COND (<ZERO? ,LIT?>
<TOO-DARK>)>
<RTRUE>)>
<SETG P-NAM <>>
<SETG P-ADJ <>>
<RFALSE>)
(<ZERO? .LEN>
<SET GCHECK T>
<AGAIN>)>
<SET X <GET .TBL <+ .TLEN 1>>>
<COND (<AND <T? ,P-ADJ>
<ZERO? ,P-NAM>
<T? .X>>
<TELL "[" THE .X ,BRACKET>)>
<SETG P-SLOCBITS .XBITS>
<PUT ,P-NAMW ,P-PHR ,P-NAM>
<PUT ,P-ADJW ,P-PHR ,P-ADJ>
<SETG P-NAM <>>
<SETG P-ADJ <>>
<RTRUE>>>
<GLOBAL P-MOBY-FOUND <>>
; <GLOBAL P-MOBY-FLAG <>> ; "Needed only for ZIL"
"This MOBY-FIND works in ZIP only!"
<CONSTANT LAST-OBJECT:OBJECT 0>
<ROUTINE MOBY-FIND (TBL "AUX" OBJ LEN NAM ADJ X)
<SET OBJ 1>
<SET NAM ,P-NAM>
<SET ADJ ,P-ADJ>
<SETG P-NAM ,P-XNAM>
<SETG P-ADJ ,P-XADJ>
<PUT .TBL ,P-MATCHLEN 0>
<REPEAT ()
<COND (<AND <NOT <IN? .OBJ ,ROOMS>>
<THIS-IT? .OBJ>>
<OBJ-FOUND .OBJ .TBL>)>
<COND (<IGRTR? OBJ ,LAST-OBJECT>
<RETURN>)>>
<SET LEN <GET .TBL ,P-MATCHLEN>>
<COND (<EQUAL? .LEN 1>
<SETG P-MOBY-FOUND <GET .TBL 1>>)>
<SETG P-NAM .NAM>
<SETG P-ADJ .ADJ>
<RETURN .LEN>>
"This MOBY-FIND works in both ZIL and ZIP."
; <ROUTINE MOBY-FIND (TBL "AUX" (OBJ 1) LEN FOO NAM ADJ)
<SET NAM ,P-NAM>
<SET ADJ ,P-ADJ>
<SETG P-NAM ,P-XNAM>
<SETG P-ADJ ,P-XADJ>
; <COND (<T? ,DEBUG>
<TELL "[MOBY-FIND called, P-NAM = " B ,P-NAM "]" CR>)>
<PUT .TBL ,P-MATCHLEN 0>
%<COND (<GASSIGNED? ZILCH> ; "ZIP case"
'<PROG ()
<REPEAT ()
<COND (<AND ; <SET FOO <META-LOC .OBJ T>>
<NOT <IN? .OBJ ,ROOMS>>
<SET FOO <THIS-IT? .OBJ>>>
<SET FOO <OBJ-FOUND .OBJ .TBL>>)>
<COND (<IGRTR? OBJ ,LAST-OBJECT>
<RETURN>)>>>)
(T ;"ZIL case"
'<PROG ()
<SETG P-SLOCBITS -1>
<COND (<SET FOO <FIRST? ,ROOMS>>
<REPEAT ()
<SEARCH-LIST .FOO .TBL ,P-SRCALL T>
<COND (<NOT <SET FOO <NEXT? .FOO>>>
<RETURN>)>>)>
<DO-SL ,LOCAL-GLOBALS 1 1 .TBL T>
<SEARCH-LIST ,ROOMS .TBL ,P-SRCTOP T>>)>
<COND (<EQUAL? <SET LEN <GET .TBL ,P-MATCHLEN>> 1>
<SETG P-MOBY-FOUND <GET .TBL 1>>)>
<SETG P-NAM .NAM>
<SETG P-ADJ .ADJ>
<RETURN .LEN>>
<GLOBAL WHICH-PRINTING:FLAG <>>
<ROUTINE WHICH-PRINT (TLEN LEN TBL "AUX" OBJ RLEN)
<SET RLEN .LEN>
<TELL "[Which">
<COND (<OR <T? ,P-OFLAG>
<T? ,P-MERGED>
<T? ,P-AND>>
<PRINTC ,SP>
<COND (<T? ,P-LASTADJ>
<TELL B ,P-LASTADJ C ,SP>)>
<PRINTB ,P-NAM>)
(<EQUAL? .TBL ,P-PRSO>
<CLAUSE-PRINT ,P-NC1 ,P-NC1L <>>)
(T
<CLAUSE-PRINT ,P-NC2 ,P-NC2L <>>)>
<TELL " do you mean,">
<SETG WHICH-PRINTING T>
<REPEAT ()
<INC TLEN>
<SET OBJ <GET .TBL .TLEN>>
<TELL C ,SP THE .OBJ>
<COND (<EQUAL? .LEN 2>
<COND (<NOT <EQUAL? .RLEN 2>>
<TELL ",">)>
<TELL " or">)
(<G? .LEN 2>
<TELL ",">)>
<COND (<DLESS? LEN 1>
<RETURN>)>>
<SETG WHICH-PRINTING <>>
<TELL "?]" CR>
<RTRUE>>
<GLOBAL LAST-PSEUDO-LOC:OBJECT <>>
<GLOBAL P-PNAM <>>
<GLOBAL P-PADJN <>>
<GLOBAL PSEUDO-PRSO?:FLAG <>> "T if original PRSO was PSEUDO-OBJECT."
<OBJECT PSEUDO-OBJECT
(LOC GLOBAL-OBJECTS)
(DESC "that")
(SDESC DESCRIBE-PSEUDO-OBJECT)
(FLAGS NODESC NOARTICLE NOALL)
(ACTION ME-F)>
<ROUTINE DESCRIBE-PSEUDO-OBJECT (OBJ)
<COND (<AND <T? ,P-PNAM>
<HERE? LAST-PSEUDO-LOC>>
<PRINTB ,P-PNAM>
<RTRUE>)>
<PRINTD ,PSEUDO-OBJECT>
<RTRUE>>
<ROUTINE GLOBAL-CHECK (TBL "AUX" LEN RMG RMGL (CNT 0) OBJ OBITS X)
<SET LEN <GET .TBL ,P-MATCHLEN>>
<SET OBITS ,P-SLOCBITS>
<SET RMG <GETPT ,HERE ,P?GLOBAL>>
<COND (<T? .RMG>
<SET RMGL <RMGL-SIZE .RMG>>
<REPEAT ()
<SET OBJ <GET/B .RMG .CNT>>
<COND (<SET X <FIRST? .OBJ>>
<SEARCH-LIST .OBJ .TBL ,P-SRCALL>)>
<COND (<THIS-IT? .OBJ>
<OBJ-FOUND .OBJ .TBL>)>
<COND (<IGRTR? CNT .RMGL>
<RETURN>)>>)>
<SET RMG <GETP ,HERE ,P?THINGS>>
<COND (<T? .RMG>
<SET RMGL <GET .RMG 0>>
<SET CNT 0>
<REPEAT ()
<COND (<AND <EQUAL? ,P-NAM <GET .RMG <+ .CNT 1>>>
<OR <ZERO? ,P-ADJ>
<EQUAL? ,P-ADJ ; ,P-ADJN
<GET .RMG <+ .CNT 2>>>>>
<SETG P-PNAM ,P-NAM>
<COND (<T? ,P-ADJ>
<SETG P-PADJN ,P-ADJ ; ,P-ADJN>)
(T
<SETG P-PADJN <>>)>
<SETG LAST-PSEUDO-LOC ,HERE>
<UNMAKE ,PSEUDO-OBJECT ,NOARTICLE>
<PUTP ,PSEUDO-OBJECT
,P?ACTION
<GET .RMG <+ .CNT 3>>>
; <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 3>>
<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 (<ZERO? <GET .TBL ,P-MATCHLEN>>
<COND (<VERB? EXAMINE LOOK-ON LOOK-INSIDE FIND FOLLOW
LEAVE SEARCH SMELL WALK-TO THROUGH
WAIT-FOR>
<DO-SL ,ROOMS 1 1>)>)>)>>
<CONSTANT P-SRCTOP 0>
<CONSTANT P-SRCALL 1>
<CONSTANT P-SRCBOT 2>
<ROUTINE DO-SL (OBJ BIT1 BIT2)
<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" X)
<COND (<SET OBJ <FIRST? .OBJ>>
<REPEAT ()
<COND (<AND <NOT <EQUAL? .LVL ,P-SRCBOT>>
<THIS-IT? .OBJ>>
<OBJ-FOUND .OBJ .TBL>)>
<COND (<AND ; <NOT <EQUAL? .LVL ,P-SRCTOP>>
<NOT <EQUAL? .OBJ ,WINNER ,LOCAL-GLOBALS
,GLOBAL-OBJECTS>>
<SET X <FIRST? .OBJ>>
<SEE-INSIDE? .OBJ>
; <SEE-ANYTHING-IN? .OBJ>>
<SET X ,P-SRCTOP>
<COND (<IS? .OBJ ,SURFACE>
<SET X ,P-SRCALL>)>
<SEARCH-LIST .OBJ .TBL .X>)>
<COND (<NOT <SET OBJ <NEXT? .OBJ>>>
<RETURN>)>>)>
<RFALSE>>
<ROUTINE THIS-IT? (OBJ "AUX" TBL LEN)
<COND (<AND <T? ,P-NAM>
<OR <NOT <SET TBL <GETPT .OBJ ,P?SYNONYM>>>
<NOT <SET LEN </ <PTSIZE .TBL> 2>>>
<NOT <SET LEN <INTBL? ,P-NAM .TBL .LEN>>>>>
<RFALSE>)
(<AND <T? ,P-ADJ>
<OR <NOT <SET TBL <GETPT .OBJ ,P?ADJECTIVE>>>
<NOT <SET LEN </ <PTSIZE .TBL> 2>>>
<NOT <SET LEN <INTBL? ,P-ADJ .TBL .LEN>>>>>
<RFALSE>)
(<AND <T? ,P-GWIMBIT>
<NOT <IS? .OBJ ,P-GWIMBIT>>>
<RFALSE>)
(T
<RTRUE>)>>
<ROUTINE OBJ-FOUND (OBJ TBL "AUX" PTR)
<SET PTR <GET .TBL ,P-MATCHLEN>>
<INC PTR>
<PUT .TBL .PTR .OBJ>
<PUT .TBL ,P-MATCHLEN .PTR>
<RFALSE>>
; <ROUTINE TAKE-CHECK ()
<COND (<AND <ITAKE-CHECK ,P-PRSO <GETB ,P-SYNTAX ,P-SLOC1>>
<ITAKE-CHECK ,P-PRSI <GETB ,P-SYNTAX ,P-SLOC2>>>
<RTRUE>)
(T
<RFALSE>)>>
<ROUTINE ITAKE-CHECK (TBL BITS "AUX" PTR LEN OBJ L GOT-IT TOOK-IT)
<SET PTR 1>
<SET LEN <GET .TBL ,P-MATCHLEN>>
<COND (<ZERO? .LEN>
<RTRUE>)
(<OR <BTST .BITS ,SHAVE>
<BTST .BITS ,STAKE>>
<REPEAT ()
<SET OBJ <GET .TBL .PTR>>
<COND (<EQUAL? .OBJ ,IT>
<COND (<NOT <ACCESSIBLE? ,P-IT-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)>
<SET OBJ ,P-IT-OBJECT>)
(<EQUAL? .OBJ ,THEM>
<COND (<NOT <ACCESSIBLE? ,P-THEM-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)>
<SET OBJ ,P-THEM-OBJECT>)
(<EQUAL? .OBJ ,HER>
<COND (<NOT <ACCESSIBLE? ,P-HER-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)>
<SET OBJ ,P-HER-OBJECT>)
(<EQUAL? .OBJ ,HIM>
<COND (<NOT <ACCESSIBLE? ,P-HIM-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)>
<SET OBJ ,P-HIM-OBJECT>)>
<COND (<AND <NOT <EQUAL? .OBJ ,WINNER ,HANDS ,FEET>>
<NOT <EQUAL? .OBJ ,ME ,YOU ,ROOMS>>
<NOT <EQUAL? .OBJ ,INTDIR ,RIGHT ,LEFT>>
<NOT <EQUAL? .OBJ ,MONEY>>
<NOT <HELD? .OBJ>>
; <NOT <IN? .OBJ ,WINNER>>>
<SETG PRSO .OBJ>
<SET L <LOC .OBJ>>
<SET GOT-IT 0>
<SET TOOK-IT 0>
<COND (<ZERO? .L>)
(<AND <IS? .OBJ ,TRYTAKE>
<NOT <IS? .OBJ ,TAKEABLE>>>
<COND (<AND <BTST .BITS ,SHAVE>
<IN? .L ,WINNER>>
<INC GOT-IT>)>)
; (<NOT <EQUAL? ,WINNER ,PLAYER>>)
(<AND <ZERO? ,P-MULT?>
; <BTST .BITS ,STAKE>
<IN? .L ,WINNER>
; <OR <IN? .L ,WINNER>
<IN? ,WINNER .L>>
<ITAKE <>>>
<INC GOT-IT>
<INC TOOK-IT>)
(<AND <EQUAL? .L ,WINNER>
<BTST .BITS ,SHAVE>>
<INC GOT-IT>)>
<COND (<AND <ZERO? .GOT-IT>
<BTST .BITS ,SHAVE>>
<WINNER-NOT-HOLDING>
<COND (<AND <EQUAL? .LEN .PTR>
<T? ,P-MULT?>>
<TELL "all of those things">)
(<EQUAL? .OBJ ,NOT-HERE-OBJECT>
<THIS-IS-IT .OBJ>
<TELL D .OBJ>)
(T
<THIS-IS-IT .OBJ>
<COND (<IS? .OBJ ,PLURAL>
<TELL "any ">)
(<NOT <IS? .OBJ ,NOARTICLE>>
<COND (<IS? .OBJ ,PROPER>
<TELL ,LTHE>)
(<IS? .OBJ ,VOWEL>
<TELL "an ">)
(T
<TELL "a ">)>)>
<TELL D .OBJ>)>
<PRINT ,PERIOD>
<RFALSE>)
(<AND <T? .GOT-IT>
<T? .TOOK-IT>
; <BTST .BITS ,STAKE>
<EQUAL? ,WINNER ,PLAYER>>
<TAKING-OBJ-FIRST .OBJ>)>)>
<COND (<IGRTR? PTR .LEN>
<RTRUE>)>>)>
<RTRUE>>
<ROUTINE HELD? ("OPT" (OBJ ,PRSO) "AUX" L)
<COND (<ZERO? .OBJ>
<RFALSE>)
(<IS? .OBJ ,TAKEABLE>)
(<NOT <IS? .OBJ ,TRYTAKE>>
<RFALSE>)>
<SET L <LOC .OBJ>>
<COND (<EQUAL? .L <> ,ROOMS ,GLOBAL-OBJECTS>
<RFALSE>)
(<EQUAL? .L ,WINNER>
<RTRUE>)>
<RETURN <HELD? .L>>>
<ROUTINE TAKING-OBJ-FIRST (OBJ "AUX" L)
<SET L <LOC .OBJ>>
<TELL "[taking " THE .OBJ>
<COND (<NOT <EQUAL? .L ,HERE <LOC ,WINNER> <>>>
<OUT-OF-LOC .L>)>
<TELL " first" ,BRACKET>
<SPARK? <> .OBJ>
<RFALSE>>
; <ROUTINE ITAKE-CHECK (TBL BITS "AUX" PTR OBJ TAKEN L)
<SET PTR <GET .TBL ,P-MATCHLEN>>
<COND (<AND <T? .PTR>
<OR <BTST .BITS ,SHAVE>
<BTST .BITS ,STAKE>>>
<REPEAT ()
<COND (<DLESS? PTR 0>
<RETURN>)>
; <COND (<L? <DEC PTR> 0>
<RETURN>)>
<SET OBJ <GET .TBL <+ .PTR 1>>>
<COND (<EQUAL? .OBJ ,IT>
<COND (<NOT <ACCESSIBLE? ,P-IT-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)
(T
<SET OBJ ,P-IT-OBJECT>)>)
(<EQUAL? .OBJ ,HER>
<COND (<NOT <ACCESSIBLE? ,P-HER-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)
(T
<SET OBJ ,P-HER-OBJECT>)>)
(<EQUAL? .OBJ ,HIM>
<COND (<NOT <ACCESSIBLE? ,P-HIM-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)
(T
<SET OBJ ,P-HIM-OBJECT>)>)
(<EQUAL? .OBJ ,THEM>
<COND (<NOT <ACCESSIBLE? ,P-THEM-OBJECT>>
<MORE-SPECIFIC>
<RFALSE>)
(T
<SET OBJ ,P-THEM-OBJECT>)>)>
<COND (<AND <NOT <HELD? .OBJ>>
<NOT <EQUAL? .OBJ ,HANDS ,FEET>>>
<SETG PRSO .OBJ>
<SET L <LOC .OBJ>>
<COND (<ZERO? .L>
<SET TAKEN T>)
(<AND <IS? .OBJ ,TRYTAKE>
<NOT <IS? .OBJ ,TAKEABLE>>>
<SET TAKEN T>)
(<NOT <EQUAL? ,WINNER ,PLAYER>>
<SET TAKEN <>>)
(<AND <BTST .BITS ,STAKE>
<IN? .L ,WINNER>
<ZERO? ,P-MULT?>
<ITAKE <>>>
<SET TAKEN <>>)
(<AND <BTST .BITS ,SHAVE>
<EQUAL? .L ,WINNER>>
<SET TAKEN <>>)
(T
<SET TAKEN T>)>
<COND (<AND <T? .TAKEN>
<BTST .BITS ,SHAVE>>
<WINNER-NOT-HOLDING>
<COND (<L? 1 <GET .TBL ,P-MATCHLEN>>
<TELL "all of those things">)
(<EQUAL? .OBJ ,NOT-HERE-OBJECT>
<TELL D ,NOT-HERE-OBJECT>)
(T
<THIS-IS-IT .OBJ>
<COND (<IS? .OBJ ,PLURAL>
<TELL "any ">)
(<NOT <IS? .OBJ ,NOARTICLE>>
<TELL ,LTHE>)>
<TELL D .OBJ>)>
<PRINT ,PERIOD>
<RFALSE>)
(<AND <ZERO? .TAKEN>
<EQUAL? ,WINNER ,PLAYER>>
<TELL "[taking " THEO>
<COND (<T? .L>
<OUT-OF-LOC .L>)>
<TELL " first" ,BRACKET>
<SPARK? <>>)>)>>)
(T
<RTRUE>)>>
<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 (<T? .LOSS>
<PRINTC %<ASCII !\[>>
<TELL ,CANT "refer to more than one object at a time with \"">
<SET TMP <GET ,P-ITBL ,P-VERBN>>
<COND (<ZERO? .TMP>
<TELL B ,W?TELL>)
(<OR <T? ,P-OFLAG>
<T? ,P-MERGED>>
<PRINTB <GET .TMP 0>>)
(T
<WORD-PRINT <GETB .TMP 2> <GETB .TMP 3>>)>
<TELL ".\"]" CR>
<RFALSE>)
(T
<RTRUE>)>>
<ROUTINE SAY-IF-HERE-LIT ()
<SETG LIT? <IS-LIT?>>
<COND (<ZERO? ,LIT?>
<SETG P-CONT <>>
<SETG OLD-HERE <>>
<SETG P-WALK-DIR <>>
<RELOOK T>)>
<RTRUE>>
<ROUTINE LIGHT-ROOM-WITH (SOURCE)
<MAKE .SOURCE ,LIGHTED>
<REPLACE-ADJ? .SOURCE ,W?DARK ,W?LIGHTED>
<COND (<T? ,LIT?>
<RFALSE>)
(<VISIBLE? .SOURCE>
<SETG LIT? T>
<SETG P-CONT <>>
<SETG OLD-HERE <>>
<CRLF>
<V-LOOK>
<RTRUE>)
(T
<RFALSE>)>>
<ROUTINE IS-LIT? ("OPT" (RM ,HERE) (RMBIT T) "AUX" (LIT 0) OHERE)
<COND (<AND <T? ,ALWAYS-LIT?>
<EQUAL? ,WINNER ,PLAYER>>
<RTRUE>)>
<SETG P-GWIMBIT ,LIGHTED>
<SET OHERE ,HERE>
<SETG HERE .RM>
<COND (<AND <T? .RMBIT>
<IS? .RM ,LIGHTED>>
<INC LIT>)
(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>)>)>
<DO-SL .RM 1 1>
<COND (<G? <GET ,P-TABLE ,P-MATCHLEN> 0>
<INC LIT>)>)>
<SETG HERE .OHERE>
<SETG P-GWIMBIT 0>
<RETURN .LIT>>
<ROUTINE DONT-HAVE? ("OPT" (OBJ ,PRSO) "AUX" L O)
<SET L <LOC .OBJ>>
<COND (<ZERO? .L>)
(<EQUAL? .L ,WINNER>
<RFALSE>)
(<AND <IN? .L ,PLAYER>
<EQUAL? ,WINNER ,PLAYER>>
<SET O ,PRSO>
<SETG PRSO .OBJ>
<COND (<ITAKE <>>
<TELL "[taking " THEO>
<OUT-OF-LOC .L>
<TELL " first" ,BRACKET>
<SPARK? <>>
<SETG PRSO .O>
<THIS-IS-IT ,PRSO>
<RFALSE>)>
<SETG PRSO .O>
<TAKE-FIRST .OBJ .L>
<RTRUE>)>
<WINNER-NOT-HOLDING>
<COND (<T? .OBJ>
<COND (<IS? .OBJ ,PLURAL>
<TELL "any ">)>
<TELL THE .OBJ>)
(T
<TELL D ,NOT-HERE-OBJECT>)>
<PRINT ,PERIOD>
<RTRUE>>
<ROUTINE TAKE-FIRST (OBJ1 OBJ2)
<TELL "You'd have to take " THE .OBJ1>
<OUT-OF-LOC .OBJ2>
<TELL ,SFIRST>
<RTRUE>>
<ROUTINE OUT-OF-LOC (L)
<TELL C ,SP>
<COND (<EQUAL? .L ,HERE>
<TELL "off the ">
<GROUND-WORD>
<RTRUE>)>
<COND (<EQUAL? .L ,PLAYER>
<TELL "away from you">
<RTRUE>)
(<IS? .L ,LIVING>
<TELL "away from">)
(<EQUAL? .L ,ARCH>
<TELL "out from under">)
(<IS? .L ,CONTAINER>
<TELL "out of">)
(<IS? .L ,SURFACE>
<TELL B ,W?OFF>)
(T
<TELL B ,W?FROM>)>
<TELL C ,SP THE .L>
<RTRUE>>
<ROUTINE SAY-WHERE (L)
<COND (<EQUAL? .L ,PLAYER>
<TELL "in " 'HANDS "s">
<RTRUE>)
(<EQUAL? .L ,HERE>
<TELL "in front of you">
<RTRUE>)
(<EQUAL? .L ,MCASE ,BCASE ,WCASE>
<TELL B ,W?IN>)
(<IS? .L ,SURFACE>
<TELL B ,W?ON>)
(<IS? .L ,CONTAINER>
<TELL B ,W?IN>)
(T
<TELL B ,W?WITH>)>
<TELL C ,SP THE .L>
<RTRUE>>
<ROUTINE WINNER-NOT-HOLDING ()
<COND (<EQUAL? ,WINNER ,PLAYER>
<TELL "You're not holding ">
<RTRUE>)>
<TELL CTHE ,WINNER " do">
<COND (<NOT <IS? ,WINNER ,PLURAL>>
<TELL "es">)>
<TELL "n't have ">
<RTRUE>>
<OBJECT NOT-HERE-OBJECT
(DESC "that")
(FLAGS NODESC NOARTICLE)
(ACTION NOT-HERE-OBJECT-F)>
<ROUTINE NOT-HERE-OBJECT-F ("AUX" (PRSO? T) TBL OBJ LEN)
<COND (<AND <PRSO? NOT-HERE-OBJECT>
<PRSI? NOT-HERE-OBJECT>>
<TELL "Those things aren't here." CR>
<RTRUE>)
(<PRSO? NOT-HERE-OBJECT>
<SET TBL ,P-PRSO>)
(T
<SET TBL ,P-PRSI>
<SET PRSO? <>>)>
<COND (<T? .PRSO?>
<COND (<VERB? ; WALK-TO ; FOLLOW FIND WHO WHAT WHERE BUY
WAIT-FOR ; PHONE>
<SET OBJ <FIND-NOT-HERE .TBL .PRSO?>>
<COND (<T? .OBJ>
<COND (<NOT <EQUAL? .OBJ ,NOT-HERE-OBJECT>>
<RFATAL>)>)
(T
<RFALSE>)>)>)
(T
<COND (<VERB? TELL-ABOUT ASK-ABOUT ASK-FOR>
<SET OBJ <FIND-NOT-HERE .TBL .PRSO?>>
<COND (<T? .OBJ>
<COND (<NOT <EQUAL? .OBJ ,NOT-HERE-OBJECT>>
<RFATAL>)>)
(T
<RFALSE>)>)>)>
<TELL ,CANT>
<COND (<VERB? LISTEN>
<TELL B ,W?HEAR>)
(<VERB? SMELL>
<TELL B ,W?SMELL>)
(T
<TELL B ,W?SEE>)>
<SET LEN <GET ,CAPS 0>>
<COND (<NOT <SET LEN <INTBL? ,P-XNAM <REST ,CAPS 2> .LEN>>>
<TELL " any">)>
<NOT-HERE-PRINT .PRSO?>
<TELL " here." CR>
<PCLEAR>
<RFATAL>>
<ROUTINE FIND-NOT-HERE (TBL PRSO? "AUX" M-F OBJ)
<SET M-F <MOBY-FIND .TBL>>
<COND (<EQUAL? .M-F 1>
<COND (<T? .PRSO?>
<SETG PRSO ,P-MOBY-FOUND>
<RFALSE>)>
<SETG PRSI ,P-MOBY-FOUND>
<RFALSE>)
(<AND <G? .M-F 1>
<SET OBJ <GET .TBL 1>>
<SET OBJ <APPLY <GETP .OBJ ,P?GENERIC> .TBL>>>
<COND (<EQUAL? .OBJ <> ,NOT-HERE-OBJECT>
<RTRUE>)
(<T? .PRSO?>
<SETG PRSO .OBJ>
<RFALSE>)>
<SETG PRSI .OBJ>
<RFALSE>)
(<VERB? ASK-ABOUT TELL-ABOUT ASK-FOR WHO WHAT WHERE
FIND FOLLOW TELL>
<RFALSE>)
(<ZERO? .PRSO?>
<TELL "You wouldn't find any">
<NOT-HERE-PRINT .PRSO?>
<TELL " there." CR>
<RTRUE>)
(T
<RETURN ,NOT-HERE-OBJECT>)>>
<ROUTINE NOT-HERE-PRINT ("OPT" (PRSO? <>) "AUX" X)
<COND (<OR <T? ,P-OFLAG>
<T? ,P-MERGED>>
<COND (<T? ,P-XADJ>
<TELL C ,SP B ,P-XADJ>)>
<COND (<T? ,P-XNAM>
<TELL C ,SP B ,P-XNAM>)>
<RFALSE>)
(<T? .PRSO?>
<SET X <GET ,P-ITBL ,P-NC1>>
<BUFFER-PRINT .X <GET ,P-ITBL ,P-NC1L> <>>
<RFALSE>)
(T
<SET X <GET ,P-ITBL ,P-NC2>>
<BUFFER-PRINT .X <GET ,P-ITBL ,P-NC2L> <>>
<RFALSE>)>>
<OBJECT C-OBJECT>
<ROUTINE CONTENTS ("OPT" (THING ,PRSO) (SAY-OR <>)
"AUX" OBJ NXT (1ST? T) (IT? <>) (TWO? <>))
<COND (<SET OBJ <FIRST? .THING>>
<REPEAT ()
<SET NXT <NEXT? .OBJ>>
<COND (<OR <EQUAL? .OBJ ,WINNER>
<IS? .OBJ ,NODESC>>
<MOVE .OBJ ,C-OBJECT>)>
<SET OBJ .NXT>
<COND (<ZERO? .OBJ>
<RETURN>)>>)>
<SET OBJ <FIRST? .THING>>
<COND (<ZERO? .OBJ>
<TELL "nothing " <PICK-NEXT ,YAWNS>>)
(T
<REPEAT ()
<COND (<T? .OBJ>
<SET NXT <NEXT? .OBJ>>
<COND (<T? .1ST?>
<SET 1ST? <>>)
(T
<COND (<T? .NXT>
<TELL ", ">)
(<T? .SAY-OR>
<TELL " or ">)
(T
<TELL ,AND>)>)>
<SETG DESCING .OBJ>
<TELL A .OBJ>
<COND (<AND <EQUAL? .OBJ ,GOBLET>
<IN? ,BFLY .OBJ>
<IS? ,BFLY ,LIVING>>
<TELL ,WITH A ,BFLY>
<PRINT " resting on the rim">)>
<COND (<AND <EQUAL? .THING ,WINNER>
<IS? .OBJ ,WIELDED>>
<TELL " (wielded)">)>
; <COND (<IS? .OBJ ,LIGHTED>
<TELL " (providing light)">)>
<COND (<AND <ZERO? .IT?>
<ZERO? .TWO?>>
<SET IT? .OBJ>)
(T
<SET TWO? T>
<SET IT? <>>)>
<SET OBJ .NXT>)
(T
<COND (<AND <T? .IT?>
<ZERO? .TWO?>>
<THIS-IS-IT .IT?>)>
<RETURN>)>>)>
<SETG DESCING <>>
<MOVE-ALL ,C-OBJECT .THING>
<RTRUE>>
<ROUTINE MOVE-ALL (FROM TO "OPT" EXCEPT "AUX" OBJ NXT)
<COND (<SET OBJ <FIRST? .FROM>>
<REPEAT ()
<SET NXT <NEXT? .OBJ>>
<COND (<OR <NOT <ASSIGNED? EXCEPT>>
<NOT <IS? .OBJ .EXCEPT>>>
<MOVE .OBJ .TO>)>
<SET OBJ .NXT>
<COND (<ZERO? .OBJ>
<RTRUE>)>>)>
<RFALSE>>
"Note that the object to be searched is the FIRST parameter expected in this
version of GLOBAL-IN? ... allowing optional target objects."
<ROUTINE GLOBAL-IN? (SOURCE OBJ1 "OPT" OBJ2 OBJ3 "AUX" LEN X)
<SET SOURCE <GETPT .SOURCE ,P?GLOBAL>>
<COND (<ZERO? .SOURCE>
<RFALSE>)>
<SET LEN </ <PTSIZE .SOURCE> 2>>
<COND (<SET X <INTBL? .OBJ1 .SOURCE .LEN>>
<RTRUE>)
(<NOT <ASSIGNED? OBJ2>>
<RFALSE>)
(<SET X <INTBL? .OBJ2 .SOURCE .LEN>>
<RTRUE>)
(<NOT <ASSIGNED? OBJ3>>
<RFALSE>)
(<SET X <INTBL? .OBJ3 .SOURCE .LEN>>
<RTRUE>)
(T
<RFALSE>)>>
; <ROUTINE GLOBAL-IN? (OBJ1 OBJ2 "AUX" TBL)
<SET TBL <GETPT .OBJ2 ,P?GLOBAL>>
<COND (<T? .TBL>
<INTBL? .OBJ1 .TBL </ <PTSIZE .TBL> 2>>
; <ZMEMQ .OBJ1 .TBL <RMGL-SIZE .TBL>>)>>
<CONSTANT AUX-TABLE-LENGTH 82>
<GLOBAL AUX-TABLE:TABLE <ITABLE ,AUX-TABLE-LENGTH (BYTE) 0>>
<ROUTINE READ-LEXV ("AUX" KEY TBL LEN ILEN X Y CNT PTR DEST OFFSET
PAGE-SIZE LAST-PAGE)
<SET PAGE-SIZE <- ,DHEIGHT 2>>
<SET LAST-PAGE <- ,MAX-HEIGHT ,DHEIGHT>>
<COPYT ,P-INBUF 0 ,P-INBUF-LENGTH>
<PUTB ,P-INBUF 0 %<- ,P-INBUF-LENGTH 2>>
<COPYT ,P-LEXV 0 ,P-LEXV-LENGTH>
<PUTB ,P-LEXV 0 ,LEXMAX>
<REPEAT ()
<COLOR ,INCOLOR ,BGND>
<SET KEY <READ ,P-INBUF 0>>
<COND (<EQUAL? .KEY ,EOL ,LF>
<DO-LEX>
<RFALSE>)>
<SET TBL <>>
<SET ILEN <GETB ,P-INBUF 1>>
<SET DEST <REST ,P-INBUF <+ .ILEN 2>>>
<SET OFFSET 0>
<COND (<AND <G? .KEY ,PAD0>
<L? .KEY %<+ ,PAD9 1>>>
<SET TBL <KEYPAD .KEY>>
<COND (<ZERO? .TBL>
<SOUND ,S-BOOP>
<AGAIN>)>)
(<ZERO? ,DMODE>)
(<EQUAL? .KEY ,CLICK1 ,CLICK2>
<SET Y <LOWCORE MSLOCY>>
<SET X <LOWCORE MSLOCX>>
<COND (<G? ,CWIDTH 1>
<DEC X>
<SET X </ .X ,CWIDTH>>
<INC X>)>
<COND (<G? ,CHEIGHT 1>
<DEC Y>
<SET Y </ .Y ,CHEIGHT>>
<INC Y>)>
<COND (<G? .Y %<+ ,MHEIGHT 1>>
<AGAIN>)
(<L? .X ,MOUSEDGE>
<AGAIN>)>
<SET TBL <CLICKED .KEY .Y .X>>
<COND (<ZERO? .TBL>
<SOUND ,S-BOOP>
<AGAIN>)>)
(<EQUAL? .KEY ,UP-ARROW ,MAC-UP-ARROW>
<COND (<ZERO? ,DBOX-TOP>
<SOUND 2>
<AGAIN>)>
<SETG DBOX-TOP <- ,DBOX-TOP .PAGE-SIZE>>
<COND (<L? ,DBOX-TOP 0>
<SETG DBOX-TOP 0>)>
<DISPLAY-DBOX>
<AGAIN>)
(<EQUAL? .KEY ,DOWN-ARROW ,MAC-DOWN-ARROW>
<SET X <- ,DBOX-LINES ,DHEIGHT>>
<COND (<OR <BTST ,IN-DBOX ,SHOWING-STATS>
<G? ,DBOX-TOP .X>
<G? ,DBOX-TOP <- .LAST-PAGE 1>>>
<SOUND 2>
<AGAIN>)>
<INC X>
<SETG DBOX-TOP <+ ,DBOX-TOP .PAGE-SIZE>>
<COND (<G? ,DBOX-TOP .X>
<SETG DBOX-TOP .X>)
(<G? ,DBOX-TOP .LAST-PAGE>
<SETG DBOX-TOP .LAST-PAGE>)>
<DISPLAY-DBOX>
<AGAIN>)>
<COND (<AND <G? .KEY %<- ,F1 1>>
<L? .KEY %<+ ,F10 1>>>
<SET TBL <GET ,SOFT-KEYS <- .KEY ,F1>>>)>
<COND (<ZERO? .TBL>
<AGAIN>)>
<SET LEN <GETB .TBL 1>>
<COND (<ZERO? .LEN>
<SOUND ,S-BOOP>
<AGAIN>)
(<ZERO? .ILEN>)
(<G? .LEN <- %<- ,P-INBUF-LENGTH 6> .ILEN>>
<SOUND ,S-BOOP>
<AGAIN>)
(<NOT <EQUAL? <GETB <BACK .DEST 1> 0> ,SP>>
<PUTB .DEST 0 ,SP>
<INC DEST>
<INC OFFSET>
<BUFOUT <>>
<TELL C ,SP>)>
<BUFOUT <>>
<SHOW-TABLE .TBL .LEN>
<SET TBL <REST .TBL 2>>
<SET PTR 0>
<SET CNT <- .LEN 1>>
<REPEAT ()
<SET X <GETB .TBL .PTR>>
<COND (<OR <EQUAL? .X ,EOL ,LF>
<EQUAL? .X %<ASCII !\|> %<ASCII !\!>>>
<BUFOUT T>
<PUTB .DEST .PTR 0>
<SET LEN <+ <+ .PTR .ILEN> .OFFSET>>
<PUTB ,P-INBUF 1 .LEN>
<DO-LEX>
<RFALSE>)>
<PUTB .DEST .PTR .X>
<COND (<IGRTR? PTR .CNT>
<RETURN>)>>
<TELL C ,SP>
<BUFOUT T>
<PUTB .DEST .PTR ,SP>
<INC OFFSET>
<SET LEN <+ <+ .LEN .ILEN> .OFFSET>>
<PUTB ,P-INBUF 1 .LEN>>>
<ROUTINE DO-LEX ()
<LEX ,P-INBUF ,P-LEXV>
<LEX ,P-INBUF ,P-LEXV ,VOCAB2 1>
<COLOR ,FORE ,BGND>
<RFALSE>>
<ROUTINE SHOW-TABLE (TBL LEN "AUX" PTR CHAR)
<SET PTR 2>
<INC LEN>
<REPEAT ()
<SET CHAR <GETB .TBL .PTR>>
<COND (<OR <EQUAL? .CHAR ,EOL ,LF>
<EQUAL? .CHAR %<ASCII !\|> %<ASCII !\!>>>
<CRLF>
<RFALSE>)
(<AND <G? .CHAR %<- <ASCII !\a> 1>>
<L? .CHAR %<+ <ASCII !\z> 1>>>
<SET CHAR <- .CHAR ,SP>>)>
<PRINTC .CHAR>
<COND (<IGRTR? PTR .LEN>
<RFALSE>)>>>
<ROUTINE CLICKED (CLK Y X "AUX" NX NY DIR TMP MX MY)
; "Zero-align X and Y."
<SET X <- .X ,MOUSEDGE 1>>
<DEC Y>
; "Get direction of mouse relative to HERE."
; "Changed per TAA. Instead of using COMPASS, we do
computation. Cardinal directions happen if one coordinate
is L=? half of the other. Otherwise do nw, etc."
<COND (<AND <EQUAL? .Y ,MAPY>
<EQUAL? .X ,MAPX>>
; "We're in the same room, so check for up/down"
<SET DIR <GETB <REST ,MAP <* ,MAPY ,MWIDTH>> ,MAPX>>
<COND (<EQUAL? .DIR ,IUARROW ,UARROW>
<SET DIR ,I-U>)
(<EQUAL? .DIR ,IDARROW ,DARROW>
<SET DIR ,I-D>)
(T
<RFALSE>)>)
(T
<SET NX <- .X ,MAPX>>
; "Get position relative to current"
;<COND (<ZERO? .NX>)
(<G? .NX ,CENTERX>
<SET X <- .X ,CENTERX>>)
(<L? .NX ,NCENTERX>
<SET X <+ .X ,CENTERX>>)>
;<SET NX <+ .X <- ,CENTERX ,MAPX>>>
<SET NY <- .Y ,MAPY>>
;<COND (<ZERO? .NY>)
(<G? .NY ,CENTERY>
<SET Y <- .Y ,CENTERY>>)
(<L? .NY ,NCENTERY>
<SET Y <+ .Y ,CENTERY>>)>
;<SET NY <+ .Y <- ,CENTERY ,MAPY>>>
;<SET DIR <GETB <REST ,COMPASS <* .NY %<+ ,MWIDTH 1>>> .NX>>
; "Get magnitude of X and Y difference"
<COND (<L? .NY 0>
<SET MY <- .NY>>)
(T
<SET MY .NY>)>
<COND (<L? .NX 0>
<SET MX <- .NX>>)
(T
<SET MX .NX>)>
<COND (<AND <0? .MX> <0? .MY>>
<SET DIR ,AMB>)
(<L=? <* 3 .MX> .MY>
; "X is small compared to Y, so this is N/S"
<COND (<G? .NY 0>
; "Mouse is below current loc"
<SET DIR ,I-SOUTH>)
(T
<SET DIR ,I-NORTH>)>)
(<L=? <* 2 .MY> .MX>
; "Y is small compared to X, so this is E/W"
<COND (<G? .NX 0>
<SET DIR ,I-EAST>)
(T
<SET DIR ,I-WEST>)>)
(<G? .NX 0>
; "Tending eastward"
<COND (<G? .NY 0>
<SET DIR ,I-SE>)
(T
<SET DIR ,I-NE>)>)
(<G? .NY 0>
<SET DIR ,I-SW>)
(T
<SET DIR ,I-NW>)>)>
<COND (<EQUAL? .DIR ,AMB> ; "DIR ambiguous."
<RFALSE>)>
<TABLE-WALK <GET ,DIR-NAMES .DIR>>
<RETURN ,AUX-TABLE>>
<ROUTINE TABLE-WALK (WRD)
<PUT ,AUX-TABLE 0 0>
<DIROUT ,D-TABLE-ON ,AUX-TABLE>
<COND (<EQUAL? .WRD ,W?AROUND>
<TELL "walk ">)>
<TELL B .WRD CR>
<DIROUT ,D-TABLE-OFF>
<PUTB ,AUX-TABLE 1 <GET ,AUX-TABLE 0>>
<RFALSE>>
<ROUTINE KEYPAD (KEY "AUX" TBL WRD)
<SET WRD <GET ,PAD-NAMES <- .KEY ,PAD1>>>
<COND (<EQUAL? .KEY ,PAD5>
<SET TBL <GETP ,HERE ,P?UP>>
<COND (<ZERO? .TBL>)
(<CHECK-EXIT? ,HERE .TBL>
<SET WRD ,W?UP>)>
<SET TBL <GETP ,HERE ,P?DOWN>>
<COND (<ZERO? .TBL>)
(<CHECK-EXIT? ,HERE .TBL>
<COND (<EQUAL? .WRD ,W?UP>
<SET WRD ,W?AROUND>)
(T
<SET WRD ,W?DOWN>)>)>)>
<TABLE-WALK .WRD>
<RETURN ,AUX-TABLE>>
"PICK-ONE expects an LTABLE, with an initial element of 0."
<ROUTINE PICK-ONE (TBL "AUX" L CNT RND X RTBL)
<SET L <GET .TBL 0>>
<SET CNT <GET .TBL 1>>
<DEC L>
<SET TBL <REST .TBL 2>>
<SET RTBL <REST .TBL <* .CNT 2>>>
<SET RND <RANDOM <- .L .CNT>>>
<SET X <GET .RTBL .RND>>
<PUT .RTBL .RND <GET .RTBL 1>>
<PUT .RTBL 1 .X>
<INC CNT>
<COND (<EQUAL? .CNT .L>
<SET CNT 0>)>
<PUT .TBL 0 .CNT>
<RETURN .X>>
"PICK-NEXT expects an LTABLE of strings, with an initial element of 2."
<ROUTINE PICK-NEXT (TBL "AUX" CNT STR)
<SET CNT <GET .TBL 1>>
<SET STR <GET .TBL .CNT>>
<COND (<IGRTR? CNT <GET .TBL 0>>
<SET CNT 2>)>
<PUT .TBL 1 .CNT>
<RETURN .STR>>
<GLOBAL P-ACT <>>
<GLOBAL P-QWORD <>>
<BUZZ $BUZZ>
<OBJECT QWORD
(LOC GLOBAL-OBJECTS)
(DESC "that")
(SYNONYM PPPZ)
(FLAGS NOARTICLE NODESC)>
<ROUTINE QUOTED-WORD? (PTR "OPT" (VERB <>) (NAMING <>) "AUX" (WRD 0))
<COND (<ZERO? .VERB>)
(<AND <ZERO? ,P-QWORD>
<T? .NAMING>
<EQUAL? .VERB ,ACT?NAME ; ,ACT?SAY>>
<SETG P-QWORD .PTR>
<SET WRD ,W?PPPZ>)>
<CHANGE-LEXV .PTR .WRD>
<RETURN .WRD>>
<ROUTINE QUOTED-PHRASE? (PTR VERB "AUX" (1ST? T) LEN WRD BPTR)
<CHANGE-LEXV .PTR ,W?$BUZZ> ; "Neutralizes W?QUOTE."
<SET LEN <- ,P-LEN 1>>
<SET PTR <+ .PTR ,P-LEXELEN>>
<SET BPTR <REST ,P-LEXV <* .PTR 2>>>
<REPEAT ()
<COND (<L? .LEN 0>
<PCLEAR>
<TELL "[You forgot a second quote.]" CR>
<RFALSE>)>
<SET WRD <GET ,P-LEXV .PTR>>
<COND (<EQUAL? .WRD ,W?QUOTE>
<CHANGE-LEXV .PTR ,W?$BUZZ>
<RTRUE>)
(<T? .1ST?>
<COND (<T? .WRD>
<COND (<EQUAL? .VERB ,ACT?SAY>)
(<EQUAL? .VERB ,ACT?NAME>
<HOLLOW-VOICE
"reserved by the Implementors">
<RFALSE>)>)
(<QUOTED-WORD? .PTR .VERB T>
<SET 1ST? <>>)
(T
<TELL ,CANT "see any ">
<SET LEN <GETB .BPTR 2>>
<WORD-PRINT .LEN <GETB .BPTR 3>>
<TELL " here." ;" [2]" CR>
<RFALSE>)>)
(T
<CHANGE-LEXV .PTR ,W?$BUZZ>)>
<SET PTR <+ .PTR ,P-LEXELEN>>
<SET LEN <- .LEN 1>>>>
<ROUTINE ITS-CLOSED ("OPT" (OBJ ,PRSO))
<THIS-IS-IT .OBJ>
<TELL CTHE .OBJ>
<IS-ARE .OBJ>
<TELL B ,W?CLOSED ,PERIOD>
<RTRUE>>
<ROUTINE REMOVE-ALL (THING "AUX" OBJ NXT)
<COND (<SET OBJ <FIRST? .THING>>
<REPEAT ()
<SET NXT <NEXT? .OBJ>>
<REMOVE .OBJ>
<SET OBJ .NXT>
<COND (<ZERO? .OBJ>
<RFALSE>)>>)>
<RFALSE>>
Reference in a new issue View git blame Copy permalink