abyss/prare.zabstr

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>