432 lines
8.9 KiB
Plaintext
432 lines
8.9 KiB
Plaintext
|
|
|
|
.FUNCT RUNNING?,RTN,C,E,TICK
|
|
ADD C-TABLE,C-TABLELEN >E
|
|
ADD C-TABLE,C-INTS >C
|
|
?PRG1: EQUAL? C,E /FALSE
|
|
GET C,C-RTN
|
|
EQUAL? STACK,RTN \?CND3
|
|
GET C,C-ENABLED?
|
|
ZERO? STACK /FALSE
|
|
GET C,C-TICK >TICK
|
|
ZERO? TICK /FALSE
|
|
GRTR? TICK,1 /FALSE
|
|
RTRUE
|
|
?CND3: ADD C,C-INTLEN >C
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT PICK-ONE,FROB
|
|
GET FROB,0
|
|
RANDOM STACK
|
|
GET FROB,STACK
|
|
RSTACK
|
|
|
|
|
|
.FUNCT GO
|
|
START::
|
|
|
|
?FCN: PUTB P-LEXV,0,59
|
|
GETB 0,30 >HOST
|
|
GETB 0,33 >WIDTH
|
|
CALL QUEUE,I-HOUSEWRECK,20
|
|
PUT STACK,0,1
|
|
CALL QUEUE,I-THING,21
|
|
PUT STACK,0,1
|
|
CALL QUEUE,I-VOGONS,50
|
|
PUT STACK,0,1
|
|
SET 'WINNER,PROTAGONIST
|
|
SET 'PLAYER,PROTAGONIST
|
|
SET 'HERE,BEDROOM
|
|
SET 'IDENTITY-FLAG,ARTHUR
|
|
MOVE ARTHUR,GLOBAL-OBJECTS
|
|
SET 'LYING-DOWN,TRUE-VALUE
|
|
MOVE PROTAGONIST,BED
|
|
CLEAR -1
|
|
ICALL1 INIT-STATUS-LINE
|
|
ICALL1 V-VERSION
|
|
CRLF
|
|
PRINTI "You wake up. The room is spinning very gently round your head. Or at least it would be if you could see it which you can't."
|
|
CRLF
|
|
CRLF
|
|
ICALL1 V-LOOK
|
|
ICALL1 MAIN-LOOP
|
|
JUMP ?FCN
|
|
|
|
|
|
.FUNCT MAIN-LOOP,ICNT,OCNT,NUM,CNT,OBJ,TBL,V,PTBL,OBJ1,TMP,?TMP1
|
|
?PRG1: SET 'CNT,0
|
|
SET 'OBJ,FALSE-VALUE
|
|
SET 'PTBL,TRUE-VALUE
|
|
CALL1 PARSER >P-WON
|
|
ZERO? P-WON /?CCL5
|
|
GET P-PRSI,P-MATCHLEN >ICNT
|
|
GET P-PRSO,P-MATCHLEN >OCNT
|
|
ZERO? P-IT-OBJECT /?CND6
|
|
CALL2 ACCESSIBLE?,P-IT-OBJECT
|
|
ZERO? STACK /?CND6
|
|
SET 'TMP,FALSE-VALUE
|
|
?PRG10: IGRTR? 'CNT,ICNT /?REP11
|
|
GET P-PRSI,CNT
|
|
EQUAL? STACK,IT \?PRG10
|
|
PUT P-PRSI,CNT,P-IT-OBJECT
|
|
SET 'TMP,TRUE-VALUE
|
|
?REP11: ZERO? TMP \?CND17
|
|
SET 'CNT,0
|
|
?PRG19: IGRTR? 'CNT,OCNT /?CND17
|
|
GET P-PRSO,CNT
|
|
EQUAL? STACK,IT \?PRG19
|
|
PUT P-PRSO,CNT,P-IT-OBJECT
|
|
?CND17: SET 'CNT,0
|
|
?CND6: ZERO? OCNT \?CCL28
|
|
SET 'NUM,OCNT
|
|
JUMP ?CND26
|
|
?CCL28: GRTR? OCNT,1 \?CCL30
|
|
SET 'TBL,P-PRSO
|
|
ZERO? ICNT \?CCL33
|
|
SET 'OBJ,FALSE-VALUE
|
|
JUMP ?CND31
|
|
?CCL33: GET P-PRSI,1 >OBJ
|
|
?CND31: SET 'NUM,OCNT
|
|
JUMP ?CND26
|
|
?CCL30: GRTR? ICNT,1 \?CCL35
|
|
SET 'PTBL,FALSE-VALUE
|
|
SET 'TBL,P-PRSI
|
|
GET P-PRSO,1 >OBJ
|
|
SET 'NUM,ICNT
|
|
JUMP ?CND26
|
|
?CCL35: SET 'NUM,1
|
|
?CND26: ZERO? OBJ \?CND36
|
|
EQUAL? ICNT,1 \?CND36
|
|
GET P-PRSI,1 >OBJ
|
|
?CND36: EQUAL? PRSA,V?WALK \?CCL42
|
|
ZERO? P-WALK-DIR \?CTR41
|
|
ZERO? PRSO /?CCL42
|
|
?CTR41: CALL PERFORM,PRSA,PRSO >V
|
|
JUMP ?CND40
|
|
?CCL42: ZERO? NUM \?CCL48
|
|
GETB P-SYNTAX,P-SBITS
|
|
BAND STACK,P-SONUMS
|
|
ZERO? STACK \?CCL51
|
|
CALL2 PERFORM,PRSA >V
|
|
SET 'PRSO,FALSE-VALUE
|
|
JUMP ?CND40
|
|
?CCL51: ZERO? LIT \?PRG56
|
|
PRINT TOO-DARK
|
|
CRLF
|
|
ICALL1 FUCKING-CLEAR
|
|
JUMP ?CND40
|
|
?PRG56: PRINTI "There isn't anything to "
|
|
GET P-ITBL,P-VERBN >TMP
|
|
EQUAL? PRSA,V?TELL \?CCL60
|
|
PRINTI "talk to"
|
|
JUMP ?PRG67
|
|
?CCL60: ZERO? P-OFLAG \?CTR63
|
|
ZERO? P-MERGED /?CCL64
|
|
?CTR63: GET TMP,0
|
|
PRINTB STACK
|
|
JUMP ?PRG67
|
|
?CCL64: GETB TMP,2 >?TMP1
|
|
GETB TMP,3
|
|
ICALL WORD-PRINT,?TMP1,STACK
|
|
?PRG67: PRINTC 33
|
|
CRLF
|
|
SET 'V,FALSE-VALUE
|
|
ICALL1 FUCKING-CLEAR
|
|
JUMP ?CND40
|
|
?CCL48: SET 'P-NOT-HERE,0
|
|
SET 'P-MULT,FALSE-VALUE
|
|
GRTR? NUM,1 \?CND69
|
|
SET 'P-MULT,TRUE-VALUE
|
|
?CND69: SET 'TMP,FALSE-VALUE
|
|
?PRG71: IGRTR? 'CNT,NUM \?CCL75
|
|
GRTR? P-NOT-HERE,0 \?CCL78
|
|
PRINTI "The "
|
|
EQUAL? P-NOT-HERE,NUM /?PRG85
|
|
PRINTI "other "
|
|
?PRG85: PRINTI "object"
|
|
EQUAL? P-NOT-HERE,1 /?PRG91
|
|
PRINTC 115
|
|
?PRG91: PRINTI " that you mentioned "
|
|
EQUAL? P-NOT-HERE,1 /?PRG98
|
|
PRINTI "are"
|
|
JUMP ?PRG100
|
|
?PRG98: PRINTI "is"
|
|
?PRG100: PRINTI "n't here."
|
|
CRLF
|
|
JUMP ?CND40
|
|
?CCL78: ZERO? TMP \?CND40
|
|
PRINT REFERRING
|
|
CRLF
|
|
JUMP ?CND40
|
|
?CCL75: ZERO? PTBL /?CCL107
|
|
GET P-PRSO,CNT >OBJ1
|
|
JUMP ?CND105
|
|
?CCL107: GET P-PRSI,CNT >OBJ1
|
|
?CND105: ZERO? PTBL /?CCL110
|
|
SET 'PRSO,OBJ1
|
|
JUMP ?CND108
|
|
?CCL110: SET 'PRSO,OBJ
|
|
?CND108: ZERO? PTBL /?CCL113
|
|
SET 'PRSI,OBJ
|
|
JUMP ?CND111
|
|
?CCL113: SET 'PRSI,OBJ1
|
|
?CND111: GRTR? NUM,1 /?CCL115
|
|
GET P-ITBL,P-NC1
|
|
GET STACK,0
|
|
EQUAL? STACK,W?ALL \?CND114
|
|
?CCL115: EQUAL? OBJ1,NOT-HERE-OBJECT \?CCL120
|
|
INC 'P-NOT-HERE
|
|
JUMP ?PRG71
|
|
?CCL120: EQUAL? P-GETFLAGS,P-ALL \?CCL122
|
|
EQUAL? PRSA,V?PICK-UP,V?TAKE \?CCL122
|
|
LOC OBJ1
|
|
EQUAL? STACK,WINNER,HERE,PRSI /?PRD127
|
|
LOC OBJ1
|
|
FSET? STACK,SURFACEBIT \?PRG71
|
|
?PRD127: FSET? OBJ1,TAKEBIT /?CCL122
|
|
FSET? OBJ1,TRYTAKEBIT \?PRG71
|
|
?CCL122: EQUAL? PRSA,V?PICK-UP,V?TAKE \?CCL133
|
|
ZERO? PRSI /?CCL133
|
|
IN? PRSO,PRSI \?PRG71
|
|
?CCL133: EQUAL? P-GETFLAGS,P-ALL \?CCL138
|
|
EQUAL? PRSA,V?DROP \?CCL138
|
|
IN? OBJ1,WINNER \?PRG71
|
|
?CCL138: EQUAL? P-GETFLAGS,P-ALL \?CCL143
|
|
ZERO? PRSI /?CCL143
|
|
EQUAL? PRSO,PRSI /?PRG71
|
|
?CCL143: EQUAL? P-GETFLAGS,P-ALL \?CCL148
|
|
EQUAL? PRSA,V?PUT \?CCL148
|
|
CALL HELD?,PRSO,PRSI
|
|
ZERO? STACK \?PRG71
|
|
?CCL148: CALL2 ACCESSIBLE?,OBJ1
|
|
ZERO? STACK /?PRG71
|
|
EQUAL? OBJ1,IT \?CCL156
|
|
PRINTD P-IT-OBJECT
|
|
JUMP ?CND154
|
|
?CCL156: CALL2 TEA-PRINT,OBJ1
|
|
ZERO? STACK /?CND154
|
|
PRINTD OBJ1
|
|
?CND154: CALL2 TEA-PRINT,OBJ1
|
|
ZERO? STACK /?CND114
|
|
PRINTI ": "
|
|
?CND114: SET 'TMP,TRUE-VALUE
|
|
CALL PERFORM,PRSA,PRSO,PRSI >V
|
|
EQUAL? V,M-FATAL \?PRG71
|
|
?CND40: EQUAL? V,M-FATAL /?CND164
|
|
EQUAL? PRSA,V?SUPERBRIEF,V?BRIEF,V?TELL /?CND164
|
|
EQUAL? PRSA,V?SAVE,V?HINTS,V?VERBOSE /?CND164
|
|
EQUAL? PRSA,V?SCRIPT,V?RESTORE,V?VERSION /?CND164
|
|
EQUAL? PRSA,V?UNSCRIPT /?CND164
|
|
LOC WINNER
|
|
GETP STACK,P?ACTION
|
|
CALL STACK,M-END >V
|
|
?CND164: EQUAL? V,M-FATAL \?CND3
|
|
SET 'P-CONT,FALSE-VALUE
|
|
JUMP ?CND3
|
|
?CCL5: SET 'P-CONT,FALSE-VALUE
|
|
?CND3: ZERO? P-WON /?CCL177
|
|
EQUAL? PRSA,V?SUPERBRIEF,V?BRIEF,V?TELL /?CND178
|
|
EQUAL? PRSA,V?QUIT,V?VERSION,V?VERBOSE /?CND178
|
|
EQUAL? PRSA,V?RESTORE,V?SAVE,V?SCORE /?CND178
|
|
EQUAL? PRSA,V?FOOTNOTE,V?UNSCRIPT,V?SCRIPT /?CND178
|
|
EQUAL? PRSA,V?RESTART,V?HINTS /?CND178
|
|
EQUAL? PRSA,V?WAIT \?CCL187
|
|
ZERO? DONT-FLAG \?CND178
|
|
?CCL187: CALL1 CLOCKER >V
|
|
?CND178: SET 'PRSA,FALSE-VALUE
|
|
SET 'PRSO,FALSE-VALUE
|
|
SET 'PRSI,FALSE-VALUE
|
|
JUMP ?PRG1
|
|
?CCL177: GETB P-LEXV,P-LEXWORDS
|
|
GRTR? STACK,3 \?PRG1
|
|
ZERO? CARELESS-WORDS-FLAG \?PRG1
|
|
ZERO? EARTH-DEMOLISHED /?PRG1
|
|
CALL2 SAVE-INPUT,FIRST-BUFFER
|
|
ZERO? STACK /?PRG1
|
|
SET 'CARELESS-WORDS-FLAG,TRUE-VALUE
|
|
CALL QUEUE,I-CARELESS-WORDS,3
|
|
PUT STACK,0,1
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT SAVE-INPUT,TBL,OFFS,CNT,TMP,?TMP1
|
|
MUL 4,P-INPUT-WORDS >TMP
|
|
GETB P-LEXV,TMP >?TMP1
|
|
ADD TMP,1
|
|
GETB P-LEXV,STACK
|
|
ADD ?TMP1,STACK >CNT
|
|
ZERO? CNT /FALSE
|
|
DEC 'CNT
|
|
?PRG3: EQUAL? OFFS,CNT \?CCL7
|
|
PUTB TBL,OFFS,0
|
|
RTRUE
|
|
?CCL7: ADD OFFS,1
|
|
GETB P-INBUF,STACK
|
|
PUTB TBL,OFFS,STACK
|
|
INC 'OFFS
|
|
JUMP ?PRG3
|
|
|
|
|
|
.FUNCT RESTORE-INPUT,TBL,CHR
|
|
INC 'TBL
|
|
?PRG1: GETB TBL,0 >CHR
|
|
ZERO? CHR /TRUE
|
|
PRINTC CHR
|
|
INC 'TBL
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT FAKE-ORPHAN,TMP,?TMP1
|
|
ICALL ORPHAN,P-SYNTAX,FALSE-VALUE
|
|
PRINTI "Be specific: what object do"
|
|
ZERO? DONT-FLAG /?PRG7
|
|
PRINTI "n't"
|
|
?PRG7: PRINTI " you want to "
|
|
GET P-OTBL,P-VERBN >TMP
|
|
ZERO? TMP \?CCL11
|
|
PRINTI "tell"
|
|
JUMP ?CND9
|
|
?CCL11: GETB P-VTBL,2
|
|
ZERO? STACK \?CCL15
|
|
GET TMP,0
|
|
PRINTB STACK
|
|
JUMP ?CND9
|
|
?CCL15: GETB TMP,2 >?TMP1
|
|
GETB TMP,3
|
|
ICALL WORD-PRINT,?TMP1,STACK
|
|
PUTB P-VTBL,2,0
|
|
?CND9: SET 'P-OFLAG,TRUE-VALUE
|
|
SET 'P-WON,FALSE-VALUE
|
|
GETB P-SYNTAX,P-SPREP1
|
|
ICALL2 PREP-PRINT,STACK
|
|
PRINTR "?"
|
|
|
|
|
|
.FUNCT PERFORM,A,O,I,V,OA,OO,OI
|
|
SET 'OA,PRSA
|
|
SET 'OO,PRSO
|
|
SET 'OI,PRSI
|
|
SET 'PRSA,A
|
|
EQUAL? IT,I,O \?CND1
|
|
ZERO? P-WALK-DIR \?CND1
|
|
EQUAL? A,V?WALK /?CND1
|
|
ZERO? I \?PRG9
|
|
ICALL1 FAKE-ORPHAN
|
|
RETURN 2
|
|
?PRG9: PRINT REFERRING
|
|
CRLF
|
|
RETURN 2
|
|
?CND1: SET 'PRSO,O
|
|
SET 'PRSI,I
|
|
EQUAL? A,V?WALK /?CND13
|
|
ZERO? P-WALK-DIR \?CND13
|
|
EQUAL? NOT-HERE-OBJECT,PRSO,PRSI \?CND13
|
|
CALL D-APPLY,STR?1,NOT-HERE-OBJECT-F >V
|
|
ZERO? V /?CND13
|
|
SET 'P-WON,FALSE-VALUE
|
|
?CND13: SET 'O,PRSO
|
|
SET 'I,PRSI
|
|
ICALL2 THIS-IS-IT,PRSI
|
|
ICALL2 THIS-IS-IT,PRSO
|
|
ZERO? V \?CND20
|
|
GETP WINNER,P?ACTION
|
|
CALL D-APPLY,STR?2,STACK >V
|
|
?CND20: ZERO? V \?CND22
|
|
ZERO? DONT-FLAG /?CND22
|
|
CALL1 DONT-F >V
|
|
?CND22: ZERO? V \?CND26
|
|
LOC WINNER
|
|
ZERO? STACK /?CND26
|
|
LOC WINNER
|
|
GETP STACK,P?ACTION
|
|
CALL D-APPLY,STR?3,STACK,M-BEG >V
|
|
?CND26: ZERO? V \?CND30
|
|
GET PREACTIONS,A
|
|
CALL D-APPLY,STR?4,STACK >V
|
|
?CND30: ZERO? V \?CND32
|
|
ZERO? I /?CND32
|
|
GETP I,P?ACTION
|
|
CALL D-APPLY,STR?5,STACK >V
|
|
?CND32: ZERO? V \?CND36
|
|
ZERO? O /?CND36
|
|
EQUAL? A,V?WALK /?CND36
|
|
GETP O,P?ACTION
|
|
CALL D-APPLY,STR?6,STACK >V
|
|
?CND36: ZERO? V \?CND41
|
|
GET ACTIONS,A
|
|
CALL D-APPLY,FALSE-VALUE,STACK >V
|
|
?CND41: SET 'PRSA,OA
|
|
SET 'PRSO,OO
|
|
SET 'PRSI,OI
|
|
RETURN V
|
|
|
|
|
|
.FUNCT THIS-IS-IT,OBJ
|
|
EQUAL? OBJ,FALSE-VALUE,PROTAGONIST /TRUE
|
|
EQUAL? OBJ,NOT-HERE-OBJECT,ME,GLOBAL-ROOM /TRUE
|
|
EQUAL? PRSA,V?WALK \?CCL3
|
|
EQUAL? PRSO,OBJ /TRUE
|
|
?CCL3: SET 'P-IT-OBJECT,OBJ
|
|
RETURN P-IT-OBJECT
|
|
|
|
|
|
.FUNCT D-APPLY,STR,FCN,FOO,RES
|
|
ZERO? FCN /FALSE
|
|
ZERO? FOO /?CCL6
|
|
CALL FCN,FOO >RES
|
|
RETURN RES
|
|
?CCL6: CALL FCN >RES
|
|
RETURN RES
|
|
|
|
|
|
.FUNCT QUEUE,RTN,TICK,CINT
|
|
CALL2 INT,RTN >CINT
|
|
PUT CINT,C-TICK,TICK
|
|
RETURN CINT
|
|
|
|
|
|
.FUNCT INT,RTN,E,C,INT
|
|
ADD C-TABLE,C-TABLELEN >E
|
|
ADD C-TABLE,C-INTS >C
|
|
?PRG1: EQUAL? C,E \?CCL5
|
|
SUB C-INTS,C-INTLEN >C-INTS
|
|
ADD C-TABLE,C-INTS >INT
|
|
PUT INT,C-RTN,RTN
|
|
RETURN INT
|
|
?CCL5: GET C,C-RTN
|
|
EQUAL? STACK,RTN \?CND3
|
|
RETURN C
|
|
?CND3: ADD C,C-INTLEN >C
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT CLOCKER,C,E,TICK,FLG
|
|
ZERO? CLOCK-WAIT /?CND1
|
|
SET 'CLOCK-WAIT,FALSE-VALUE
|
|
RFALSE
|
|
?CND1: ZERO? P-WON \?CCL5
|
|
PUSH 0
|
|
JUMP ?CND3
|
|
?CCL5: PUSH C-INTS
|
|
?CND3: ADD C-TABLE,STACK >C
|
|
ADD C-TABLE,C-TABLELEN >E
|
|
?PRG6: EQUAL? C,E \?CCL10
|
|
INC 'MOVES
|
|
RETURN FLG
|
|
?CCL10: GET C,C-ENABLED?
|
|
ZERO? STACK /?CND8
|
|
GET C,C-TICK >TICK
|
|
ZERO? TICK /?CND8
|
|
SUB TICK,1
|
|
PUT C,C-TICK,STACK
|
|
GRTR? TICK,1 /?CND8
|
|
GET C,C-RTN
|
|
CALL STACK
|
|
ZERO? STACK /?CND8
|
|
SET 'FLG,TRUE-VALUE
|
|
?CND8: ADD C,C-INTLEN >C
|
|
JUMP ?PRG6
|
|
|
|
.ENDI
|