105 lines
6.0 KiB
Plaintext
105 lines
6.0 KiB
Plaintext
<FLAGS-AND-DEFAULTS (("P-ZORK0" %<>)("ONE-BYTE-PARTS-OF-SPEECH" %<>)(
|
|
"WORD-FLAGS-IN-TABLE" T)("IN-ZILCH" T)("P-APOSTROPHE-BREAKS-WORDS" T)(
|
|
"P-BE-VERB" T)) (("YES?" "DEFS" #WORD *31055044554*) ("WHICH-PRINT" "DEFS2" #
|
|
WORD *07342702061*) ("CANT-FIND-OBJECT" "DEFS2" #WORD *34547172463*) ("REFRESH"
|
|
"DEFS" #WORD *22741033411*))>
|
|
|
|
<ZZPACKAGE "PARSER">
|
|
<RENTRY PRINT-LEXV TELL-CTHE TELL-THE>
|
|
<INCLUDE "BASEDEFS" "PBITDEFS" "PDEFS">
|
|
<USE "PMEM" "PSTACK" "REDS">
|
|
<FILE-FLAGS MDL-ZIL? CLEAN-STACK?>
|
|
<BEGIN-SEGMENT 0>
|
|
<DEFAULTS-DEFINED CANT-FIND-OBJECT CANT-USE-MULTIPLE DONT-UNDERSTAND
|
|
PRINT-INTQUOTE PRINT-LEXV REFRESH SETUP-ORPHAN SETUP-ORPHAN-NP TOO-MANY-NOUNS
|
|
WHICH-LIST? WHICH-PRINT WINNER-SAYS-WHICH? YES?>
|
|
<DEFINE-ROUTINE TOO-MANY-NEW>
|
|
<DEFINE-ROUTINE NAKED-OOPS>
|
|
<DEFINE-ROUTINE CANT-OOPS>
|
|
<DEFINE-ROUTINE CANT-AGAIN>
|
|
<DEFAULT-DEFINITION CANT-USE-MULTIPLE <ROUTINE CANT-USE-MULTIPLE>>
|
|
<DEFINE-ROUTINE MAKE-ROOM-FOR-TOKENS>
|
|
<DEFINE-ROUTINE REPLACE-ONE-TOKEN>
|
|
<DEFAULT-DEFINITION REFRESH <DEFINE V-$REFRESH () <LOWCORE FLAGS <BAND <LOWCORE
|
|
FLAGS> <BCOM ,F-REFRESH>>> <CLEAR -1> <INIT-STATUS-LINE> <RTRUE>>>
|
|
<DEFAULT-DEFINITION PRINT-INTQUOTE <ROUTINE PRINT-INTQUOTE>>
|
|
<DEFAULT-DEFINITION PRINT-LEXV <ROUTINE PRINT-LEXV>>
|
|
<DEFINE-ROUTINE COPY-INPUT>
|
|
<COND (<NOT <OR <CHECK-VERSION? XZIP> <CHECK-VERSION? YZIP>>> <DEFINE
|
|
COPY-INBUF (SRC DEST "AUX" CNT:FIX) <SET CNT <- <GETB .SRC 0> 1>> <REPEAT () <
|
|
PUTB .DEST .CNT <GETB .SRC .CNT>> <COND (<L? <SET CNT <- .CNT 1>> 0> <RETURN>)>
|
|
>> <DEFINE COPY-LEXV (SRC DEST "OPT" (MAX:FIX ,LEXV-LENGTH) "AUX" (CTR:FIX 1))
|
|
<PUTB .DEST 0 <GETB .SRC 0>> <PUTB .DEST 1 <GETB .SRC 1>> <SET DEST <ZREST .
|
|
DEST <* ,P-LEXSTART:FIX 2>>> <SET SRC <ZREST .SRC <* ,P-LEXSTART:FIX 2>>> <
|
|
REPEAT () <ZPUT .DEST 0 <ZGET .SRC 0>> <PUTB .DEST 2 <GETB .SRC 2>> <PUTB .DEST
|
|
3 <GETB .SRC 3>> <COND (<G? <SET CTR <+ .CTR 1>> .MAX> <RETURN>)> <SET DEST <
|
|
ZREST .DEST <* 2 ,P-LEXELEN:FIX>>> <SET SRC <ZREST .SRC <* 2 ,P-LEXELEN:FIX>>>>
|
|
>)>
|
|
<END-SEGMENT>
|
|
<BEGIN-SEGMENT 0>
|
|
<ADD-WORD NO.WORD ADJ>
|
|
<DEFINE-ROUTINE BUFFER-PRINT>
|
|
<DEFINE-ROUTINE CAPITALIZE>
|
|
<DEFINE-ROUTINE PRINT-PARSER-FAILURE>
|
|
<DEFINE-ROUTINE NAKED-ADJECTIVE?>
|
|
<DEFINE-ROUTINE CHANGE-AND-TO-THEN?>
|
|
<DEFAULT-DEFINITION DONT-UNDERSTAND <ROUTINE DONT-UNDERSTAND>>
|
|
<DEFINE-ROUTINE MISSING>
|
|
<DEFAULT-DEFINITION CANT-FIND-OBJECT <DEFINE CANT-FIND-OBJECT (NP PART "AUX"
|
|
TMP) <COND (<ZERO? <NP-QUANT .NP>> <NP-CANT-SEE .NP .PART>) (T <TELL
|
|
"[There isn't anything to "> <COND (<SET TMP <PARSE-VERB ,PARSE-RESULT>> <
|
|
PRINT-VOCAB-WORD .TMP> <COND (<NOT <EQUAL? .PART 0 1>> <TELL !\ > <
|
|
PRINT-VOCAB-WORD .PART>)>) (T <TELL "do that to">)> <TELL "!]" CR>)>> <DEFINE
|
|
NP-CANT-SEE ("OPT" (NP <GET-NP>) (SYN 0) "AUX" TMP) <COND (<SET TMP <NP-NAME .
|
|
NP>> <TELL "["> <TELL-CTHE ,WINNER> <TELL " "> <COND (<AND <BTST .SYN ,
|
|
SEARCH-MUST-HAVE> <NOT <BTST .SYN ,SEARCH-MOBY>>> <COND (<EQUAL? ,WINNER ,
|
|
PLAYER ,ME> <TELL "don't">) (ELSE <TELL "doesn't">)> <TELL " have">) (T <TELL
|
|
"can't see">)> <TELL " "> <COND (<OR <CAPITAL-NOUN? .TMP> <AND <SET TMP <
|
|
NP-ADJS .NP>> <ADJS-POSS .TMP>>> <NP-PRINT .NP T>) (T <TELL "any "> <NP-PRINT .
|
|
NP>)> <TELL !\ > <COND (<AND <SET TMP <NP-LOC .NP>> <OR <AND <PMEM-TYPE? .TMP
|
|
NOUN-PHRASE> <TELL "in">> <AND <PMEM-TYPE? .TMP LOCATION> <SET TMP <
|
|
LOCATION-OBJECT .TMP>> <PRINT-VOCAB-WORD <LOCATION-PREP .TMP>>>>> <TELL " "> <
|
|
TELL-THE <NOUN-PHRASE-OBJ1 .TMP>>) (T <COND (T <TELL "right ">)> <TELL "here">)
|
|
> <TELL ".]" CR>) (T <MORE-SPECIFIC>)>>>
|
|
<DEFAULT-DEFINITION WINNER-SAYS-WHICH? <ROUTINE WINNER-SAYS-WHICH?>>
|
|
<DEFAULT-DEFINITION WHICH-LIST? <ROUTINE WHICH-LIST?>>
|
|
<DEFAULT-DEFINITION WHICH-PRINT <DEFINE WHICH-PRINT ("OPT" (NP <GET-NP>)) <
|
|
REPEAT ((PTR <NP-LEXEND .NP>) (NOUN <NP-NAME .NP>)) <COND (<==? .NOUN <ZGET .
|
|
PTR 0>> <SETG P-OFLAG </ <- .PTR ,P-LEXV> 2>> <COPYT ,G-LEXV ,O-LEXV ,
|
|
LEXV-LENGTH-BYTES> <COPYT ,G-INBUF ,O-INBUF <+ 1 ,INBUF-LENGTH>> <ZPUT ,
|
|
OOPS-TABLE ,O-AGAIN <ZGET ,OOPS-TABLE ,O-START>> <RETURN>) (<G? ,P-LEXV <SET
|
|
PTR <- .PTR ,LEXV-ELEMENT-SIZE-BYTES>>> <RFALSE>)>> <PROG ((SR ,ORPHAN-SR) (TMP
|
|
<>) (LEN <FIND-RES-COUNT .SR>) (SZ <FIND-RES-SIZE .SR>)) <COND (<AND <NOT <==?
|
|
,WINNER ,PLAYER>> <NOT <SET TMP <WINNER-SAYS-WHICH? .NP>>>> <TELL
|
|
"\"I don't understand "> <COND (<WHICH-LIST? .NP .SR> <TELL "if">) (T <TELL
|
|
"which"> <COND (<T? .NP> <TELL !\ > <NP-PRINT .NP>)>)>) (<EQUAL? .TMP T> <RTRUE
|
|
>) (T <TELL "[Which"> <COND (<T? .NP> <TELL !\ > <NP-PRINT .NP>)> <TELL " do">)
|
|
> <TELL " you mean"> <COND (<WHICH-LIST? .NP .SR> <COND (<OR .TMP <==? ,WINNER
|
|
,PLAYER>> <TELL !\,>)> <REPEAT ((REM .LEN) (VEC <REST-TO-SLOT .SR FIND-RES-OBJ1
|
|
>)) <TELL !\ > <TELL-THE <ZGET .VEC 0>> <COND (<==? .REM 2> <COND (<NOT <==? .
|
|
LEN 2>> <TELL !\,>)> <TELL " or">) (<G? .REM 2> <TELL !\,>)> <COND (<L? <SET
|
|
REM <- .REM 1>> 1> <RETURN>) (<L? <SET SZ <- .SZ 1>> 1> <COND (T <RETURN>)>) (T
|
|
<SET VEC <ZREST .VEC 2>>)>>)> <COND (<AND <NOT <==? ,WINNER ,PLAYER>> <NOT .TMP
|
|
>> <TELL ".\"" CR>) (T <TELL "?]" CR>)>>>>
|
|
<DEFINE-ROUTINE NP-PRINT>
|
|
<DEFINE-ROUTINE ADJS-PRINT>
|
|
<DEFAULT-DEFINITION TOO-MANY-NOUNS <ROUTINE TOO-MANY-NOUNS>>
|
|
<DEFINE-ROUTINE INBUF-ADD>
|
|
<DEFINE-ROUTINE INBUF-PRINT>
|
|
<DEFAULT-DEFINITION YES? <CONSTANT YES-INBUF <ITABLE 19 (BYTE LENGTH) 0>> <
|
|
CONSTANT YES-LEXV <ITABLE 3 (LEXV) 0 0>> <DEFINE YES? ("OPT" (NO-Q <>) "AUX"
|
|
WORD VAL) <COND (<NOT .NO-Q> <TELL !\?>)> <REPEAT () <TELL "|>"> <COND (T <PUTB
|
|
,YES-INBUF 1 0>)> <ZREAD ,YES-INBUF ,YES-LEXV> <COND (<AND <NOT <0? <GETB ,
|
|
YES-LEXV ,P-LEXWORDS>>> <SET WORD <ZGET ,YES-LEXV ,P-LEXSTART>>> <COND (<
|
|
COMPARE-WORD-TYPES <WORD-CLASSIFICATION-NUMBER .WORD> <GET-CLASSIFICATION VERB>
|
|
> <SET VAL <WORD-VERB-STUFF .WORD>>) (T <SET VAL <>>)> <COND (<EQUAL? .VAL ,
|
|
ACT?YES> <SET VAL T> <RETURN>) (<OR <EQUAL? .VAL ,ACT?NO> <EQUAL? .WORD ,W?N>>
|
|
<SET VAL <>> <RETURN>) (<EQUAL? .VAL ,ACT?RESTART> <V-RESTART>) (<EQUAL? .VAL ,
|
|
ACT?RESTORE> <V-RESTORE>) (<EQUAL? .VAL ,ACT?QUIT> <V-QUIT>)>)> <TELL
|
|
"[Please type YES or NO.]">> .VAL>>
|
|
<DEFAULT-DEFINITION SETUP-ORPHAN <ROUTINE SETUP-ORPHAN>>
|
|
<DEFAULT-DEFINITION SETUP-ORPHAN-NP <ROUTINE SETUP-ORPHAN-NP>>
|
|
<DEFINE-ROUTINE INSERT-ADJS>
|
|
<DEFINE-ROUTINE INSERT-ADJS-WD>
|
|
<END-SEGMENT>
|
|
<ENDPACKAGE> |