beyondzork/parser.zap

2886 lines
60 KiB
Plaintext

.FUNCT PARSER,PTR,VAL,VERB,OF-FLAG,LEN,DIR,NW,LW,OWINNER,OMERGED,WRD,X,?TMP2,?TMP1
SET 'PTR,P-LEXSTART
?PRG1: ZERO? P-OFLAG \?CND3
COPYT P-ITBL,P-OTBL,P-ITBLLEN
?CND3: COPYT P-ITBL,0,P-ITBLLEN
SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
SET 'P-XNAM,FALSE-VALUE
SET 'P-XADJ,FALSE-VALUE
SET 'P-DIR-WORD,FALSE-VALUE
SET 'P-PNAM,FALSE-VALUE
SET 'P-PADJN,FALSE-VALUE
ZERO? P-OFLAG \?CND5
SET 'P-ACT,FALSE-VALUE
SET 'P-QWORD,FALSE-VALUE
SET 'P-LASTADJ,FALSE-VALUE
PUT P-NAMW,0,FALSE-VALUE
PUT P-NAMW,1,FALSE-VALUE
PUT P-ADJW,0,FALSE-VALUE
PUT P-ADJW,1,FALSE-VALUE
PUT P-OFW,0,FALSE-VALUE
PUT P-OFW,1,FALSE-VALUE
?CND5: SET 'OMERGED,P-MERGED
SET 'P-MERGED,FALSE-VALUE
SET 'P-END-ON-PREP,FALSE-VALUE
PUT P-PRSO,P-MATCHLEN,0
PUT P-PRSI,P-MATCHLEN,0
PUT P-BUTS,P-MATCHLEN,0
SET 'OWINNER,WINNER
ZERO? QUOTE-FLAG \?CND7
EQUAL? WINNER,PLAYER /?CND7
SET 'WINNER,PLAYER
LOC WINNER
FSET? STACK,VEHICLE /?CND11
LOC WINNER >HERE
?CND11: CALL1 IS-LIT? >LIT?
?CND7: ZERO? RESERVE-PTR /?CCL15
SET 'PTR,RESERVE-PTR
COPYT RESERVE-LEXV,P-LEXV,P-LEXV-LENGTH
COPYT RESERVE-INBUF,P-INBUF,P-INBUF-LENGTH
ZERO? VERBOSITY /?CND16
EQUAL? PLAYER,WINNER \?CND16
CRLF
?CND16: SET 'RESERVE-PTR,FALSE-VALUE
SET 'P-CONT,FALSE-VALUE
JUMP ?CND13
?CCL15: ZERO? P-CONT /?CCL21
SET 'PTR,P-CONT
SET 'P-CONT,FALSE-VALUE
ZERO? VERBOSITY /?CND13
EQUAL? PLAYER,WINNER \?CND13
CRLF
JUMP ?CND13
?CCL21: SET 'WINNER,PLAYER
SET 'QUOTE-FLAG,FALSE-VALUE
LOC WINNER
FSET? STACK,VEHICLE /?CND26
LOC WINNER >HERE
?CND26: CALL1 IS-LIT? >LIT?
GET 0,8
BTST STACK,4 \?CND28
ICALL1 V-REFRESH
?CND28: EQUAL? HERE,OLD-HERE /?CND30
ZERO? DMODE /?CTR32
EQUAL? IN-DBOX,SHOWING-STATS /?CTR32
EQUAL? PRIOR,SHOWING-INV,SHOWING-STATS \?CCL33
?CTR32: ICALL1 V-LOOK
JUMP ?CND30
?CCL33: ICALL1 DISPLAY-PLACE
?CND30: ZERO? DMODE /?CND37
ZERO? AUTO /?CND37
ZERO? NEW-DBOX /?CND37
EQUAL? IN-DBOX,SHOWING-ROOM \?CCL42
EQUAL? PRIOR,0,SHOWING-ROOM \?CCL42
BTST NEW-DBOX,SHOWING-ROOM \?CND37
SET 'X,P-IT-OBJECT
ICALL1 UPDATE-ROOMDESC
ICALL2 THIS-IS-IT,X
JUMP ?CND37
?CCL42: EQUAL? IN-DBOX,SHOWING-INV \?CCL48
EQUAL? PRIOR,0,SHOWING-INV \?CCL48
BTST NEW-DBOX,SHOWING-INV \?CND37
SET 'X,P-IT-OBJECT
ICALL1 UPDATE-INVENTORY
ICALL2 THIS-IS-IT,X
JUMP ?CND37
?CCL48: EQUAL? IN-DBOX,SHOWING-STATS \?CND37
EQUAL? PRIOR,0,SHOWING-STATS \?CND37
BTST NEW-DBOX,SHOWING-STATS \?CND37
SET 'X,ENDURANCE
ICALL1 TO-TOP-WINDOW
?PRG58: GET STATS,X
ICALL STAT-ROUTINE,X,STACK
IGRTR? 'X,LUCK \?PRG58
ICALL1 TO-BOTTOM-WINDOW
?CND37: ZERO? VERBOSITY /?CND62
CRLF
?CND62: PRINTC 62
ICALL1 READ-LEXV
?CND13: GETB P-LEXV,P-LEXWORDS >P-LEN
GET P-LEXV,PTR
EQUAL? STACK,W?QUOTE \?CND64
ADD PTR,P-LEXELEN >PTR
DEC 'P-LEN
?CND64: GET P-LEXV,PTR
EQUAL? STACK,W?THEN,W?PLEASE,W?SO \?CND66
ADD PTR,P-LEXELEN >PTR
DEC 'P-LEN
?CND66: LESS? 1,P-LEN \?CND68
GET P-LEXV,PTR
EQUAL? STACK,W?GO \?CND68
ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
ZERO? NW /?CND68
CALL WT?,NW,64
ZERO? STACK /?CND68
ADD PTR,P-LEXELEN >PTR
DEC 'P-LEN
?CND68: ZERO? P-LEN \?CND74
PRINTI "[What?]"
CRLF
RFALSE
?CND74: GET P-LEXV,PTR >WRD
EQUAL? WRD,W?UNDO \?CND76
ICALL1 V-UNDO
RFALSE
?CND76: ISAVE >CAN-UNDO
EQUAL? CAN-UNDO,2 \?REP2
ICALL1 V-REFRESH
ICALL2 COMPLETED,STR?508
ZERO? DMODE /?CCL81
EQUAL? PRIOR,0,SHOWING-ROOM /?PRG1
?CCL81: CRLF
JUMP ?PRG1
?REP2: EQUAL? WRD,W?OOPS \?CCL86
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?PERIOD,W?COMMA \?CND87
ADD PTR,P-LEXELEN >PTR
DEC 'P-LEN
?CND87: GRTR? P-LEN,1 /?CCL91
PRINTC 91
PRINT CANT
PRINTI "use OOPS that way.]"
CRLF
RFALSE
?CCL91: GET OOPS-TABLE,O-PTR
ZERO? STACK /?CCL93
GRTR? P-LEN,2 \?CND94
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?QUOTE \?CND96
PRINTI "[Sorry. "
PRINT CANT
PRINTI "correct mistakes in quoted text.]"
CRLF
RFALSE
?CND96: PRINTI "[NOTE: Only the first word after OOPS is used.]"
CRLF
PRINT TAB
?CND94: GET OOPS-TABLE,O-PTR >?TMP1
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
PUT AGAIN-LEXV,?TMP1,STACK
SET 'WINNER,OWINNER
MUL PTR,P-LEXELEN
ADD STACK,6
GETB P-LEXV,STACK >?TMP2
MUL PTR,P-LEXELEN
ADD STACK,7
GETB P-LEXV,STACK >?TMP1
GET OOPS-TABLE,O-PTR
MUL STACK,P-LEXELEN
ADD STACK,3
ICALL INBUF-ADD,?TMP2,?TMP1,STACK
COPYT AGAIN-LEXV,P-LEXV,P-LEXV-LENGTH
GETB P-LEXV,P-LEXWORDS >P-LEN
GET OOPS-TABLE,O-START >PTR
COPYT OOPS-INBUF,P-INBUF,P-INBUF-LENGTH
JUMP ?CND84
?CCL93: PUT OOPS-TABLE,O-END,FALSE-VALUE
PRINTI "[There was no word to replace in that sentence.]"
CRLF
RFALSE
?CCL86: EQUAL? WRD,W?AGAIN,W?G /?CND98
SET 'P-QWORD,FALSE-VALUE
SET 'P-NUMBER,-1
?CND98: PUT OOPS-TABLE,O-END,FALSE-VALUE
?CND84: GET P-LEXV,PTR
EQUAL? STACK,W?AGAIN,W?G \?CCL102
ZERO? P-OFLAG \?CTR104
ZERO? P-WON /?CTR104
GETB OOPS-INBUF,1
ZERO? STACK \?CCL105
?CTR104: PRINTC 91
PRINT CANT
PRINTI "use AGAIN that way.]"
CRLF
RFALSE
?CCL105: GRTR? P-LEN,1 \?CCL110
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?PERIOD,W?COMMA,W?THEN /?CTR112
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?AND \?CCL113
?CTR112: ADD PTR,4 >PTR
GETB P-LEXV,P-LEXWORDS
SUB STACK,2
PUTB P-LEXV,P-LEXWORDS,STACK
JUMP ?CND103
?CCL113: ICALL1 DONT-UNDERSTAND
RFALSE
?CCL110: ADD PTR,P-LEXELEN >PTR
GETB P-LEXV,P-LEXWORDS
SUB STACK,1
PUTB P-LEXV,P-LEXWORDS,STACK
?CND103: GETB P-LEXV,P-LEXWORDS
GRTR? STACK,0 \?CCL118
COPYT P-LEXV,RESERVE-LEXV,P-LEXV-LENGTH
COPYT P-INBUF,RESERVE-INBUF,P-INBUF-LENGTH
SET 'RESERVE-PTR,PTR
JUMP ?CND116
?CCL118: SET 'RESERVE-PTR,FALSE-VALUE
?CND116: SET 'WINNER,OWINNER
SET 'P-MERGED,OMERGED
COPYT OOPS-INBUF,P-INBUF,P-INBUF-LENGTH
COPYT AGAIN-LEXV,P-LEXV,P-LEXV-LENGTH
SET 'DIR,AGAIN-DIR
COPYT P-OTBL,P-ITBL,P-ITBLLEN
JUMP ?CND100
?CCL102: SET 'P-NUMBER,-1
COPYT P-LEXV,AGAIN-LEXV,P-LEXV-LENGTH
COPYT P-INBUF,OOPS-INBUF,P-INBUF-LENGTH
PUT OOPS-TABLE,O-START,PTR
MUL 4,P-LEN
PUT OOPS-TABLE,O-LENGTH,STACK
GETB P-LEXV,P-LEXWORDS
MUL P-LEXELEN,STACK
ADD PTR,STACK
MUL 2,STACK >LEN
SUB LEN,1
GETB P-LEXV,STACK >?TMP1
SUB LEN,2
GETB P-LEXV,STACK
ADD ?TMP1,STACK
PUT OOPS-TABLE,O-END,STACK
SET 'RESERVE-PTR,FALSE-VALUE
SET 'LEN,P-LEN
SET 'P-DIR,FALSE-VALUE
SET 'P-NCN,0
SET 'P-GETFLAGS,0
PUT P-ITBL,P-VERBN,0
?PRG119: DLESS? 'P-LEN,0 \?CND121
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND100
?CND121: GET P-LEXV,PTR >WRD
CALL2 BUZZER-WORD?,WRD
ZERO? STACK \FALSE
ZERO? WRD \?CTR126
CALL QUOTED-WORD?,PTR,VERB >WRD
ZERO? WRD \?CTR126
CALL2 NUMBER?,PTR >WRD
ZERO? WRD /?CCL127
?CTR126: ZERO? P-LEN \?CCL133
SET 'NW,0
JUMP ?CND131
?CCL133: ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
?CND131: EQUAL? WRD,W?TO \?CCL136
EQUAL? VERB,ACT?TELL,ACT?ASK \?CCL136
PUT P-ITBL,P-VERB,ACT?TELL
SET 'WRD,W?QUOTE
JUMP ?CND134
?CCL136: EQUAL? WRD,W?THEN \?CCL140
GRTR? P-LEN,0 \?CCL140
ZERO? VERB \?CCL140
ZERO? QUOTE-FLAG \?CCL140
PUT P-ITBL,P-VERB,ACT?TELL
PUT P-ITBL,P-VERBN,0
SET 'WRD,W?QUOTE
JUMP ?CND134
?CCL140: EQUAL? WRD,W?PERIOD \?CND134
EQUAL? LW,W?MR,W?MRS \?CND134
DEC 'P-NCN
ICALL CHANGE-LEXV,PTR,LW,TRUE-VALUE
SET 'WRD,LW
SET 'LW,0
?CND134: EQUAL? WRD,W?THEN,W?PERIOD,W?QUOTE \?CCL150
EQUAL? WRD,W?QUOTE \?CND151
GET P-LEXV,PTR
EQUAL? STACK,W?QUOTE \?CCL155
EQUAL? VERB,ACT?TELL,ACT?SAY \?CTR154
EQUAL? WINNER,PLAYER /?CCL155
?CTR154: CALL QUOTED-PHRASE?,PTR,VERB
ZERO? STACK /FALSE
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG119
?CCL155: ZERO? QUOTE-FLAG /?CCL164
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND151
?CCL164: SET 'QUOTE-FLAG,TRUE-VALUE
?CND151: ZERO? P-LEN /?PEN165
ADD PTR,P-LEXELEN >P-CONT
?PEN165: PUTB P-LEXV,P-LEXWORDS,P-LEN
JUMP ?CND100
?CCL150: CALL WT?,WRD,16,3 >VAL
ZERO? VAL /?CCL168
EQUAL? VERB,FALSE-VALUE,ACT?WALK,ACT?GO \?CCL168
EQUAL? LEN,1 /?CTR167
EQUAL? LEN,2 \?PRD174
EQUAL? VERB,ACT?WALK,ACT?GO /?CTR167
?PRD174: EQUAL? NW,W?THEN,W?PERIOD,W?QUOTE \?PRD177
GRTR? LEN,1 /?CTR167
?PRD177: ZERO? QUOTE-FLAG /?PRD180
EQUAL? LEN,2 \?PRD180
EQUAL? NW,W?QUOTE /?CTR167
?PRD180: GRTR? LEN,2 \?CCL168
EQUAL? NW,W?COMMA,W?AND \?CCL168
?CTR167: SET 'DIR,VAL
SET 'P-DIR-WORD,WRD
EQUAL? NW,W?COMMA,W?AND \?CND186
ADD PTR,P-LEXELEN
ICALL CHANGE-LEXV,STACK,W?THEN
?CND186: GRTR? LEN,2 /?CND123
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND100
?CCL168: CALL WT?,WRD,64,1 >VAL
ZERO? VAL /?CCL191
ZERO? VERB \?CCL191
SET 'P-PRSA-WORD,WRD
SET 'VERB,VAL
PUT P-ITBL,P-VERB,VAL
PUT P-ITBL,P-VERBN,P-VTBL
PUT P-VTBL,0,WRD
MUL PTR,2
ADD STACK,2 >X
GETB P-LEXV,X
PUTB P-VTBL,2,STACK
ADD X,1
GETB P-LEXV,STACK
PUTB P-VTBL,3,STACK
JUMP ?CND123
?CCL191: CALL WT?,WRD,8,0 >VAL
ZERO? VAL \?CTR194
EQUAL? WRD,W?ALL,W?EVERYTHING /?CTR194
EQUAL? WRD,W?BOTH,W?A /?CTR194
CALL WT?,WRD,32
ZERO? STACK \?CTR194
CALL WT?,WRD,128
ZERO? STACK /?CCL195
?CTR194: GRTR? P-LEN,1 \?CCL203
EQUAL? NW,W?OF \?CCL203
EQUAL? VERB,ACT?TAKE /?CCL203
ZERO? VAL \?CCL203
EQUAL? WRD,W?A /?CCL203
EQUAL? WRD,W?ALL,W?BOTH,W?EVERYTHING /?CCL203
PUT P-OFW,P-NCN,WRD
SET 'OF-FLAG,TRUE-VALUE
JUMP ?CND123
?CCL203: ZERO? VAL /?CCL211
ZERO? P-LEN /?CTR210
EQUAL? NW,W?THEN,W?PERIOD \?CCL211
?CTR210: SET 'P-END-ON-PREP,TRUE-VALUE
LESS? P-NCN,2 \?CND123
PUT P-ITBL,P-PREP1,VAL
PUT P-ITBL,P-PREP1N,WRD
JUMP ?CND123
?CCL211: EQUAL? P-NCN,2 \?CCL219
PRINTI "[There are too many nouns in that sentence.]"
CRLF
RFALSE
?CCL219: INC 'P-NCN
SET 'P-ACT,VERB
CALL CLAUSE,PTR,VAL,WRD >PTR
ZERO? PTR /FALSE
LESS? PTR,0 \?CND123
SET 'QUOTE-FLAG,FALSE-VALUE
?CND100: PUT OOPS-TABLE,O-PTR,FALSE-VALUE
ZERO? DIR /?CND236
SET 'PRSA,V?WALK
SET 'P-WALK-DIR,DIR
SET 'AGAIN-DIR,DIR
SET 'PRSO,DIR
SET 'P-OFLAG,FALSE-VALUE
RTRUE
?CCL195: EQUAL? WRD,W?OF \?CCL225
ZERO? OF-FLAG /?CTR227
EQUAL? NW,W?PERIOD,W?THEN \?CCL228
?CTR227: ICALL2 CANT-USE,PTR
RFALSE
?CCL228: SET 'OF-FLAG,FALSE-VALUE
?CND123: SET 'LW,WRD
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG119
?CCL225: CALL WT?,WRD,4
ZERO? STACK \?CND123
EQUAL? VERB,ACT?TELL \?CCL233
CALL WT?,WRD,64
ZERO? STACK /?CCL233
ICALL1 WAY-TO-TALK
RFALSE
?CCL233: ICALL2 CANT-USE,PTR
RFALSE
?CCL127: ICALL2 UNKNOWN-WORD,PTR
RFALSE
?CND236: SET 'P-WALK-DIR,FALSE-VALUE
SET 'AGAIN-DIR,FALSE-VALUE
ZERO? P-OFLAG /?CND238
CALL1 ORPHAN-MERGE
ZERO? STACK /?CND238
SET 'WINNER,OWINNER
?CND238: CALL1 SYNTAX-CHECK
ZERO? STACK /FALSE
CALL1 SNARF-OBJECTS
ZERO? STACK /FALSE
CALL1 MANY-CHECK
ZERO? STACK /FALSE
GETB P-SYNTAX,P-SLOC1
CALL ITAKE-CHECK,P-PRSO,STACK
ZERO? STACK /FALSE
GETB P-SYNTAX,P-SLOC2
CALL ITAKE-CHECK,P-PRSI,STACK
ZERO? STACK /FALSE
RTRUE
.FUNCT PCLEAR
SET 'P-CONT,FALSE-VALUE
SET 'QUOTE-FLAG,FALSE-VALUE
RFALSE
.FUNCT CHANGE-LEXV,PTR,WRD,PTRS?,X,Y,Z
ASSIGNED? 'PTRS? \?CND1
SUB PTR,P-LEXELEN
MUL 2,STACK
ADD 2,STACK >X
GETB P-LEXV,X >Y
MUL 2,PTR
ADD 2,STACK >Z
PUTB P-LEXV,Z,Y
PUTB AGAIN-LEXV,Z,Y
ADD 1,X
GETB P-LEXV,STACK >Y
MUL 2,PTR
ADD 3,STACK >Z
PUTB P-LEXV,Z,Y
PUTB AGAIN-LEXV,Z,Y
?CND1: PUT P-LEXV,PTR,WRD
PUT AGAIN-LEXV,PTR,WRD
RTRUE
.FUNCT WT?,PTR,BIT,B1,OFFS,TYP
ASSIGNED? 'B1 /?CND1
SET 'B1,5
?CND1: SET 'OFFS,P-P1OFF
GETB PTR,P-PSOFF >TYP
BTST TYP,BIT \FALSE
GRTR? B1,4 /TRUE
BAND TYP,P-P1BITS >TYP
EQUAL? TYP,B1 /?CND7
INC 'OFFS
?CND7: GETB PTR,OFFS
RSTACK
.FUNCT CLAUSE,PTR,VAL,WRD,FIRST??,ANDFLG,LW,OFF,NUM,NW,?TMP1
SET 'FIRST??,TRUE-VALUE
SUB P-NCN,1
MUL STACK,2 >OFF
ZERO? VAL /?CCL3
ADD P-PREP1,OFF >NUM
PUT P-ITBL,NUM,VAL
ADD NUM,1
PUT P-ITBL,STACK,WRD
ADD PTR,P-LEXELEN >PTR
JUMP ?CND1
?CCL3: INC 'P-LEN
?CND1: ZERO? P-LEN \?CND4
DEC 'P-NCN
RETURN -1
?CND4: ADD P-NC1,OFF >NUM
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,NUM,STACK
GET P-LEXV,PTR
EQUAL? STACK,W?THE,W?A,W?AN /?CCL7
GET P-LEXV,PTR
EQUAL? STACK,W?$BUZZ \?PRG10
?CCL7: GET P-ITBL,NUM
ADD STACK,4
PUT P-ITBL,NUM,STACK
?PRG10: DLESS? 'P-LEN,0 \?CND12
ADD NUM,1 >?TMP1
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
RETURN -1
?CND12: GET P-LEXV,PTR >WRD
CALL2 BUZZER-WORD?,WRD
ZERO? STACK \FALSE
ZERO? WRD \?CTR17
CALL2 QUOTED-WORD?,PTR >WRD
ZERO? WRD \?CTR17
CALL2 NUMBER?,PTR >WRD
ZERO? WRD /?CCL18
?CTR17: ZERO? P-LEN \?CCL24
SET 'NW,0
JUMP ?CND22
?CCL24: ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
ZERO? NW \?CND22
ADD PTR,P-LEXELEN
CALL2 NUMBER?,STACK >NW
?CND22: EQUAL? WRD,W?QUOTE \?CCL29
EQUAL? P-ACT,ACT?TELL,ACT?SAY,ACT?NAME /?CCL29
CALL QUOTED-PHRASE?,PTR,P-ACT
ZERO? STACK /FALSE
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG10
?CCL29: EQUAL? WRD,W?PERIOD \?CCL36
EQUAL? LW,W?MR,W?MRS \?CCL36
SET 'LW,0
JUMP ?CND14
?CCL36: EQUAL? WRD,W?AND,W?COMMA \?CCL40
SET 'ANDFLG,TRUE-VALUE
JUMP ?CND14
?CCL40: EQUAL? WRD,W?ALL,W?BOTH,W?EVERYTHING \?CCL42
EQUAL? NW,W?OF \?CND14
DEC 'P-LEN
ADD PTR,P-LEXELEN >PTR
JUMP ?CND14
?CCL42: EQUAL? WRD,W?THEN,W?PERIOD /?CTR45
CALL WT?,WRD,8
ZERO? STACK /?CCL46
GET P-ITBL,P-VERB
ZERO? STACK /?CCL46
ZERO? FIRST?? \?CCL46
?CTR45: INC 'P-LEN
ADD NUM,1 >?TMP1
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
SUB PTR,P-LEXELEN
RSTACK
?CCL46: ZERO? ANDFLG /?CCL53
GET P-ITBL,P-VERBN
ZERO? STACK /?CTR52
CALL2 VERB-DIR-ONLY?,WRD
ZERO? STACK /?CCL53
?CTR52: SUB PTR,4 >PTR
ADD PTR,2
ICALL CHANGE-LEXV,STACK,W?THEN
ADD P-LEN,2 >P-LEN
JUMP ?CND14
?CCL53: CALL WT?,WRD,128
ZERO? STACK /?CCL59
GRTR? P-LEN,0 \?CCL62
EQUAL? NW,W?OF \?CCL62
EQUAL? WRD,W?ALL,W?EVERYTHING /?CCL62
SUB P-NCN,1
PUT P-OFW,STACK,WRD
JUMP ?CND14
?CCL62: CALL WT?,WRD,32
ZERO? STACK /?CCL66
ZERO? NW /?CCL66
CALL WT?,NW,128
ZERO? STACK \?CND14
?CCL66: ZERO? ANDFLG \?CCL71
EQUAL? NW,W?BUT,W?EXCEPT /?CCL71
EQUAL? NW,W?AND,W?COMMA /?CCL71
ADD NUM,1 >?TMP1
ADD PTR,2
MUL STACK,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
RETURN PTR
?CCL71: SET 'ANDFLG,FALSE-VALUE
JUMP ?CND14
?CCL59: CALL WT?,WRD,32
ZERO? STACK \?CND14
CALL WT?,WRD,4
ZERO? STACK \?CND14
ZERO? ANDFLG /?CCL78
GET P-ITBL,P-VERB
ZERO? STACK \?CCL78
SUB PTR,4 >PTR
ADD PTR,2
ICALL CHANGE-LEXV,STACK,W?THEN
ADD P-LEN,2 >P-LEN
?CND14: SET 'LW,WRD
SET 'FIRST??,FALSE-VALUE
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG10
?CCL78: CALL WT?,WRD,8
ZERO? STACK \?CND14
ICALL2 CANT-USE,PTR
RFALSE
?CCL18: ICALL2 UNKNOWN-WORD,PTR
RFALSE
.FUNCT SPOKEN-TO,WHO
EQUAL? WHO,QCONTEXT \?CCL2
EQUAL? HERE,QCONTEXT-ROOM /TRUE
?CCL2: ICALL2 SEE-CHARACTER,WHO
PRINTI "[spoken to "
ICALL2 THE-PRINT,WHO
PRINT BRACKET
RTRUE
.FUNCT ANYONE-HERE?,OBJ
CALL1 QCONTEXT-GOOD? >OBJ
ZERO? OBJ /?PRD4
RETURN OBJ
?PRD4: FIRST? HERE >OBJ /?PRG5
RETURN OBJ
?PRG5: FSET? OBJ,PERSON \?CCL9
EQUAL? OBJ,PLAYER,WINNER /?CCL9
FSET? OBJ,PLURAL /?CCL9
RETURN OBJ
?CCL9: NEXT? OBJ >OBJ /?PRG5
RETURN OBJ
.FUNCT SEE-CHARACTER,OBJ
FSET? OBJ,FEMALE \?CCL3
SET 'P-HER-OBJECT,OBJ
JUMP ?CND1
?CCL3: SET 'P-HIM-OBJECT,OBJ
?CND1: SET 'QCONTEXT,OBJ
LOC OBJ >QCONTEXT-ROOM
RFALSE
.FUNCT QCONTEXT-GOOD?
ZERO? QCONTEXT /FALSE
FSET? QCONTEXT,PERSON \FALSE
EQUAL? HERE,QCONTEXT-ROOM \FALSE
CALL2 VISIBLE?,QCONTEXT
ZERO? STACK /FALSE
RETURN QCONTEXT
.FUNCT THIS-IS-IT,OBJ
ZERO? OBJ /FALSE
EQUAL? OBJ,PLAYER,ME,INTNUM /FALSE
EQUAL? OBJ,INTDIR,LEFT,RIGHT /FALSE
FSET? OBJ,FEMALE \?CCL8
SET 'P-HER-OBJECT,OBJ
RFALSE
?CCL8: FSET? OBJ,PERSON \?CCL10
SET 'P-HIM-OBJECT,OBJ
RFALSE
?CCL10: FSET? OBJ,PLURAL \?CCL12
SET 'P-THEM-OBJECT,OBJ
RFALSE
?CCL12: SET 'P-IT-OBJECT,OBJ
RFALSE
.FUNCT FAKE-ORPHAN,TMP,X
ICALL ORPHAN,P-SYNTAX,FALSE-VALUE
ICALL1 BE-SPECIFIC
GET P-OTBL,P-VERBN >TMP
ZERO? TMP \?CCL3
PRINTB W?TELL
JUMP ?CND1
?CCL3: GETB P-VTBL,2
ZERO? STACK \?CCL5
GET TMP,0
PRINTB STACK
JUMP ?CND1
?CCL5: GETB TMP,2 >X
GETB TMP,3
ICALL WORD-PRINT,X,STACK
PUTB P-VTBL,2,0
?CND1: SET 'P-OFLAG,TRUE-VALUE
SET 'P-WON,FALSE-VALUE
PRINTR "?]"
.FUNCT PERFORM,A,O,I,V,WHO,OA,OO,OI,ONP,X
EQUAL? WINNER,PLAYER /?CND1
FSET? WINNER,PERSON /?CND1
ICALL2 NOT-LIKELY,WINNER
PRINT STR?509
ICALL1 PCLEAR
RETURN 2
?CND1: SET 'OA,PRSA
SET 'OO,PRSO
SET 'OI,PRSI
SET 'ONP,NOW-PRSI?
CALL1 ANYONE-HERE? >WHO
SET 'PRSA,A
EQUAL? WINNER,PLAYER /?CCL9
INTBL? PRSA,GAME-VERBS,NGVERBS >X \?CCL9
PRINTC 91
PRINT CANT
PRINTI "tell characters to do that.]"
CRLF
RETURN 2
?CCL9: ZERO? LIT? \?CCL15
INTBL? PRSA,SEEVERBS,NSVERBS >X \?CCL15
ICALL1 TOO-DARK
RETURN 2
?CCL15: EQUAL? A,V?WALK /?CND7
EQUAL? WINNER,PLAYER \?CCL23
EQUAL? PRSA,V?WHO,V?WHAT,V?WHERE \?CCL23
ZERO? WHO /?CCL23
SET 'WINNER,WHO
ICALL2 SPOKEN-TO,WHO
JUMP ?CND21
?CCL23: EQUAL? WINNER,PLAYER \?CND21
EQUAL? O,ME \?CND21
EQUAL? PRSA,V?TELL,V?TELL-ABOUT,V?ASK-ABOUT /?CCL27
EQUAL? PRSA,V?ASK-FOR,V?QUESTION,V?REPLY /?CCL27
EQUAL? PRSA,V?THANK,V?YELL,V?HELLO /?CCL27
EQUAL? PRSA,V?GOODBYE,V?SAY,V?ALARM \?CND21
?CCL27: ZERO? WHO \?CND35
ICALL1 TALK-TO-SELF
RETURN 2
?CND35: SET 'WINNER,WHO
ICALL2 SPOKEN-TO,WHO
?CND21: EQUAL? YOU,I,O \?CND39
EQUAL? WINNER,PLAYER \?CCL43
ZERO? WHO \?CCL46
ICALL1 TALK-TO-SELF
RETURN 2
?CCL46: SET 'WINNER,WHO
ICALL2 SPOKEN-TO,WHO
JUMP ?CND41
?CCL43: ICALL2 SEE-CHARACTER,WINNER
SET 'WHO,WINNER
?CND41: EQUAL? I,YOU \?CND49
SET 'I,WHO
?CND49: EQUAL? O,YOU \?CND39
SET 'O,WHO
?CND39: EQUAL? IT,I,O \?CND53
CALL2 ACCESSIBLE?,P-IT-OBJECT
ZERO? STACK \?CND53
ZERO? I \?CCL59
ICALL1 FAKE-ORPHAN
RETURN 2
?CCL59: ICALL2 CANT-SEE-ANY,P-IT-OBJECT
RETURN 2
?CND53: EQUAL? THEM,I,O \?CND62
CALL2 VISIBLE?,P-THEM-OBJECT
ZERO? STACK /?CCL66
EQUAL? THEM,O \?CND67
SET 'O,P-THEM-OBJECT
?CND67: EQUAL? THEM,I \?CND62
SET 'I,P-THEM-OBJECT
?CND62: EQUAL? HER,I,O \?CND76
CALL2 VISIBLE?,P-HER-OBJECT
ZERO? STACK /?CCL80
EQUAL? P-HER-OBJECT,WINNER \?CND81
CALL2 NO-OTHER?,TRUE-VALUE
ZERO? STACK /?CND81
RETURN 2
?CCL66: ZERO? I \?CCL73
ICALL1 FAKE-ORPHAN
RETURN 2
?CCL73: ICALL2 CANT-SEE-ANY,P-THEM-OBJECT
RETURN 2
?CND81: EQUAL? HER,O \?CND87
SET 'O,P-HER-OBJECT
?CND87: EQUAL? HER,I \?CND76
SET 'I,P-HER-OBJECT
?CND76: EQUAL? HIM,I,O \?CND96
CALL2 VISIBLE?,P-HIM-OBJECT
ZERO? STACK /?CCL100
EQUAL? P-HIM-OBJECT,WINNER \?CND101
CALL1 NO-OTHER?
ZERO? STACK /?CND101
RETURN 2
?CCL80: ZERO? I \?CCL93
ICALL1 FAKE-ORPHAN
RETURN 2
?CCL93: ICALL2 CANT-SEE-ANY,P-HER-OBJECT
RETURN 2
?CND101: EQUAL? HIM,O \?CND107
SET 'O,P-HIM-OBJECT
?CND107: EQUAL? HIM,I \?CND96
SET 'I,P-HIM-OBJECT
?CND96: EQUAL? O,IT \?CND116
SET 'O,P-IT-OBJECT
?CND116: EQUAL? I,IT \?CND7
SET 'I,P-IT-OBJECT
?CND7: SET 'PRSI,I
SET 'PRSO,O
SET 'V,FALSE-VALUE
EQUAL? A,V?WALK /?CND120
EQUAL? NOT-HERE-OBJECT,PRSO,PRSI \?CND120
CALL NOT-HERE-OBJECT-F >V
ZERO? V /?CND120
SET 'P-WON,FALSE-VALUE
?CND120: EQUAL? A,V?WALK /?CND126
ICALL2 THIS-IS-IT,PRSI
ICALL2 THIS-IS-IT,PRSO
?CND126: SET 'O,PRSO
SET 'I,PRSI
ZERO? V \?CND128
GETP WINNER,P?ACTION
CALL STACK,M-WINNER >V
?CND128: ZERO? V \?CND130
LOC WINNER
GETP STACK,P?ACTION
CALL STACK,M-BEG >V
?CND130: ZERO? V \?CND132
GET PREACTIONS,A
CALL STACK >V
?CND132: ZERO? V \?CND134
EQUAL? A,V?TELL-ABOUT,V?ASK-ABOUT,V?ASK-FOR /?CND134
SET 'NOW-PRSI?,TRUE-VALUE
ZERO? I /?CND137
EQUAL? A,V?WALK /?CND137
LOC I
ZERO? STACK /?CND137
LOC I
GETP STACK,P?CONTFCN >V
ZERO? V /?CND137
CALL V,M-CONT >V
?CND137: SET 'NOW-PRSI?,FALSE-VALUE
ZERO? V \?CND144
ZERO? O /?CND144
EQUAL? A,V?WALK /?CND144
LOC O
ZERO? STACK /?CND144
LOC O
GETP STACK,P?CONTFCN >V
ZERO? V /?CND144
CALL V,M-CONT >V
?CND144: SET 'NOW-PRSI?,TRUE-VALUE
ZERO? V \?CND134
ZERO? I /?CND134
GETP I,P?ACTION
CALL STACK >V
?CND134: SET 'NOW-PRSI?,FALSE-VALUE
ZERO? V \?CND155
ZERO? O /?CND155
EQUAL? A,V?WALK /?CND155
GETP O,P?ACTION
CALL STACK >V
?CND155: ZERO? V \?CND159
GET ACTIONS,A
CALL STACK >V
?CND159: EQUAL? V,M-FATAL /?CND161
LOC WINNER
GETP STACK,P?ACTION
ICALL STACK,M-END
?CND161: SET 'PRSA,OA
SET 'PRSO,OO
SET 'PRSI,OI
SET 'NOW-PRSI?,ONP
RETURN V
?CCL100: ZERO? I \?CCL113
ICALL1 FAKE-ORPHAN
RETURN 2
?CCL113: ICALL2 CANT-SEE-ANY,P-HIM-OBJECT
RETURN 2
.FUNCT NO-OTHER?,FEMALE?,OBJ
FIRST? HERE >OBJ \?CND1
?PRG3: EQUAL? OBJ,WINNER /?CND5
FSET? OBJ,PERSON \?CND5
ZERO? FEMALE? /?CCL10
FSET? OBJ,FEMALE /?CND1
JUMP ?CND5
?CCL10: FSET? OBJ,FEMALE \?CND1
?CND5: NEXT? OBJ >OBJ /?PRG3
?CND1: ZERO? OBJ \FALSE
ICALL2 PERPLEXED,WINNER
PRINTR "Who are you talking about?"""
.FUNCT BUZZER-WORD?,WORD,TBL,LEN,X
GET Q-BUZZES,0 >LEN
INTBL? WORD,Q-BUZZES+2,LEN >TBL \?CND1
ICALL TO-DO-THING-USE,STR?510,STR?511
RTRUE
?CND1: GET N-BUZZES,0 >LEN
INTBL? WORD,N-BUZZES+2,LEN >TBL \?CND3
ICALL1 NYMPH-APPEARS
PRINT DONT
PRINTI "need to use that "
PRINTD INTNUM
ICALL1 TO-COMPLETE
RTRUE
?CND3: GET SWEAR-WORDS,0 >LEN
INTBL? WORD,SWEAR-WORDS+2,LEN >TBL \?CND5
GET STATS,INTELLIGENCE >WORD
LESS? WORD,1 \?CND7
PRINTR "Such language betrays your low intelligence."
?CND7: PRINTI "You suddenly feel less intelligent."
CRLF
ICALL UPDATE-STAT,-1,INTELLIGENCE,TRUE-VALUE
RTRUE
?CND5: CALL1 SEE-COLOR?
ZERO? STACK \?CND9
GET COLOR-WORDS,0 >LEN
INTBL? WORD,COLOR-WORDS+2,LEN >TBL \?CND9
PRINT DONT
PRINTI "see the color "
PRINTB WORD
PRINTR " here; or any other colors, for that matter."
?CND9: GET MAGIC-WORDS,0 >LEN
?PRG13: GET MAGIC-WORDS,LEN >TBL
GET TBL,0
EQUAL? WORD,STACK \?CND15
GET TBL,2
ZERO? STACK \?CND15
PRINTI "[This story won't recognize the word """
PRINTB WORD
PRINTR ".""]"
?CND15: DLESS? 'LEN,2 \?PRG13
EQUAL? WORD,W?QUIETLY,W?SLOWLY,W?CAREFULLY /?CCL22
EQUAL? WORD,W?CLOSELY,W?QUICKLY,W?RAPIDLY \?CND21
?CCL22: ICALL1 NYMPH-APPEARS
PRINTI "Adverbs (such as """
PRINTB WORD
PRINTI """) aren't needed"
ICALL1 TO-COMPLETE
RTRUE
?CND21: EQUAL? WORD,W?XYZZY,W?PLUGH,W?PLOVER /?CCL26
EQUAL? WORD,W?YOHO,W?ULYSSES,W?ODYSSEUS \FALSE
?CCL26: PRINT STR?512
CRLF
RTRUE
.FUNCT VERB-DIR-ONLY?,WRD
CALL WT?,WRD,128
ZERO? STACK \FALSE
CALL WT?,WRD,32
ZERO? STACK \FALSE
CALL WT?,WRD,16
ZERO? STACK \TRUE
CALL WT?,WRD,64
ZERO? STACK /FALSE
RTRUE
.FUNCT INBUF-ADD,LEN,BEG,SLOT,DBEG,CTR,TMP,?TMP1
GET OOPS-TABLE,O-END >TMP
ZERO? TMP /?CCL3
SET 'DBEG,TMP
JUMP ?CND1
?CCL3: GET OOPS-TABLE,O-LENGTH >TMP
GETB AGAIN-LEXV,TMP >?TMP1
ADD TMP,1
GETB AGAIN-LEXV,STACK
ADD ?TMP1,STACK >DBEG
?CND1: ADD DBEG,LEN
PUT OOPS-TABLE,O-END,STACK
?PRG4: ADD DBEG,CTR >?TMP1
ADD BEG,CTR
GETB P-INBUF,STACK
PUTB OOPS-INBUF,?TMP1,STACK
INC 'CTR
EQUAL? CTR,LEN \?PRG4
PUTB AGAIN-LEXV,SLOT,DBEG
SUB SLOT,1
PUTB AGAIN-LEXV,STACK,LEN
RTRUE
.FUNCT NUMBER?,PTR,SUM,TIM,EXC,CNT,BPTR,CHR,CCTR,TMP,NW,?TMP1
ADD PTR,PTR
ADD P-LEXV,STACK >TMP
GETB TMP,3 >BPTR
GETB TMP,2 >CNT
GRTR? CNT,3 \?PRG3
SET 'CNT,3
?PRG3: DLESS? 'CNT,0 /?REP4
GETB P-INBUF,BPTR >CHR
EQUAL? CHR,58 \?CCL9
ZERO? EXC \FALSE
SET 'TIM,SUM
SET 'SUM,0
JUMP ?CND7
?CCL9: EQUAL? CHR,45 \?CCL13
ZERO? TIM \FALSE
SET 'EXC,SUM
SET 'SUM,0
JUMP ?CND7
?CCL13: GRTR? SUM,9999 /FALSE
GRTR? CHR,47 \FALSE
LESS? CHR,58 \FALSE
MUL SUM,10 >?TMP1
SUB CHR,48
ADD ?TMP1,STACK >SUM
?CND7: INC 'BPTR
JUMP ?PRG3
?REP4: ICALL CHANGE-LEXV,PTR,W?INTNUM
ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
GRTR? SUM,9999 /FALSE
ZERO? EXC /?CCL26
SET 'P-EXCHANGE,EXC
JUMP ?CND22
?CCL26: ZERO? TIM /?CCL28
SET 'P-EXCHANGE,0
GRTR? TIM,23 /FALSE
GRTR? TIM,19 /?CND29
GRTR? TIM,12 /FALSE
GRTR? TIM,7 /?CND29
ADD 12,TIM >TIM
?CND29: MUL TIM,60
ADD SUM,STACK >SUM
JUMP ?CND22
?CCL28: SET 'P-EXCHANGE,0
?CND22: SET 'P-NUMBER,SUM
RETURN W?INTNUM
.FUNCT ORPHAN-MERGE,WHICH,ADJ,TEMP,VERB,BEG,END,WRD,X
SET 'WHICH,1
SET 'P-OFLAG,FALSE-VALUE
GET P-ITBL,P-VERBN
GET STACK,0 >WRD
GET P-OTBL,P-VERB >X
CALL WT?,WRD,64,1
EQUAL? STACK,X /?CTR2
CALL WT?,WRD,32
ZERO? STACK /?CCL3
?CTR2: SET 'ADJ,TRUE-VALUE
JUMP ?CND1
?CCL3: CALL WT?,WRD,128,0
ZERO? STACK /?CND1
ZERO? P-NCN \?CND1
PUT P-ITBL,P-VERB,0
PUT P-ITBL,P-VERBN,0
ADD P-LEXV,2
PUT P-ITBL,P-NC1,STACK
ADD P-LEXV,6
PUT P-ITBL,P-NC1L,STACK
SET 'P-NCN,1
?CND1: GET P-ITBL,P-VERB >VERB
ZERO? VERB /?CCL11
ZERO? ADJ \?CCL11
GET P-OTBL,P-VERB
EQUAL? VERB,STACK \FALSE
?CCL11: EQUAL? P-NCN,2 /FALSE
GET P-OTBL,P-NC1
EQUAL? STACK,1 \?CCL18
GET P-ITBL,P-PREP1 >TEMP
ZERO? TEMP /?CTR20
GET P-OTBL,P-PREP1
EQUAL? TEMP,STACK \FALSE
?CTR20: ZERO? ADJ /?CCL26
ADD P-LEXV,2
PUT P-OTBL,P-NC1,STACK
GET P-ITBL,P-NC1L
ZERO? STACK \?CND27
ADD P-LEXV,6
PUT P-ITBL,P-NC1L,STACK
?CND27: ZERO? P-NCN \?CND24
SET 'P-NCN,1
JUMP ?CND24
?CCL26: GET P-ITBL,P-NC1
PUT P-OTBL,P-NC1,STACK
?CND24: GET P-ITBL,P-NC1L
PUT P-OTBL,P-NC1L,STACK
JUMP ?CND9
?CCL18: GET P-OTBL,P-NC2
EQUAL? STACK,1 \?CCL32
SET 'WHICH,2
GET P-ITBL,P-PREP1 >TEMP
ZERO? TEMP /?CTR34
GET P-OTBL,P-PREP2
EQUAL? TEMP,STACK \FALSE
?CTR34: ZERO? ADJ /?CND38
ADD P-LEXV,2
PUT P-ITBL,P-NC1,STACK
GET P-ITBL,P-NC1L
ZERO? STACK \?CND38
ADD P-LEXV,6
PUT P-ITBL,P-NC1L,STACK
?CND38: GET P-ITBL,P-NC1
PUT P-OTBL,P-NC2,STACK
GET P-ITBL,P-NC1L
PUT P-OTBL,P-NC2L,STACK
SET 'P-NCN,2
JUMP ?CND9
?CCL32: ZERO? P-ACLAUSE /?CND9
EQUAL? P-NCN,1 /?CCL45
ZERO? ADJ \?CCL45
SET 'P-ACLAUSE,FALSE-VALUE
RFALSE
?CCL45: EQUAL? P-ACLAUSE,P-NC1 /?CND48
SET 'WHICH,2
?CND48: GET P-ITBL,P-NC1 >BEG
ZERO? ADJ /?CND50
ADD P-LEXV,2 >BEG
SET 'ADJ,FALSE-VALUE
?CND50: GET P-ITBL,P-NC1L >END
?PRG52: GET BEG,0 >WRD
EQUAL? BEG,END \?CCL56
ZERO? ADJ /?CCL59
ICALL2 CLAUSE-WIN,ADJ
JUMP ?CND9
?CCL59: SET 'P-ACLAUSE,FALSE-VALUE
RFALSE
?CCL56: EQUAL? WRD,W?ALL,W?EVERYTHING,W?ONE /?CTR60
EQUAL? WRD,W?BOTH /?CTR60
GETB WRD,P-PSOFF
BTST STACK,32 \?CCL61
ZERO? ADJ \?CCL61
?CTR60: SET 'ADJ,WRD
JUMP ?CND54
?CCL61: EQUAL? WRD,W?ONE \?CCL68
ICALL2 CLAUSE-WIN,ADJ
JUMP ?CND9
?CCL68: GETB WRD,P-PSOFF
BTST STACK,128 \?CND54
ADD BEG,P-WORDLEN
EQUAL? STACK,END \?CND54
EQUAL? WRD,P-ANAM \?CCL74
ICALL2 CLAUSE-WIN,ADJ
JUMP ?CND9
?CCL74: ICALL1 CLAUSE-WIN
?CND9: GET P-OVTBL,0
PUT P-VTBL,0,STACK
GETB P-OVTBL,2
PUTB P-VTBL,2,STACK
GETB P-OVTBL,3
PUTB P-VTBL,3,STACK
PUT P-OTBL,P-VERBN,P-VTBL
PUTB P-VTBL,2,0
COPYT P-OTBL,P-ITBL,P-ITBLLEN
SET 'P-MERGED,WHICH
RTRUE
?CND54: ADD BEG,P-WORDLEN >BEG
ZERO? END \?PRG52
SET 'END,BEG
SET 'P-NCN,1
SUB BEG,4
PUT P-ITBL,P-NC1,STACK
PUT P-ITBL,P-NC1L,BEG
JUMP ?PRG52
.FUNCT CLAUSE-WIN,ADJ,X
ZERO? ADJ /?CCL3
SET 'P-LASTADJ,ADJ
GET P-OTBL,P-VERB
PUT P-ITBL,P-VERB,STACK
JUMP ?CND1
?CCL3: SET 'ADJ,TRUE-VALUE
?CND1: SET 'X,P-OCL2
EQUAL? P-ACLAUSE,P-NC1 \?CND4
SET 'X,P-OCL1
?CND4: ADD P-ACLAUSE,1
ICALL CLAUSE-COPY,P-OTBL,P-OTBL,P-ACLAUSE,STACK,X,ADJ
GET P-OTBL,P-NC2
ZERO? STACK /?CND6
SET 'P-NCN,2
?CND6: SET 'P-ACLAUSE,FALSE-VALUE
RTRUE
.FUNCT WORD-PRINT,CNT,BUF
GRTR? BUF,1 \FALSE
?PRG3: DLESS? 'CNT,0 /FALSE
GETB P-INBUF,BUF
PRINTC STACK
INC 'BUF
JUMP ?PRG3
.FUNCT UNKNOWN-WORD,PTR,CNT,MSG,LEN,OFFSET,CHAR
PUT OOPS-TABLE,O-PTR,PTR
CALL2 PICK-NEXT,UNKNOWN-MSGS >MSG
PRINTC 91
GET MSG,0
PRINT STACK
MUL PTR,2
ADD P-LEXV,STACK >OFFSET
GETB OFFSET,2 >LEN
GETB OFFSET,3 >OFFSET
GRTR? OFFSET,1 \?CND1
?PRG3: DLESS? 'LEN,0 /?CND1
GETB P-INBUF,OFFSET >CHAR
PRINTC CHAR
INC 'OFFSET
LESS? CNT,12 \?PRG3
INC 'CNT
PUTB LAST-BAD,CNT,CHAR
JUMP ?PRG3
?CND1: PUTB LAST-BAD,0,CNT
SET 'QUOTE-FLAG,FALSE-VALUE
SET 'P-OFLAG,FALSE-VALUE
GET MSG,1
PRINT STACK
PRINTR "]"
.FUNCT SYNTAX-CHECK,DRIVE1,DRIVE2,SYN,LEN,NUM,OBJ,PREP,VERB,X,Y,?TMP1
GET P-ITBL,P-VERB >VERB
ZERO? VERB \?CND1
ICALL2 NOT-IN-SENTENCE,STR?513
RFALSE
?CND1: SUB 255,VERB
GET VERBS,STACK >SYN
GETB SYN,0 >LEN
INC 'SYN
?PRG3: GETB SYN,P-SBITS
BAND STACK,P-SONUMS >NUM
GET P-ITBL,P-PREP1 >PREP
GETB SYN,P-SPREP1 >X
GRTR? P-NCN,NUM /?CND5
LESS? NUM,1 /?CCL8
ZERO? P-NCN \?CCL8
EQUAL? PREP,0,X \?CCL8
SET 'DRIVE1,SYN
JUMP ?CND5
?CCL8: GET P-ITBL,P-PREP1
EQUAL? X,STACK \?CND5
EQUAL? NUM,2 \?CCL15
EQUAL? P-NCN,1 \?CCL15
SET 'DRIVE2,SYN
?CND5: DLESS? 'LEN,1 \?CND19
ZERO? DRIVE1 \?REP4
ZERO? DRIVE2 \?REP4
ICALL1 DONT-UNDERSTAND
RFALSE
?CCL15: GETB SYN,P-SPREP2 >?TMP1
GET P-ITBL,P-PREP2
EQUAL? ?TMP1,STACK \?CND5
SET 'P-SYNTAX,SYN
GETB SYN,P-SACTION >PRSA
RTRUE
?CND19: ADD SYN,P-SYNLEN >SYN
JUMP ?PRG3
?REP4: ZERO? DRIVE1 /?CND25
GETB DRIVE1,P-SFWIM1 >X
GETB DRIVE1,P-SLOC1 >Y
GETB DRIVE1,P-SPREP1
CALL GWIM,X,Y,STACK >OBJ
ZERO? OBJ /?CND25
PUT P-PRSO,P-MATCHLEN,1
PUT P-PRSO,1,OBJ
SET 'P-SYNTAX,DRIVE1
GETB DRIVE1,P-SACTION >PRSA
RTRUE
?CND25: ZERO? DRIVE2 /?CCL31
GETB DRIVE2,P-SFWIM2 >X
GETB DRIVE2,P-SLOC2 >Y
GETB DRIVE2,P-SPREP2
CALL GWIM,X,Y,STACK >OBJ
ZERO? OBJ /?CND29
PUT P-PRSI,P-MATCHLEN,1
PUT P-PRSI,1,OBJ
SET 'P-SYNTAX,DRIVE2
GETB DRIVE2,P-SACTION >PRSA
RTRUE
?CCL31: EQUAL? VERB,ACT?FIND \?CND29
ICALL1 DO-IT-YOURSELF
RFALSE
?CND29: EQUAL? WINNER,PLAYER \?CCL37
ICALL ORPHAN,DRIVE1,DRIVE2
PRINTI "[Wh"
JUMP ?CND35
?CCL37: PRINTI "[Your command wasn't complete. Next time, type wh"
?CND35: EQUAL? VERB,ACT?WALK,ACT?GO \?CCL40
PRINTI "ere"
JUMP ?CND38
?CCL40: ZERO? DRIVE1 /?PRD44
GETB DRIVE1,P-SFWIM1
EQUAL? STACK,PERSON /?CTR41
?PRD44: ZERO? DRIVE2 /?CCL42
GETB DRIVE2,P-SFWIM2
EQUAL? STACK,PERSON \?CCL42
?CTR41: PRINTI "om"
JUMP ?CND38
?CCL42: PRINTI "at"
?CND38: EQUAL? WINNER,PLAYER \?CCL51
PRINTI " do you want"
JUMP ?CND49
?CCL51: PRINTI " you want "
ICALL2 THE-PRINT,WINNER
?CND49: PRINT STO
ICALL1 VERB-PRINT
ZERO? DRIVE2 /?CND52
ICALL CLAUSE-PRINT,P-NC1,P-NC1L
?CND52: SET 'P-END-ON-PREP,FALSE-VALUE
ZERO? DRIVE1 /?CCL56
GETB DRIVE1,P-SPREP1
JUMP ?CND54
?CCL56: GETB DRIVE2,P-SPREP2
?CND54: ICALL2 PREP-PRINT,STACK
EQUAL? WINNER,PLAYER \?CCL59
SET 'P-OFLAG,TRUE-VALUE
PRINTI "?]"
CRLF
RFALSE
?CCL59: SET 'P-OFLAG,FALSE-VALUE
PRINTI ".]"
CRLF
RFALSE
.FUNCT VERB-PRINT,TMP,X
GET P-ITBL,P-VERBN >TMP
ZERO? TMP \?CCL3
PRINTB W?TELL
RTRUE
?CCL3: GETB P-VTBL,2
ZERO? STACK \?CCL5
GET TMP,0
PRINTB STACK
RTRUE
?CCL5: GETB TMP,2 >X
GETB TMP,3
ICALL WORD-PRINT,X,STACK
PUTB P-VTBL,2,0
RTRUE
.FUNCT ORPHAN,D1,D2
ZERO? P-MERGED \?CND1
PUT P-OCL1,P-MATCHLEN,0
PUT P-OCL2,P-MATCHLEN,0
?CND1: GET P-VTBL,0
PUT P-OVTBL,0,STACK
GETB P-VTBL,2
PUTB P-OVTBL,2,STACK
GETB P-VTBL,3
PUTB P-OVTBL,3,STACK
COPYT P-ITBL,P-OTBL,P-ITBLLEN
EQUAL? P-NCN,2 \?CND3
ICALL CLAUSE-COPY,P-ITBL,P-OTBL,P-NC2,P-NC2L,P-OCL2
?CND3: LESS? P-NCN,1 /?CND5
ICALL CLAUSE-COPY,P-ITBL,P-OTBL,P-NC1,P-NC1L,P-OCL1
?CND5: ZERO? D1 /?CCL9
GETB D1,P-SPREP1
PUT P-OTBL,P-PREP1,STACK
PUT P-OTBL,P-NC1,1
RTRUE
?CCL9: ZERO? D2 /TRUE
GETB D2,P-SPREP2
PUT P-OTBL,P-PREP2,STACK
PUT P-OTBL,P-NC2,1
RTRUE
.FUNCT CLAUSE-PRINT,BPTR,EPTR,THE?,X
ASSIGNED? 'THE? /?CND1
SET 'THE?,TRUE-VALUE
?CND1: GET P-ITBL,BPTR >X
GET P-ITBL,EPTR
ICALL BUFFER-PRINT,X,STACK,THE?
RFALSE
.FUNCT BUFFER-PRINT,BEG,END,CP,NOSP,WRD,FIRST??,PN,LEN
SET 'FIRST??,TRUE-VALUE
?PRG1: EQUAL? BEG,END /TRUE
GET BEG,0 >WRD
EQUAL? WRD,W?$BUZZ /?CND5
EQUAL? WRD,W?COMMA \?CCL8
PRINTI ", "
JUMP ?CND5
?CCL8: ZERO? NOSP /?CCL10
SET 'NOSP,FALSE-VALUE
JUMP ?CND5
?CCL10: PRINTC SP
?CND5: EQUAL? WRD,W?HIM \?PRD14
CALL2 VISIBLE?,P-HIM-OBJECT
ZERO? STACK /?CCL12
?PRD14: EQUAL? WRD,W?HER \?PRD17
CALL2 VISIBLE?,P-HER-OBJECT
ZERO? STACK /?CCL12
?PRD17: EQUAL? WRD,W?THEM \?CND11
CALL2 VISIBLE?,P-THEM-OBJECT
ZERO? STACK \?CND11
?CCL12: SET 'PN,TRUE-VALUE
?CND11: GET CAPS,0 >LEN
EQUAL? WRD,W?PERIOD,W?COMMA,W?$BUZZ /?CTR23
CALL WT?,WRD,4
ZERO? STACK \?PRD28
CALL WT?,WRD,8
ZERO? STACK /?CCL24
?PRD28: CALL WT?,WRD,32
ZERO? STACK \?CCL24
CALL WT?,WRD,128
ZERO? STACK \?CCL24
?CTR23: SET 'NOSP,TRUE-VALUE
JUMP ?CND22
?CCL24: EQUAL? WRD,W?ME \?CCL33
ICALL2 PRINT-TABLE,CHARNAME
SET 'PN,TRUE-VALUE
JUMP ?CND22
?CCL33: INTBL? WRD,CAPS+2,LEN >LEN \?CCL35
ICALL2 CAPITALIZE,BEG
SET 'PN,TRUE-VALUE
JUMP ?CND22
?CCL35: GETB BEG,3 >LEN
ZERO? FIRST?? /?CND36
ZERO? PN \?CND36
ZERO? CP /?CND36
PRINT LTHE
?CND36: ZERO? P-OFLAG \?CTR42
ZERO? P-MERGED /?CCL43
?CTR42: PRINTB WRD
JUMP ?CND41
?CCL43: EQUAL? WRD,W?IT \?CCL47
CALL2 VISIBLE?,P-IT-OBJECT
ZERO? STACK /?CCL47
ICALL2 DPRINT,P-IT-OBJECT
JUMP ?CND41
?CCL47: EQUAL? WRD,W?HER \?CCL51
ZERO? PN \?CCL51
ICALL2 DPRINT,P-HER-OBJECT
JUMP ?CND41
?CCL51: EQUAL? WRD,W?THEM \?CCL55
ZERO? PN \?CCL55
ICALL2 DPRINT,P-THEM-OBJECT
JUMP ?CND41
?CCL55: EQUAL? WRD,W?HIM \?CCL59
ZERO? PN \?CCL59
ICALL2 DPRINT,P-HIM-OBJECT
JUMP ?CND41
?CCL59: GETB BEG,2
ICALL WORD-PRINT,STACK,LEN
?CND41: SET 'FIRST??,FALSE-VALUE
?CND22: ADD BEG,P-WORDLEN >BEG
JUMP ?PRG1
.FUNCT ADD-CAP?,WRD,X
GET CAPS,0 >X
INTBL? -1,CAPS+2,X >X \FALSE
PUT X,0,WRD
RTRUE
.FUNCT CAPITALIZE,PTR,?TMP1
ZERO? P-OFLAG \?CTR2
ZERO? P-MERGED /?CCL3
?CTR2: GET PTR,0
PRINTB STACK
RTRUE
?CCL3: GETB PTR,3
GETB P-INBUF,STACK
SUB STACK,SP
PRINTC STACK
GETB PTR,2
SUB STACK,1 >?TMP1
GETB PTR,3
ADD STACK,1
CALL WORD-PRINT,?TMP1,STACK
RSTACK
.FUNCT PREP-PRINT,PREP,SP?,WRD
ASSIGNED? 'SP? /?CND1
SET 'SP?,TRUE-VALUE
?CND1: ZERO? PREP /FALSE
ZERO? P-END-ON-PREP \FALSE
ZERO? SP? /?CND8
PRINTC SP
?CND8: CALL2 PREP-FIND,PREP >WRD
PRINTB WRD
GET P-ITBL,P-VERBN
GET STACK,0
EQUAL? W?SIT,STACK \?CND10
EQUAL? W?DOWN,WRD \?CND10
PRINTI " on"
?CND10: GET P-ITBL,P-VERBN
GET STACK,0
EQUAL? W?GET,STACK \TRUE
EQUAL? W?OUT,WRD \TRUE
PRINTI " of"
RTRUE
.FUNCT CLAUSE-COPY,SRC,DEST,BB,EE,OCL,INSRT,BEG,END,OBEG,CNT,B,E
GET SRC,BB >BEG
GET SRC,EE >END
GET OCL,P-MATCHLEN >OBEG
?PRG1: EQUAL? BEG,END /?REP2
ZERO? INSRT /?CCL7
GET BEG,0
EQUAL? P-ANAM,STACK \?CCL7
EQUAL? INSRT,TRUE-VALUE \?CCL12
GET P-ITBL,P-NC1 >B
GET P-ITBL,P-NC1L >E
?PRG13: EQUAL? B,E /?CND5
GET B,0
ICALL CLAUSE-ADD,STACK,OCL
ADD B,P-WORDLEN >B
JUMP ?PRG13
?CCL12: GET OCL,1
EQUAL? INSRT,STACK /?CND17
ICALL CLAUSE-ADD,INSRT,OCL
?CND17: ICALL CLAUSE-ADD,P-ANAM,OCL
JUMP ?CND5
?CCL7: GET BEG,0
ICALL CLAUSE-ADD,STACK,OCL
?CND5: ADD BEG,P-WORDLEN >BEG
JUMP ?PRG1
?REP2: GET OCL,P-MATCHLEN
SUB STACK,OBEG >CNT
GRTR? OBEG,0 \?CND19
ZERO? CNT /?CND19
PUT OCL,P-MATCHLEN,0
INC 'OBEG
?PRG23: GET OCL,OBEG
ICALL CLAUSE-ADD,STACK,OCL
SUB CNT,2 >CNT
ZERO? CNT /?REP24
ADD OBEG,2 >OBEG
JUMP ?PRG23
?REP24: SET 'OBEG,0
?CND19: MUL OBEG,P-LEXELEN
ADD STACK,2
ADD OCL,STACK
PUT DEST,BB,STACK
GET OCL,P-MATCHLEN
MUL STACK,P-LEXELEN
ADD STACK,2
ADD OCL,STACK
PUT DEST,EE,STACK
RTRUE
.FUNCT CLAUSE-ADD,WRD,TBL,PTR
GET TBL,P-MATCHLEN >PTR
INC 'PTR
PUT TBL,PTR,WRD
INC 'PTR
PUT TBL,PTR,0
PUT TBL,P-MATCHLEN,PTR
RFALSE
.FUNCT PREP-FIND,PREP,CNT,SIZE
GET PREPOSITIONS,0
MUL STACK,2 >SIZE
?PRG1: IGRTR? 'CNT,SIZE /FALSE
GET PREPOSITIONS,CNT
EQUAL? STACK,PREP \?PRG1
SUB CNT,1
GET PREPOSITIONS,STACK
RSTACK
.FUNCT GWIM,GBIT,LBIT,PREP,OBJ
EQUAL? GBIT,LOCATION \?CCL3
RETURN ROOMS
?CCL3: EQUAL? P-IT-OBJECT,FALSE-VALUE,NOT-HERE-OBJECT /?CCL5
FSET? P-IT-OBJECT,GBIT \?CCL5
EQUAL? GBIT,TAKEABLE \?CCL9
IN? P-IT-OBJECT,PLAYER /?CND1
?CCL9: SET 'OBJ,P-IT-OBJECT
JUMP ?CND1
?CCL5: EQUAL? P-HIM-OBJECT,FALSE-VALUE,NOT-HERE-OBJECT /?CCL13
FSET? P-HIM-OBJECT,GBIT \?CCL13
SET 'OBJ,P-HIM-OBJECT
JUMP ?CND1
?CCL13: EQUAL? P-HER-OBJECT,FALSE-VALUE,NOT-HERE-OBJECT /?CCL17
FSET? P-HER-OBJECT,GBIT \?CCL17
SET 'OBJ,P-HER-OBJECT
JUMP ?CND1
?CCL17: EQUAL? P-THEM-OBJECT,FALSE-VALUE,NOT-HERE-OBJECT /?CND1
FSET? P-THEM-OBJECT,GBIT \?CND1
SET 'OBJ,P-THEM-OBJECT
?CND1: ZERO? OBJ /?CND23
PRINTC 91
ICALL2 THE-PRINT,OBJ
PRINT BRACKET
RETURN OBJ
?CND23: SET 'P-GWIMBIT,GBIT
SET 'P-SLOCBITS,LBIT
PUT P-MERGE,P-MATCHLEN,0
CALL GET-OBJECT,P-MERGE,FALSE-VALUE
ZERO? STACK /?CCL27
SET 'P-GWIMBIT,0
GET P-MERGE,P-MATCHLEN
EQUAL? STACK,1 \FALSE
GET P-MERGE,1 >OBJ
EQUAL? WINNER,PLAYER /?PRD33
RETURN OBJ
?PRD33: EQUAL? OBJ,HANDS /?CND30
PRINTC 91
CALL PREP-PRINT,PREP,FALSE-VALUE
ZERO? STACK /?CND34
PRINTC SP
?CND34: ICALL2 THE-PRINT,OBJ
PRINT BRACKET
?CND30: RETURN OBJ
?CCL27: EQUAL? GBIT,WIELDED \?CCL37
SET 'P-GWIMBIT,0
RETURN HANDS
?CCL37: SET 'P-GWIMBIT,0
RFALSE
.FUNCT SNARF-OBJECTS,PTR
GET P-ITBL,P-NC1 >PTR
ZERO? PTR /?CND1
SET 'P-PHR,0
GETB P-SYNTAX,P-SLOC1 >P-SLOCBITS
GET P-ITBL,P-NC1L
CALL SNARFEM,PTR,STACK,P-PRSO
ZERO? STACK /FALSE
GET P-BUTS,P-MATCHLEN
ZERO? STACK /?CND1
CALL2 BUT-MERGE,P-PRSO >P-PRSO
?CND1: GET P-ITBL,P-NC2 >PTR
ZERO? PTR /TRUE
SET 'P-PHR,1
GETB P-SYNTAX,P-SLOC2 >P-SLOCBITS
GET P-ITBL,P-NC2L
CALL SNARFEM,PTR,STACK,P-PRSI
ZERO? STACK /FALSE
GET P-BUTS,P-MATCHLEN
ZERO? STACK /TRUE
GET P-PRSI,P-MATCHLEN
EQUAL? STACK,1 \?CND13
CALL2 BUT-MERGE,P-PRSO >P-PRSO
RTRUE
?CND13: CALL2 BUT-MERGE,P-PRSI >P-PRSI
RTRUE
.FUNCT BUT-MERGE,TBL,LEN,BUTLEN,CNT,MATCHES,OBJ,NTBL,X
SET 'CNT,1
GET TBL,P-MATCHLEN >LEN
PUT P-MERGE,P-MATCHLEN,0
?PRG1: DLESS? 'LEN,0 /?REP2
GET TBL,CNT >OBJ
ADD P-BUTS,2 >X
GET P-BUTS,0
INTBL? OBJ,X,STACK >X /?CND5
INC 'MATCHES
PUT P-MERGE,MATCHES,OBJ
?CND5: INC 'CNT
JUMP ?PRG1
?REP2: PUT P-MERGE,P-MATCHLEN,MATCHES
SET 'NTBL,P-MERGE
SET 'P-MERGE,TBL
RETURN NTBL
.FUNCT SNARFEM,PTR,EPTR,TBL,BUT,LEN,WV,WRD,NW,WAS-ALL?,ONEOBJ
SET 'P-AND,FALSE-VALUE
EQUAL? P-GETFLAGS,P-ALL \?CND1
SET 'WAS-ALL?,TRUE-VALUE
?CND1: SET 'P-GETFLAGS,0
PUT P-BUTS,P-MATCHLEN,0
PUT TBL,P-MATCHLEN,0
GET PTR,0 >WRD
?PRG3: EQUAL? PTR,EPTR \?CCL7
ZERO? BUT /?PRD10
PUSH BUT
JUMP ?PEN8
?PRD10: PUSH TBL
?PEN8: CALL2 GET-OBJECT,STACK >WV
ZERO? WAS-ALL? /?CND11
SET 'P-GETFLAGS,P-ALL
?CND11: RETURN WV
?CCL7: ADD PTR,P-WORDLEN
EQUAL? EPTR,STACK \?CCL15
SET 'NW,0
JUMP ?CND13
?CCL15: GET PTR,P-LEXELEN >NW
?CND13: EQUAL? WRD,W?ALL,W?BOTH,W?EVERYTHING \?CCL18
SET 'P-GETFLAGS,P-ALL
EQUAL? NW,W?OF \?CND5
ADD PTR,P-WORDLEN >PTR
JUMP ?CND5
?CCL18: EQUAL? WRD,W?BUT,W?EXCEPT \?CCL22
ZERO? BUT /?PRD27
PUSH BUT
JUMP ?PEN25
?PRD27: PUSH TBL
?PEN25: CALL2 GET-OBJECT,STACK
ZERO? STACK /FALSE
SET 'BUT,P-BUTS
PUT BUT,P-MATCHLEN,0
JUMP ?CND5
?CCL22: CALL2 BUZZER-WORD?,WRD
ZERO? STACK \FALSE
EQUAL? WRD,W?A \?CCL31
ZERO? P-ADJ \?CCL34
SET 'P-GETFLAGS,P-ONE
EQUAL? NW,W?OF \?CND5
ADD PTR,P-WORDLEN >PTR
JUMP ?CND5
?CCL34: SET 'P-NAM,ONEOBJ
ZERO? BUT /?PRD41
PUSH BUT
JUMP ?PEN39
?PRD41: PUSH TBL
?PEN39: CALL2 GET-OBJECT,STACK
ZERO? STACK /FALSE
ZERO? NW \?CND5
RTRUE
?CCL31: EQUAL? WRD,W?AND,W?COMMA \?CCL45
EQUAL? NW,W?AND,W?COMMA /?CCL45
SET 'P-AND,TRUE-VALUE
ZERO? BUT /?PRD52
PUSH BUT
JUMP ?PEN50
?PRD52: PUSH TBL
?PEN50: CALL2 GET-OBJECT,STACK
ZERO? STACK \?CND5
RFALSE
?CCL45: CALL WT?,WRD,4
ZERO? STACK \?CND5
EQUAL? WRD,W?AND,W?COMMA /?CND5
EQUAL? WRD,W?OF \?CCL56
ZERO? P-GETFLAGS \?CND5
SET 'P-GETFLAGS,P-INHIBIT
JUMP ?CND5
?CCL56: CALL WT?,WRD,32
ZERO? STACK /?CCL60
ZERO? P-ADJ \?CCL60
EQUAL? NW,W?OF /?CCL60
SET 'P-ADJ,WRD
JUMP ?CND5
?CCL60: CALL WT?,WRD,128
ZERO? STACK /?CND5
SET 'P-NAM,WRD
SET 'ONEOBJ,WRD
?CND5: EQUAL? PTR,EPTR /?PRG3
ADD PTR,P-WORDLEN >PTR
SET 'WRD,NW
JUMP ?PRG3
.FUNCT GET-OBJECT,TBL,VRB,GCHECK,OLEN,BTS,LEN,XBITS,TLEN,OBJ,ADJ,X,XTBL,TTBL,TOBJ
ASSIGNED? 'VRB /?CND1
SET 'VRB,TRUE-VALUE
?CND1: SET 'XBITS,P-SLOCBITS
GET TBL,P-MATCHLEN >TLEN
BTST P-GETFLAGS,P-INHIBIT /TRUE
SET 'ADJ,P-ADJ
ZERO? P-NAM \?CND5
ZERO? P-ADJ /?CND5
CALL WT?,P-ADJ,128
ZERO? STACK /?CCL11
SET 'P-NAM,P-ADJ
SET 'P-ADJ,FALSE-VALUE
?CND5: ZERO? P-NAM \?CND13
ZERO? P-ADJ \?CND13
EQUAL? P-GETFLAGS,P-ALL /?CND13
ZERO? P-GWIMBIT \?CND13
ZERO? VRB /FALSE
ICALL2 NOT-IN-SENTENCE,STR?514
RFALSE
?CCL11: CALL WT?,P-ADJ,16,3 >BTS
ZERO? BTS /?CND5
SET 'P-ADJ,FALSE-VALUE
PUT TBL,P-MATCHLEN,1
PUT TBL,1,INTDIR
SET 'P-DIRECTION,BTS
RTRUE
?CND13: EQUAL? P-GETFLAGS,P-ALL \?CCL22
ZERO? P-SLOCBITS \?CND21
?CCL22: SET 'P-SLOCBITS,-1
?CND21: SET 'P-TABLE,TBL
?PRG25: ZERO? GCHECK /?CCL29
ICALL2 GLOBAL-CHECK,TBL
JUMP ?CND27
?CCL29: ICALL DO-SL,HERE,SOG,SIR
ICALL DO-SL,WINNER,SH,SC
?CND27: GET TBL,P-MATCHLEN
SUB STACK,TLEN >LEN
BTST P-GETFLAGS,P-ALL /?CND30
ZERO? LEN /?CCL33
BTST P-GETFLAGS,P-ONE \?CCL33
GRTR? LEN,1 \?CND36
RANDOM LEN
GET TBL,STACK
PUT TBL,1,STACK
PRINTI "[How about "
GET TBL,1
ICALL2 THE-PRINT,STACK
PRINTI "?]"
CRLF
?CND36: PUT TBL,P-MATCHLEN,1
?CND30: ADD TLEN,1
GET TBL,STACK >X
ZERO? P-ADJ /?CND87
ZERO? P-NAM \?CND87
ZERO? X /?CND87
PRINTC 91
ICALL2 THE-PRINT,X
PRINT BRACKET
?CND87: SET 'P-SLOCBITS,XBITS
PUT P-NAMW,P-PHR,P-NAM
PUT P-ADJW,P-PHR,P-ADJ
SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RTRUE
?CCL33: GRTR? LEN,1 /?CTR38
ZERO? LEN \?CCL39
EQUAL? P-SLOCBITS,-1 /?CCL39
?CTR38: EQUAL? P-SLOCBITS,-1 \?CCL46
SET 'P-SLOCBITS,XBITS
SET 'OLEN,LEN
GET TBL,P-MATCHLEN
SUB STACK,LEN
PUT TBL,P-MATCHLEN,STACK
JUMP ?PRG25
?CCL46: PUT P-NAMW,P-PHR,P-NAM
PUT P-ADJW,P-PHR,P-ADJ
ZERO? LEN \?CND47
SET 'LEN,OLEN
?CND47: ZERO? P-NAM /?CND49
ADD TLEN,1
GET TBL,STACK >OBJ
ZERO? OBJ /?CND49
MUL TLEN,2
ADD TBL,STACK >TTBL
GET TTBL,0 >TOBJ
PUT TTBL,0,LEN
GETP OBJ,P?GENERIC
CALL STACK,TTBL >OBJ
PUT TTBL,0,TOBJ
ZERO? OBJ /?CND49
EQUAL? OBJ,NOT-HERE-OBJECT /FALSE
ADD TLEN,1 >X
PUT TBL,X,OBJ
PUT TBL,P-MATCHLEN,X
SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RTRUE
?CND49: ZERO? VRB /?CCL59
EQUAL? WINNER,PLAYER /?CCL59
ICALL1 DONT-UNDERSTAND
RFALSE
?CCL59: ZERO? VRB /?CCL63
ZERO? P-NAM /?CCL63
SET 'XTBL,P-OCL2
EQUAL? TBL,P-PRSO \?CND66
SET 'XTBL,P-OCL1
?CND66: EQUAL? PRSA,V?NAME \?CCL70
ICALL1 MORE-SPECIFIC
JUMP ?CND57
?CCL70: GET XTBL,0
GRTR? STACK,22 \?CCL72
PUT XTBL,0,0
ICALL1 NYMPH-APPEARS
PRINTI "Parser overflow! Please try something else"
PRINT STR?515
JUMP ?CND57
?CCL72: ICALL WHICH-PRINT,TLEN,LEN,TBL
SET 'P-ACLAUSE,P-NC2
EQUAL? TBL,P-PRSO \?CND73
SET 'P-ACLAUSE,P-NC1
?CND73: SET 'P-ANAM,P-NAM
ICALL ORPHAN,FALSE-VALUE,FALSE-VALUE
SET 'P-OFLAG,TRUE-VALUE
JUMP ?CND57
?CCL63: ZERO? VRB /?CND57
ICALL2 NOT-IN-SENTENCE,STR?514
?CND57: SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RFALSE
?CCL39: ZERO? P-OFLAG \FALSE
ZERO? LEN \?CCL79
ZERO? GCHECK /?CCL79
PUT P-NAMW,P-PHR,P-NAM
PUT P-ADJW,P-PHR,P-ADJ
ZERO? VRB /?CND82
SET 'P-SLOCBITS,XBITS
ICALL OBJ-FOUND,NOT-HERE-OBJECT,TBL
SET 'P-XNAM,P-NAM
SET 'P-NAM,FALSE-VALUE
SET 'P-XADJ,P-ADJ
SET 'P-ADJ,FALSE-VALUE
ZERO? LIT? \TRUE
ICALL1 TOO-DARK
RTRUE
?CND82: SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RFALSE
?CCL79: ZERO? LEN \?CND30
SET 'GCHECK,TRUE-VALUE
JUMP ?PRG25
.FUNCT MOBY-FIND,TBL,OBJ,LEN,NAM,ADJ,X
SET 'OBJ,1
SET 'NAM,P-NAM
SET 'ADJ,P-ADJ
SET 'P-NAM,P-XNAM
SET 'P-ADJ,P-XADJ
PUT TBL,P-MATCHLEN,0
?PRG1: IN? OBJ,ROOMS /?CND3
CALL2 THIS-IT?,OBJ
ZERO? STACK /?CND3
ICALL OBJ-FOUND,OBJ,TBL
?CND3: IGRTR? 'OBJ,LAST-OBJECT \?PRG1
GET TBL,P-MATCHLEN >LEN
EQUAL? LEN,1 \?CND9
GET TBL,1 >P-MOBY-FOUND
?CND9: SET 'P-NAM,NAM
SET 'P-ADJ,ADJ
RETURN LEN
.FUNCT WHICH-PRINT,TLEN,LEN,TBL,OBJ,RLEN
SET 'RLEN,LEN
PRINTI "[Which"
ZERO? P-OFLAG \?CTR2
ZERO? P-MERGED \?CTR2
ZERO? P-AND /?CCL3
?CTR2: PRINTC SP
ZERO? P-LASTADJ /?CND7
PRINTB P-LASTADJ
PRINTC SP
?CND7: PRINTB P-NAM
JUMP ?CND1
?CCL3: EQUAL? TBL,P-PRSO \?CCL10
ICALL CLAUSE-PRINT,P-NC1,P-NC1L,FALSE-VALUE
JUMP ?CND1
?CCL10: ICALL CLAUSE-PRINT,P-NC2,P-NC2L,FALSE-VALUE
?CND1: PRINTI " do you mean,"
SET 'WHICH-PRINTING,TRUE-VALUE
?PRG11: INC 'TLEN
GET TBL,TLEN >OBJ
PRINTC SP
ICALL2 THE-PRINT,OBJ
EQUAL? LEN,2 \?CCL15
EQUAL? RLEN,2 /?CND16
PRINTC 44
?CND16: PRINTI " or"
JUMP ?CND13
?CCL15: GRTR? LEN,2 \?CND13
PRINTC 44
?CND13: DLESS? 'LEN,1 \?PRG11
SET 'WHICH-PRINTING,FALSE-VALUE
PRINTR "?]"
.FUNCT DESCRIBE-PSEUDO-OBJECT,OBJ
ZERO? P-PNAM /?CND1
EQUAL? HERE,LAST-PSEUDO-LOC \?CND1
PRINTB P-PNAM
RTRUE
?CND1: PRINTD PSEUDO-OBJECT
RTRUE
.FUNCT GLOBAL-CHECK,TBL,LEN,RMG,RMGL,CNT,OBJ,OBITS,X
GET TBL,P-MATCHLEN >LEN
SET 'OBITS,P-SLOCBITS
GETPT HERE,P?GLOBAL >RMG
ZERO? RMG /?CND1
PTSIZE RMG
DIV STACK,2
SUB STACK,1 >RMGL
?PRG3: GET RMG,CNT >OBJ
FIRST? OBJ >X \?CND5
ICALL SEARCH-LIST,OBJ,TBL,P-SRCALL
?CND5: CALL2 THIS-IT?,OBJ
ZERO? STACK /?CND7
ICALL OBJ-FOUND,OBJ,TBL
?CND7: IGRTR? 'CNT,RMGL \?PRG3
?CND1: GETP HERE,P?THINGS >RMG
ZERO? RMG /?CND11
GET RMG,0 >RMGL
SET 'CNT,0
?PRG13: ADD CNT,1
GET RMG,STACK
EQUAL? P-NAM,STACK \?CND15
ZERO? P-ADJ /?CCL16
ADD CNT,2
GET RMG,STACK
EQUAL? P-ADJ,STACK \?CND15
?CCL16: SET 'P-PNAM,P-NAM
ZERO? P-ADJ /?CCL23
SET 'P-PADJN,P-ADJ
JUMP ?CND21
?CCL23: SET 'P-PADJN,FALSE-VALUE
?CND21: SET 'LAST-PSEUDO-LOC,HERE
FCLEAR PSEUDO-OBJECT,NOARTICLE
ADD CNT,3
GET RMG,STACK
PUTP PSEUDO-OBJECT,P?ACTION,STACK
ICALL OBJ-FOUND,PSEUDO-OBJECT,TBL
JUMP ?CND11
?CND15: ADD CNT,3 >CNT
LESS? CNT,RMGL /?PRG13
?CND11: GET TBL,P-MATCHLEN
EQUAL? STACK,LEN \FALSE
SET 'P-SLOCBITS,-1
SET 'P-TABLE,TBL
ICALL DO-SL,GLOBAL-OBJECTS,1,1
SET 'P-SLOCBITS,OBITS
RETURN P-SLOCBITS
.FUNCT DO-SL,OBJ,BIT1,BIT2
ADD BIT1,BIT2
BTST P-SLOCBITS,STACK \?CCL3
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCALL
RSTACK
?CCL3: BTST P-SLOCBITS,BIT1 \?CCL6
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCTOP
RSTACK
?CCL6: BTST P-SLOCBITS,BIT2 \TRUE
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCBOT
RSTACK
.FUNCT SEARCH-LIST,OBJ,TBL,LVL,X
FIRST? OBJ >OBJ \FALSE
?PRG3: EQUAL? LVL,P-SRCBOT /?CND5
CALL2 THIS-IT?,OBJ
ZERO? STACK /?CND5
ICALL OBJ-FOUND,OBJ,TBL
?CND5: EQUAL? OBJ,WINNER,LOCAL-GLOBALS,GLOBAL-OBJECTS /?CND9
FIRST? OBJ >X \?CND9
CALL2 SEE-INSIDE?,OBJ
ZERO? STACK /?CND9
SET 'X,P-SRCTOP
FSET? OBJ,SURFACE \?CND14
SET 'X,P-SRCALL
?CND14: ICALL SEARCH-LIST,OBJ,TBL,X
?CND9: NEXT? OBJ >OBJ /?PRG3
RFALSE
.FUNCT THIS-IT?,OBJ,TBL,LEN
ZERO? P-NAM /?CCL3
GETPT OBJ,P?SYNONYM >TBL
ZERO? TBL /FALSE
PTSIZE TBL
DIV STACK,2 >LEN
ZERO? LEN /FALSE
INTBL? P-NAM,TBL,LEN >LEN \FALSE
?CCL3: ZERO? P-ADJ /?CCL10
GETPT OBJ,P?ADJECTIVE >TBL
ZERO? TBL /FALSE
PTSIZE TBL
DIV STACK,2 >LEN
ZERO? LEN /FALSE
INTBL? P-ADJ,TBL,LEN >LEN \FALSE
?CCL10: ZERO? P-GWIMBIT /TRUE
FSET? OBJ,P-GWIMBIT /TRUE
RFALSE
.FUNCT OBJ-FOUND,OBJ,TBL,PTR
GET TBL,P-MATCHLEN >PTR
INC 'PTR
PUT TBL,PTR,OBJ
PUT TBL,P-MATCHLEN,PTR
RFALSE
.FUNCT ITAKE-CHECK,TBL,BITS,PTR,LEN,OBJ,L,GOT-IT,TOOK-IT
SET 'PTR,1
GET TBL,P-MATCHLEN >LEN
ZERO? LEN /TRUE
BTST BITS,SHAVE /?PRG7
BTST BITS,STAKE \TRUE
?PRG7: GET TBL,PTR >OBJ
EQUAL? OBJ,IT \?CCL11
CALL2 ACCESSIBLE?,P-IT-OBJECT
ZERO? STACK \?CND12
ICALL1 MORE-SPECIFIC
RFALSE
?CND12: SET 'OBJ,P-IT-OBJECT
JUMP ?CND9
?CCL11: EQUAL? OBJ,THEM \?CCL15
CALL2 ACCESSIBLE?,P-THEM-OBJECT
ZERO? STACK \?CND16
ICALL1 MORE-SPECIFIC
RFALSE
?CND16: SET 'OBJ,P-THEM-OBJECT
JUMP ?CND9
?CCL15: EQUAL? OBJ,HER \?CCL19
CALL2 ACCESSIBLE?,P-HER-OBJECT
ZERO? STACK \?CND20
ICALL1 MORE-SPECIFIC
RFALSE
?CND20: SET 'OBJ,P-HER-OBJECT
JUMP ?CND9
?CCL19: EQUAL? OBJ,HIM \?CND9
CALL2 ACCESSIBLE?,P-HIM-OBJECT
ZERO? STACK \?CND23
ICALL1 MORE-SPECIFIC
RFALSE
?CND23: SET 'OBJ,P-HIM-OBJECT
?CND9: EQUAL? OBJ,WINNER,HANDS,FEET /?CND25
EQUAL? OBJ,ME,YOU,ROOMS /?CND25
EQUAL? OBJ,INTDIR,RIGHT,LEFT /?CND25
EQUAL? OBJ,MONEY /?CND25
CALL2 HELD?,OBJ
ZERO? STACK \?CND25
SET 'PRSO,OBJ
LOC OBJ >L
SET 'GOT-IT,0
SET 'TOOK-IT,0
ZERO? L /?CND32
FSET? OBJ,TRYTAKE \?CCL35
FSET? OBJ,TAKEABLE /?CCL35
BTST BITS,SHAVE \?CND32
IN? L,WINNER \?CND32
INC 'GOT-IT
JUMP ?CND32
?CCL35: ZERO? P-MULT? \?CCL43
IN? L,WINNER \?CCL43
CALL2 ITAKE,FALSE-VALUE
ZERO? STACK /?CCL43
INC 'GOT-IT
INC 'TOOK-IT
JUMP ?CND32
?CCL43: EQUAL? L,WINNER \?CND32
BTST BITS,SHAVE \?CND32
INC 'GOT-IT
?CND32: ZERO? GOT-IT \?CCL52
BTST BITS,SHAVE \?CCL52
ICALL1 WINNER-NOT-HOLDING
EQUAL? LEN,PTR \?CCL57
ZERO? P-MULT? /?CCL57
PRINTI "all of those things"
JUMP ?CND55
?CCL57: EQUAL? OBJ,NOT-HERE-OBJECT \?CCL61
ICALL2 THIS-IS-IT,OBJ
ICALL2 DPRINT,OBJ
JUMP ?CND55
?CCL61: ICALL2 THIS-IS-IT,OBJ
FSET? OBJ,PLURAL \?CCL64
PRINTI "any "
JUMP ?CND62
?CCL64: FSET? OBJ,NOARTICLE /?CND62
FSET? OBJ,PROPER \?CCL68
PRINT LTHE
JUMP ?CND62
?CCL68: FSET? OBJ,VOWEL \?CCL70
PRINTI "an "
JUMP ?CND62
?CCL70: PRINTI "a "
?CND62: ICALL2 DPRINT,OBJ
?CND55: PRINT PERIOD
RFALSE
?CCL52: ZERO? GOT-IT /?CND25
ZERO? TOOK-IT /?CND25
EQUAL? WINNER,PLAYER \?CND25
ICALL2 TAKING-OBJ-FIRST,OBJ
?CND25: IGRTR? 'PTR,LEN \?PRG7
RTRUE
.FUNCT HELD?,OBJ,L
ASSIGNED? 'OBJ /?CND1
SET 'OBJ,PRSO
?CND1: ZERO? OBJ /FALSE
FSET? OBJ,TAKEABLE /?CND3
FSET? OBJ,TRYTAKE \FALSE
?CND3: LOC OBJ >L
EQUAL? L,FALSE-VALUE,ROOMS,GLOBAL-OBJECTS /FALSE
EQUAL? L,WINNER /TRUE
CALL2 HELD?,L
RSTACK
.FUNCT TAKING-OBJ-FIRST,OBJ,L
LOC OBJ >L
PRINTI "[taking "
ICALL2 THE-PRINT,OBJ
LOC WINNER
EQUAL? L,HERE,STACK,FALSE-VALUE /?CND1
ICALL2 OUT-OF-LOC,L
?CND1: PRINTI " first"
PRINT BRACKET
ICALL SPARK?,FALSE-VALUE,OBJ
RFALSE
.FUNCT MANY-CHECK,LOSS,TMP,?TMP1
GET P-PRSO,P-MATCHLEN
GRTR? STACK,1 \?CCL3
GETB P-SYNTAX,P-SLOC1
BTST STACK,SMANY /?CCL3
SET 'LOSS,1
JUMP ?CND1
?CCL3: GET P-PRSI,P-MATCHLEN
GRTR? STACK,1 \?CND1
GETB P-SYNTAX,P-SLOC2
BTST STACK,SMANY /?CND1
SET 'LOSS,2
?CND1: ZERO? LOSS /TRUE
PRINTC 91
PRINT CANT
PRINTI "refer to more than one object at a time with """
GET P-ITBL,P-VERBN >TMP
ZERO? TMP \?CCL14
PRINTB W?TELL
JUMP ?CND12
?CCL14: ZERO? P-OFLAG \?CTR15
ZERO? P-MERGED /?CCL16
?CTR15: GET TMP,0
PRINTB STACK
JUMP ?CND12
?CCL16: GETB TMP,2 >?TMP1
GETB TMP,3
ICALL WORD-PRINT,?TMP1,STACK
?CND12: PRINTI ".""]"
CRLF
RFALSE
.FUNCT SAY-IF-HERE-LIT
CALL1 IS-LIT? >LIT?
ZERO? LIT? \TRUE
SET 'P-CONT,FALSE-VALUE
SET 'OLD-HERE,FALSE-VALUE
SET 'P-WALK-DIR,FALSE-VALUE
ICALL2 RELOOK,TRUE-VALUE
RTRUE
.FUNCT LIGHT-ROOM-WITH,SOURCE
FSET SOURCE,LIGHTED
ICALL REPLACE-ADJ?,SOURCE,W?DARK,W?LIGHTED
ZERO? LIT? \FALSE
CALL2 VISIBLE?,SOURCE
ZERO? STACK /FALSE
SET 'LIT?,TRUE-VALUE
SET 'P-CONT,FALSE-VALUE
SET 'OLD-HERE,FALSE-VALUE
CRLF
ICALL1 V-LOOK
RTRUE
.FUNCT IS-LIT?,RM,RMBIT,LIT,OHERE
ASSIGNED? 'RM /?CND1
SET 'RM,HERE
?CND1: ASSIGNED? 'RMBIT /?CND3
SET 'RMBIT,TRUE-VALUE
?CND3: ZERO? ALWAYS-LIT? /?CND5
EQUAL? WINNER,PLAYER /TRUE
?CND5: SET 'P-GWIMBIT,LIGHTED
SET 'OHERE,HERE
SET 'HERE,RM
ZERO? RMBIT /?CCL11
FSET? RM,LIGHTED \?CCL11
INC 'LIT
JUMP ?CND9
?CCL11: PUT P-MERGE,P-MATCHLEN,0
SET 'P-TABLE,P-MERGE
SET 'P-SLOCBITS,-1
EQUAL? OHERE,RM \?CND14
ICALL DO-SL,WINNER,1,1
EQUAL? WINNER,PLAYER /?CND14
IN? PLAYER,RM \?CND14
ICALL DO-SL,PLAYER,1,1
?CND14: ICALL DO-SL,RM,1,1
GET P-TABLE,P-MATCHLEN
GRTR? STACK,0 \?CND9
INC 'LIT
?CND9: SET 'HERE,OHERE
SET 'P-GWIMBIT,0
RETURN LIT
.FUNCT DONT-HAVE?,OBJ,L,O
ASSIGNED? 'OBJ /?CND1
SET 'OBJ,PRSO
?CND1: LOC OBJ >L
ZERO? L /?CND3
EQUAL? L,WINNER /FALSE
IN? L,PLAYER \?CND3
EQUAL? WINNER,PLAYER \?CND3
SET 'O,PRSO
SET 'PRSO,OBJ
CALL2 ITAKE,FALSE-VALUE
ZERO? STACK /?CND10
PRINTI "[taking "
ICALL1 THE-PRINT
ICALL2 OUT-OF-LOC,L
PRINTI " first"
PRINT BRACKET
ICALL2 SPARK?,FALSE-VALUE
SET 'PRSO,O
ICALL2 THIS-IS-IT,PRSO
RFALSE
?CND10: SET 'PRSO,O
ICALL TAKE-FIRST,OBJ,L
RTRUE
?CND3: ICALL1 WINNER-NOT-HOLDING
ZERO? OBJ /?CCL14
FSET? OBJ,PLURAL \?CND15
PRINTI "any "
?CND15: ICALL2 THE-PRINT,OBJ
JUMP ?CND12
?CCL14: ICALL2 DPRINT,NOT-HERE-OBJECT
?CND12: PRINT PERIOD
RTRUE
.FUNCT TAKE-FIRST,OBJ1,OBJ2
PRINTI "You'd have to take "
ICALL2 THE-PRINT,OBJ1
ICALL2 OUT-OF-LOC,OBJ2
PRINT SFIRST
RTRUE
.FUNCT OUT-OF-LOC,L
PRINTC SP
EQUAL? L,HERE \?CND1
PRINTI "off the "
ICALL1 GROUND-WORD
RTRUE
?CND1: EQUAL? L,PLAYER \?CCL5
PRINTI "away from you"
RTRUE
?CCL5: FSET? L,LIVING \?CCL7
PRINTI "away from"
JUMP ?CND3
?CCL7: EQUAL? L,ARCH \?CCL9
PRINTI "out from under"
JUMP ?CND3
?CCL9: FSET? L,CONTAINER \?CCL11
PRINTI "out of"
JUMP ?CND3
?CCL11: FSET? L,SURFACE \?CCL13
PRINTB W?OFF
JUMP ?CND3
?CCL13: PRINTB W?FROM
?CND3: PRINTC SP
ICALL2 THE-PRINT,L
RTRUE
.FUNCT SAY-WHERE,L
EQUAL? L,PLAYER \?CCL3
PRINTI "in "
PRINTD HANDS
PRINTC 115
RTRUE
?CCL3: EQUAL? L,HERE \?CCL5
PRINTI "in front of you"
RTRUE
?CCL5: EQUAL? L,MCASE,BCASE,WCASE \?CCL7
PRINTB W?IN
JUMP ?CND1
?CCL7: FSET? L,SURFACE \?CCL9
PRINTB W?ON
JUMP ?CND1
?CCL9: FSET? L,CONTAINER \?CCL11
PRINTB W?IN
JUMP ?CND1
?CCL11: PRINTB W?WITH
?CND1: PRINTC SP
ICALL2 THE-PRINT,L
RTRUE
.FUNCT WINNER-NOT-HOLDING
EQUAL? WINNER,PLAYER \?CND1
PRINTI "You're not holding "
RTRUE
?CND1: ICALL2 CTHE-PRINT,WINNER
PRINTI " do"
FSET? WINNER,PLURAL /?CND3
PRINTI "es"
?CND3: PRINTI "n't have "
RTRUE
.FUNCT NOT-HERE-OBJECT-F,PRSO?,TBL,OBJ,LEN
SET 'PRSO?,TRUE-VALUE
EQUAL? PRSO,NOT-HERE-OBJECT \?CCL3
EQUAL? PRSI,NOT-HERE-OBJECT \?CCL3
PRINTR "Those things aren't here."
?CCL3: EQUAL? PRSO,NOT-HERE-OBJECT \?CCL7
SET 'TBL,P-PRSO
JUMP ?CND1
?CCL7: SET 'TBL,P-PRSI
SET 'PRSO?,FALSE-VALUE
?CND1: ZERO? PRSO? /?CCL10
EQUAL? PRSA,V?FIND,V?WHO,V?WHAT /?CCL12
EQUAL? PRSA,V?WHERE,V?BUY,V?WAIT-FOR \?CND8
?CCL12: CALL FIND-NOT-HERE,TBL,PRSO? >OBJ
ZERO? OBJ /FALSE
EQUAL? OBJ,NOT-HERE-OBJECT /?CND8
RETURN 2
?CCL10: EQUAL? PRSA,V?TELL-ABOUT,V?ASK-ABOUT,V?ASK-FOR \?CND8
CALL FIND-NOT-HERE,TBL,PRSO? >OBJ
ZERO? OBJ /FALSE
EQUAL? OBJ,NOT-HERE-OBJECT /?CND8
RETURN 2
?CND8: PRINT CANT
EQUAL? PRSA,V?LISTEN \?CCL33
PRINTB W?HEAR
JUMP ?CND31
?CCL33: EQUAL? PRSA,V?SMELL \?CCL35
PRINTB W?SMELL
JUMP ?CND31
?CCL35: PRINTB W?SEE
?CND31: GET CAPS,0 >LEN
INTBL? P-XNAM,CAPS+2,LEN >LEN /?CND36
PRINTI " any"
?CND36: ICALL2 NOT-HERE-PRINT,PRSO?
PRINTI " here."
CRLF
ICALL1 PCLEAR
RETURN 2
.FUNCT FIND-NOT-HERE,TBL,PRSO?,M-F,OBJ
CALL2 MOBY-FIND,TBL >M-F
EQUAL? M-F,1 \?CCL3
ZERO? PRSO? /?CND4
SET 'PRSO,P-MOBY-FOUND
RFALSE
?CND4: SET 'PRSI,P-MOBY-FOUND
RFALSE
?CCL3: GRTR? M-F,1 \?CCL7
GET TBL,1 >OBJ
ZERO? OBJ /?CCL7
GETP OBJ,P?GENERIC
CALL STACK,TBL >OBJ
ZERO? OBJ /?CCL7
EQUAL? OBJ,FALSE-VALUE,NOT-HERE-OBJECT /TRUE
ZERO? PRSO? /?CND11
SET 'PRSO,OBJ
RFALSE
?CND11: SET 'PRSI,OBJ
RFALSE
?CCL7: EQUAL? PRSA,V?ASK-ABOUT,V?TELL-ABOUT,V?ASK-FOR /FALSE
EQUAL? PRSA,V?WHO,V?WHAT,V?WHERE /FALSE
EQUAL? PRSA,V?FIND,V?FOLLOW,V?TELL /FALSE
ZERO? PRSO? /?CTR20
RETURN NOT-HERE-OBJECT
?CTR20: PRINTI "You wouldn't find any"
ICALL2 NOT-HERE-PRINT,PRSO?
PRINTR " there."
.FUNCT NOT-HERE-PRINT,PRSO?,X
ZERO? P-OFLAG \?CTR2
ZERO? P-MERGED /?CCL3
?CTR2: ZERO? P-XADJ /?CND6
PRINTC SP
PRINTB P-XADJ
?CND6: ZERO? P-XNAM /FALSE
PRINTC SP
PRINTB P-XNAM
RFALSE
?CCL3: ZERO? PRSO? /?CCL11
GET P-ITBL,P-NC1 >X
GET P-ITBL,P-NC1L
ICALL BUFFER-PRINT,X,STACK,FALSE-VALUE
RFALSE
?CCL11: GET P-ITBL,P-NC2 >X
GET P-ITBL,P-NC2L
ICALL BUFFER-PRINT,X,STACK,FALSE-VALUE
RFALSE
.FUNCT CONTENTS,THING,SAY-OR,OBJ,NXT,1ST?,IT?,TWO?
ASSIGNED? 'THING /?CND1
SET 'THING,PRSO
?CND1: SET '1ST?,TRUE-VALUE
FIRST? THING >OBJ \?CND3
?PRG5: NEXT? OBJ >NXT /?BOGUS7
?BOGUS7: EQUAL? OBJ,WINNER /?CCL9
FSET? OBJ,NODESC \?CND8
?CCL9: MOVE OBJ,C-OBJECT
?CND8: SET 'OBJ,NXT
ZERO? OBJ \?PRG5
?CND3: FIRST? THING >OBJ /?BOGUS14
?BOGUS14: ZERO? OBJ \?PRG18
PRINTI "nothing "
CALL2 PICK-NEXT,YAWNS
PRINT STACK
JUMP ?CND15
?PRG18: ZERO? OBJ /?CCL22
NEXT? OBJ >NXT /?BOGUS23
?BOGUS23: ZERO? 1ST? /?CCL26
SET '1ST?,FALSE-VALUE
JUMP ?CND24
?CCL26: ZERO? NXT /?CCL29
PRINTI ", "
JUMP ?CND24
?CCL29: ZERO? SAY-OR /?CCL31
PRINTI " or "
JUMP ?CND24
?CCL31: PRINT AND
?CND24: SET 'DESCING,OBJ
ICALL2 PRINTA,OBJ
EQUAL? OBJ,GOBLET \?CND32
IN? BFLY,OBJ \?CND32
FSET? BFLY,LIVING \?CND32
PRINT WITH
ICALL2 PRINTA,BFLY
PRINT STR?493
?CND32: EQUAL? THING,WINNER \?CND37
FSET? OBJ,WIELDED \?CND37
PRINTI " (wielded)"
?CND37: ZERO? IT? \?CCL43
ZERO? TWO? \?CCL43
SET 'IT?,OBJ
JUMP ?CND41
?CCL43: SET 'TWO?,TRUE-VALUE
SET 'IT?,FALSE-VALUE
?CND41: SET 'OBJ,NXT
JUMP ?PRG18
?CCL22: ZERO? IT? /?CND15
ZERO? TWO? \?CND15
ICALL2 THIS-IS-IT,IT?
?CND15: SET 'DESCING,FALSE-VALUE
ICALL MOVE-ALL,C-OBJECT,THING
RTRUE
.FUNCT MOVE-ALL,FROM,TO,EXCEPT,OBJ,NXT
FIRST? FROM >OBJ \FALSE
?PRG3: NEXT? OBJ >NXT /?BOGUS5
?BOGUS5: ASSIGNED? 'EXCEPT \?CCL7
FSET? OBJ,EXCEPT /?CND6
?CCL7: MOVE OBJ,TO
?CND6: SET 'OBJ,NXT
ZERO? OBJ \?PRG3
RTRUE
.FUNCT GLOBAL-IN?,SOURCE,OBJ1,OBJ2,OBJ3,LEN,X
GETPT SOURCE,P?GLOBAL >SOURCE
ZERO? SOURCE /FALSE
PTSIZE SOURCE
DIV STACK,2 >LEN
INTBL? OBJ1,SOURCE,LEN >X /TRUE
ASSIGNED? 'OBJ2 \FALSE
INTBL? OBJ2,SOURCE,LEN >X /TRUE
ASSIGNED? 'OBJ3 \FALSE
INTBL? OBJ3,SOURCE,LEN >X /TRUE
RFALSE
.FUNCT READ-LEXV,KEY,TBL,LEN,ILEN,X,Y,CNT,PTR,DEST,OFFSET,PAGE-SIZE,LAST-PAGE
SUB DHEIGHT,2 >PAGE-SIZE
SUB MAX-HEIGHT,DHEIGHT >LAST-PAGE
COPYT P-INBUF,0,P-INBUF-LENGTH
PUTB P-INBUF,0,80
COPYT P-LEXV,0,P-LEXV-LENGTH
PUTB P-LEXV,0,LEXMAX
?PRG1: COLOR INCOLOR,BGND
READ P-INBUF,0 >KEY
EQUAL? KEY,EOL,LF \?CND3
ICALL1 DO-LEX
RFALSE
?CND3: SET 'TBL,FALSE-VALUE
GETB P-INBUF,1 >ILEN
ADD ILEN,2
ADD P-INBUF,STACK >DEST
SET 'OFFSET,0
GRTR? KEY,PAD0 \?CCL7
LESS? KEY,155 \?CCL7
CALL2 KEYPAD,KEY >TBL
ZERO? TBL \?CND5
SOUND S-BOOP
JUMP ?PRG1
?CCL7: ZERO? DMODE /?CND5
EQUAL? KEY,CLICK1,CLICK2 \?CCL14
GET 0,27
GET STACK,2 >Y
GET 0,27
GET STACK,1 >X
GRTR? CWIDTH,1 \?CND15
DEC 'X
DIV X,CWIDTH >X
INC 'X
?CND15: GRTR? CHEIGHT,1 \?CND17
DEC 'Y
DIV Y,CHEIGHT >Y
INC 'Y
?CND17: GRTR? Y,12 /?PRG1
LESS? X,MOUSEDGE /?PRG1
CALL CLICKED,KEY,Y,X >TBL
ZERO? TBL \?CND5
SOUND S-BOOP
JUMP ?PRG1
?CCL14: EQUAL? KEY,UP-ARROW,MAC-UP-ARROW \?CCL26
ZERO? DBOX-TOP \?CND27
SOUND 2
JUMP ?PRG1
?CND27: SUB DBOX-TOP,PAGE-SIZE >DBOX-TOP
LESS? DBOX-TOP,0 \?CND29
SET 'DBOX-TOP,0
?CND29: ICALL1 DISPLAY-DBOX
JUMP ?PRG1
?CCL26: EQUAL? KEY,DOWN-ARROW,MAC-DOWN-ARROW \?CND5
SUB DBOX-LINES,DHEIGHT >X
BTST IN-DBOX,SHOWING-STATS /?CCL33
GRTR? DBOX-TOP,X /?CCL33
SUB LAST-PAGE,1
GRTR? DBOX-TOP,STACK \?CND32
?CCL33: SOUND 2
JUMP ?PRG1
?CND32: INC 'X
ADD DBOX-TOP,PAGE-SIZE >DBOX-TOP
GRTR? DBOX-TOP,X \?CCL39
SET 'DBOX-TOP,X
JUMP ?CND37
?CCL39: GRTR? DBOX-TOP,LAST-PAGE \?CND37
SET 'DBOX-TOP,LAST-PAGE
?CND37: ICALL1 DISPLAY-DBOX
JUMP ?PRG1
?CND5: GRTR? KEY,132 \?CND41
LESS? KEY,143 \?CND41
SUB KEY,F1
GET SOFT-KEYS,STACK >TBL
?CND41: ZERO? TBL /?PRG1
GETB TBL,1 >LEN
ZERO? LEN \?CCL49
SOUND S-BOOP
JUMP ?PRG1
?CCL49: ZERO? ILEN /?CND47
SUB 76,ILEN
GRTR? LEN,STACK \?CCL52
SOUND S-BOOP
JUMP ?PRG1
?CCL52: SUB DEST,1
GETB STACK,0
EQUAL? STACK,SP /?CND47
PUTB DEST,0,SP
INC 'DEST
INC 'OFFSET
BUFOUT FALSE-VALUE
PRINTC SP
?CND47: BUFOUT FALSE-VALUE
ICALL SHOW-TABLE,TBL,LEN
ADD TBL,2 >TBL
SET 'PTR,0
SUB LEN,1 >CNT
?PRG54: GETB TBL,PTR >X
EQUAL? X,EOL,LF /?CCL57
EQUAL? X,124,33 \?CND56
?CCL57: BUFOUT TRUE-VALUE
PUTB DEST,PTR,0
ADD PTR,ILEN
ADD STACK,OFFSET >LEN
PUTB P-INBUF,1,LEN
ICALL1 DO-LEX
RFALSE
?CND56: PUTB DEST,PTR,X
IGRTR? 'PTR,CNT \?PRG54
PRINTC SP
BUFOUT TRUE-VALUE
PUTB DEST,PTR,SP
INC 'OFFSET
ADD LEN,ILEN
ADD STACK,OFFSET >LEN
PUTB P-INBUF,1,LEN
JUMP ?PRG1
.FUNCT DO-LEX
LEX P-INBUF,P-LEXV
LEX P-INBUF,P-LEXV,VOCAB2,1
COLOR FORE,BGND
RFALSE
.FUNCT SHOW-TABLE,TBL,LEN,PTR,CHAR
SET 'PTR,2
INC 'LEN
?PRG1: GETB TBL,PTR >CHAR
EQUAL? CHAR,EOL,LF /?CTR4
EQUAL? CHAR,124,33 \?CCL5
?CTR4: CRLF
RFALSE
?CCL5: GRTR? CHAR,96 \?CND3
LESS? CHAR,123 \?CND3
SUB CHAR,SP >CHAR
?CND3: PRINTC CHAR
IGRTR? 'PTR,LEN \?PRG1
RFALSE
.FUNCT CLICKED,CLK,Y,X,NX,NY,DIR,TMP,MX,MY
SUB X,MOUSEDGE
SUB STACK,1 >X
DEC 'Y
EQUAL? Y,MAPY \?CCL3
EQUAL? X,MAPX \?CCL3
MUL MAPY,MWIDTH
ADD MAP,STACK
GETB STACK,MAPX >DIR
EQUAL? DIR,IUARROW,UARROW \?CCL8
SET 'DIR,I-U
JUMP ?CND1
?CCL8: EQUAL? DIR,IDARROW,DARROW \FALSE
SET 'DIR,I-D
JUMP ?CND1
?CCL3: SUB X,MAPX >NX
SUB Y,MAPY >NY
LESS? NY,0 \?CCL13
SUB 0,NY >MY
JUMP ?CND11
?CCL13: SET 'MY,NY
?CND11: LESS? NX,0 \?CCL16
SUB 0,NX >MX
JUMP ?CND14
?CCL16: SET 'MX,NX
?CND14: ZERO? MX \?CCL19
ZERO? MY \?CCL19
SET 'DIR,AMB
JUMP ?CND1
?CCL19: MUL 3,MX
GRTR? STACK,MY /?CCL23
GRTR? NY,0 \?CCL26
SET 'DIR,I-SOUTH
JUMP ?CND1
?CCL26: SET 'DIR,I-NORTH
JUMP ?CND1
?CCL23: MUL 2,MY
GRTR? STACK,MX /?CCL28
GRTR? NX,0 \?CCL31
SET 'DIR,I-EAST
JUMP ?CND1
?CCL31: SET 'DIR,I-WEST
JUMP ?CND1
?CCL28: GRTR? NX,0 \?CCL33
GRTR? NY,0 \?CCL36
SET 'DIR,I-SE
JUMP ?CND1
?CCL36: SET 'DIR,I-NE
JUMP ?CND1
?CCL33: GRTR? NY,0 \?CCL38
SET 'DIR,I-SW
JUMP ?CND1
?CCL38: SET 'DIR,I-NW
?CND1: EQUAL? DIR,AMB /FALSE
GET DIR-NAMES,DIR
ICALL2 TABLE-WALK,STACK
RETURN AUX-TABLE
.FUNCT TABLE-WALK,WRD
PUT AUX-TABLE,0,0
DIROUT D-TABLE-ON,AUX-TABLE
EQUAL? WRD,W?AROUND \?CND1
PRINTI "walk "
?CND1: PRINTB WRD
CRLF
DIROUT D-TABLE-OFF
GET AUX-TABLE,0
PUTB AUX-TABLE,1,STACK
RFALSE
.FUNCT KEYPAD,KEY,TBL,WRD
SUB KEY,PAD1
GET PAD-NAMES,STACK >WRD
EQUAL? KEY,PAD5 \?CND1
GETP HERE,P?UP >TBL
ZERO? TBL /?CND3
CALL CHECK-EXIT?,HERE,TBL
ZERO? STACK /?CND3
SET 'WRD,W?UP
?CND3: GETP HERE,P?DOWN >TBL
ZERO? TBL /?CND1
CALL CHECK-EXIT?,HERE,TBL
ZERO? STACK /?CND1
EQUAL? WRD,W?UP \?CCL11
SET 'WRD,W?AROUND
JUMP ?CND1
?CCL11: SET 'WRD,W?DOWN
?CND1: ICALL2 TABLE-WALK,WRD
RETURN AUX-TABLE
.FUNCT PICK-ONE,TBL,L,CNT,RND,X,RTBL
GET TBL,0 >L
GET TBL,1 >CNT
DEC 'L
ADD TBL,2 >TBL
MUL CNT,2
ADD TBL,STACK >RTBL
SUB L,CNT
RANDOM STACK >RND
GET RTBL,RND >X
GET RTBL,1
PUT RTBL,RND,STACK
PUT RTBL,1,X
INC 'CNT
EQUAL? CNT,L \?CND1
SET 'CNT,0
?CND1: PUT TBL,0,CNT
RETURN X
.FUNCT PICK-NEXT,TBL,CNT,STR
GET TBL,1 >CNT
GET TBL,CNT >STR
GET TBL,0
IGRTR? 'CNT,STACK \?CND1
SET 'CNT,2
?CND1: PUT TBL,1,CNT
RETURN STR
.FUNCT QUOTED-WORD?,PTR,VERB,NAMING,WRD
ZERO? VERB /?CND1
ZERO? P-QWORD \?CND1
ZERO? NAMING /?CND1
EQUAL? VERB,ACT?NAME \?CND1
SET 'P-QWORD,PTR
SET 'WRD,W?PPPZ
?CND1: ICALL CHANGE-LEXV,PTR,WRD
RETURN WRD
.FUNCT QUOTED-PHRASE?,PTR,VERB,1ST?,LEN,WRD,BPTR
SET '1ST?,TRUE-VALUE
ICALL CHANGE-LEXV,PTR,W?$BUZZ
SUB P-LEN,1 >LEN
ADD PTR,P-LEXELEN >PTR
MUL PTR,2
ADD P-LEXV,STACK >BPTR
?PRG1: LESS? LEN,0 \?CND3
ICALL1 PCLEAR
PRINTI "[You forgot a second quote.]"
CRLF
RFALSE
?CND3: GET P-LEXV,PTR >WRD
EQUAL? WRD,W?QUOTE \?CCL7
ICALL CHANGE-LEXV,PTR,W?$BUZZ
RTRUE
?CCL7: ZERO? 1ST? /?CCL9
ZERO? WRD /?CCL12
EQUAL? VERB,ACT?SAY /?CND5
EQUAL? VERB,ACT?NAME \?CND5
ICALL2 HOLLOW-VOICE,STR?516
RFALSE
?CCL12: CALL QUOTED-WORD?,PTR,VERB,TRUE-VALUE
ZERO? STACK /?CCL17
SET '1ST?,FALSE-VALUE
JUMP ?CND5
?CCL17: PRINT CANT
PRINTI "see any "
GETB BPTR,2 >LEN
GETB BPTR,3
ICALL WORD-PRINT,LEN,STACK
PRINTI " here."
CRLF
RFALSE
?CCL9: ICALL CHANGE-LEXV,PTR,W?$BUZZ
?CND5: ADD PTR,P-LEXELEN >PTR
DEC 'LEN
JUMP ?PRG1
.FUNCT ITS-CLOSED,OBJ
ASSIGNED? 'OBJ /?CND1
SET 'OBJ,PRSO
?CND1: ICALL2 THIS-IS-IT,OBJ
ICALL2 CTHE-PRINT,OBJ
ICALL2 IS-ARE,OBJ
PRINTB W?CLOSED
PRINT PERIOD
RTRUE
.FUNCT REMOVE-ALL,THING,OBJ,NXT
FIRST? THING >OBJ \FALSE
?PRG3: NEXT? OBJ >NXT /?BOGUS5
?BOGUS5: REMOVE OBJ
SET 'OBJ,NXT
ZERO? OBJ \?PRG3
RFALSE
.ENDI