2886 lines
60 KiB
Plaintext
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
|