470 lines
9.8 KiB
Plaintext
470 lines
9.8 KiB
Plaintext
|
|
|
|
.FUNCT PICK-ONE,FROB
|
|
GET FROB,0
|
|
RANDOM STACK
|
|
GET FROB,STACK
|
|
RSTACK
|
|
|
|
|
|
.FUNCT GO
|
|
START::
|
|
|
|
?FCN: GETB 0,30 >HOST
|
|
GETB 0,33 >WIDTH
|
|
CALL QUEUE,I-BLATHER,-1
|
|
PUT STACK,0,1
|
|
CALL QUEUE,I-AMBASSADOR,-1
|
|
PUT STACK,0,1
|
|
CALL QUEUE,I-RANDOM-INTERRUPTS,1
|
|
PUT STACK,0,1
|
|
CALL QUEUE,I-SLEEP-WARNINGS,3600
|
|
PUT STACK,0,1
|
|
CALL QUEUE,I-HUNGER-WARNINGS,2000
|
|
PUT STACK,0,1
|
|
CALL QUEUE,I-SICKNESS-WARNINGS,1000
|
|
PUT STACK,0,1
|
|
SET 'SPOUT-PLACED,GROUND
|
|
GETB 0,56
|
|
ZERO? STACK \?CCL3
|
|
RANDOM 180
|
|
ADD 4450,STACK >INTERNAL-MOVES
|
|
JUMP ?CND1
|
|
?CCL3: SET 'INTERNAL-MOVES,4540
|
|
?CND1: SET 'MOVES,INTERNAL-MOVES
|
|
SET 'LIT,TRUE-VALUE
|
|
SET 'WINNER,ADVENTURER
|
|
CLEAR -1
|
|
ICALL1 INIT-STATUS-LINE
|
|
SET 'HERE,DECK-NINE
|
|
ICALL1 UPDATE-STATUS-LINE
|
|
SET 'P-IT-LOC,DECK-NINE
|
|
SET 'P-IT-OBJECT,POD-DOOR
|
|
FSET? HERE,TOUCHBIT /?CND4
|
|
ICALL1 V-VERSION
|
|
CRLF
|
|
PRINTI "Another routine day of drudgery aboard the Stellar Patrol Ship Feinstein. This morning's assignment for a certain lowly Ensign Seventh Class: scrubbing the filthy metal deck at the port end of Level Nine. With your Patrol-issue self-contained multi-purpose all-weather scrub brush you shine the floor with a diligence born of the knowledge that at any moment dreaded Ensign First Class Blather, the bane of your shipboard existence, could appear."
|
|
CRLF
|
|
CRLF
|
|
?CND4: ICALL1 V-LOOK
|
|
ICALL1 MAIN-LOOP
|
|
JUMP ?FCN
|
|
|
|
|
|
.FUNCT I-RANDOM-INTERRUPTS
|
|
RANDOM 90
|
|
ADD STACK,240
|
|
CALL QUEUE,I-BLOWUP-FEINSTEIN,STACK
|
|
PUT STACK,0,1
|
|
ICALL1 COMM-SETUP
|
|
RANDOM 1000 >NUMBER-NEEDED
|
|
RETURN NUMBER-NEEDED
|
|
|
|
|
|
.FUNCT MAIN-LOOP,TRASH
|
|
?PRG1: CALL1 MAIN-LOOP-1 >TRASH
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT MAIN-LOOP-1,ICNT,OCNT,NUM,CNT,OBJ,TBL,V,PTBL,OBJ1,TMP,?TMP1
|
|
SET 'C-ELAPSED,C-ELAPSED-DEFAULT
|
|
SET 'CNT,0
|
|
SET 'OBJ,FALSE-VALUE
|
|
SET 'PTBL,TRUE-VALUE
|
|
CALL1 PARSER >P-WON
|
|
ZERO? P-WON /?CCL3
|
|
GET P-PRSI,P-MATCHLEN >ICNT
|
|
GET P-PRSO,P-MATCHLEN >OCNT
|
|
ZERO? P-IT-OBJECT /?CND4
|
|
CALL2 ACCESSIBLE?,P-IT-OBJECT
|
|
ZERO? STACK /?CND4
|
|
SET 'TMP,FALSE-VALUE
|
|
?PRG8: IGRTR? 'CNT,ICNT /?REP9
|
|
GET P-PRSI,CNT
|
|
EQUAL? STACK,IT \?PRG8
|
|
CALL1 TOO-DARK-FOR-IT?
|
|
ZERO? STACK \TRUE
|
|
PUT P-PRSI,CNT,P-IT-OBJECT
|
|
SET 'TMP,TRUE-VALUE
|
|
?REP9: ZERO? TMP \?CND17
|
|
SET 'CNT,0
|
|
?PRG19: IGRTR? 'CNT,OCNT /?CND17
|
|
GET P-PRSO,CNT
|
|
EQUAL? STACK,IT \?PRG19
|
|
CALL1 TOO-DARK-FOR-IT?
|
|
ZERO? STACK \TRUE
|
|
PUT P-PRSO,CNT,P-IT-OBJECT
|
|
?CND17: SET 'CNT,0
|
|
?CND4: ZERO? OCNT \?CCL30
|
|
SET 'NUM,OCNT
|
|
JUMP ?CND28
|
|
?CCL30: GRTR? OCNT,1 \?CCL32
|
|
SET 'TBL,P-PRSO
|
|
ZERO? ICNT \?CCL35
|
|
SET 'OBJ,FALSE-VALUE
|
|
JUMP ?CND33
|
|
?CCL35: GET P-PRSI,1 >OBJ
|
|
?CND33: SET 'NUM,OCNT
|
|
JUMP ?CND28
|
|
?CCL32: GRTR? ICNT,1 \?CCL37
|
|
SET 'PTBL,FALSE-VALUE
|
|
SET 'TBL,P-PRSI
|
|
GET P-PRSO,1 >OBJ
|
|
SET 'NUM,ICNT
|
|
JUMP ?CND28
|
|
?CCL37: SET 'NUM,1
|
|
?CND28: ZERO? OBJ \?CND38
|
|
EQUAL? ICNT,1 \?CND38
|
|
GET P-PRSI,1 >OBJ
|
|
?CND38: EQUAL? PRSA,V?WALK \?CCL44
|
|
CALL2 PERFORM-PRSA,PRSO >V
|
|
JUMP ?CND42
|
|
?CCL44: ZERO? NUM \?CCL46
|
|
GETB P-SYNTAX,P-SBITS
|
|
BAND STACK,P-SONUMS
|
|
ZERO? STACK \?CCL49
|
|
CALL1 PERFORM-PRSA >V
|
|
SET 'PRSO,FALSE-VALUE
|
|
JUMP ?CND42
|
|
?CCL49: ZERO? LIT \?CCL51
|
|
PRINT TOO-DARK
|
|
CRLF
|
|
ICALL1 STOP
|
|
JUMP ?CND42
|
|
?CCL51: PRINTI "There isn't anything to "
|
|
GET P-ITBL,P-VERBN >TMP
|
|
ZERO? P-OFLAG \?CTR53
|
|
ZERO? P-MERGED /?CCL54
|
|
?CTR53: GET TMP,0
|
|
PRINTB STACK
|
|
JUMP ?CND52
|
|
?CCL54: GETB TMP,2 >?TMP1
|
|
GETB TMP,3
|
|
ICALL WORD-PRINT,?TMP1,STACK
|
|
?CND52: PRINTC 33
|
|
CRLF
|
|
SET 'V,FALSE-VALUE
|
|
ICALL1 STOP
|
|
JUMP ?CND42
|
|
?CCL46: SET 'P-NOT-HERE,0
|
|
SET 'P-MULT,FALSE-VALUE
|
|
GRTR? NUM,1 \?CND57
|
|
SET 'P-MULT,TRUE-VALUE
|
|
?CND57: SET 'TMP,FALSE-VALUE
|
|
?PRG59: IGRTR? 'CNT,NUM \?CCL63
|
|
GRTR? P-NOT-HERE,0 \?CCL66
|
|
PRINTI "[The "
|
|
EQUAL? P-NOT-HERE,NUM /?CND67
|
|
PRINTI "other "
|
|
?CND67: PRINTI "object"
|
|
EQUAL? P-NOT-HERE,1 /?CND69
|
|
PRINTC 115
|
|
?CND69: PRINTI " that you mentioned "
|
|
EQUAL? P-NOT-HERE,1 /?CCL73
|
|
PRINTI "are"
|
|
JUMP ?CND71
|
|
?CCL73: PRINTI "is"
|
|
?CND71: PRINTI "n't here.]"
|
|
CRLF
|
|
JUMP ?CND42
|
|
?CCL66: ZERO? TMP \?CND42
|
|
PRINTI "There's nothing there."
|
|
CRLF
|
|
JUMP ?CND42
|
|
?CCL63: ZERO? PTBL /?CCL77
|
|
GET P-PRSO,CNT >OBJ1
|
|
JUMP ?CND75
|
|
?CCL77: GET P-PRSI,CNT >OBJ1
|
|
?CND75: ZERO? PTBL /?CCL80
|
|
SET 'PRSO,OBJ1
|
|
JUMP ?CND78
|
|
?CCL80: SET 'PRSO,OBJ
|
|
?CND78: ZERO? PTBL /?CCL83
|
|
SET 'PRSI,OBJ
|
|
JUMP ?CND81
|
|
?CCL83: SET 'PRSI,OBJ1
|
|
?CND81: GRTR? NUM,1 /?CCL85
|
|
GET P-ITBL,P-NC1
|
|
GET STACK,0
|
|
EQUAL? STACK,W?ALL \?CND84
|
|
?CCL85: CALL2 DONT-ALL,OBJ1
|
|
ZERO? STACK \?PRG59
|
|
EQUAL? OBJ1,IT \?CCL93
|
|
PRINTD P-IT-OBJECT
|
|
JUMP ?CND91
|
|
?CCL93: PRINTD OBJ1
|
|
?CND91: PRINTI ": "
|
|
?CND84: SET 'TMP,TRUE-VALUE
|
|
CALL PERFORM-PRSA,PRSO,PRSI >V
|
|
EQUAL? V,M-FATAL \?PRG59
|
|
?CND42: EQUAL? V,M-FATAL \?CND96
|
|
SET 'P-CONT,FALSE-VALUE
|
|
?CND96: CALL2 CLOCKER-VERB?,PRSA
|
|
ZERO? STACK /?CND1
|
|
EQUAL? PRSA,V?TELL /?CND1
|
|
ZERO? P-WON /?CND1
|
|
LOC WINNER
|
|
GETP STACK,P?ACTION
|
|
CALL STACK,M-END >V
|
|
JUMP ?CND1
|
|
?CCL3: SET 'P-CONT,FALSE-VALUE
|
|
?CND1: CALL2 INT,I-POD-TRIP
|
|
GET STACK,C-ENABLED?
|
|
ZERO? STACK /?CCL105
|
|
SET 'C-ELAPSED,54
|
|
JUMP ?CND103
|
|
?CCL105: GRTR? SHUTTLE-VELOCITY,0 \?CCL107
|
|
DIV 600,SHUTTLE-VELOCITY >C-ELAPSED
|
|
JUMP ?CND103
|
|
?CCL107: EQUAL? PRSA,V?TELL /?CCL108
|
|
CALL2 CLOCKER-VERB?,PRSA
|
|
ZERO? STACK \?CND103
|
|
?CCL108: SET 'C-ELAPSED,0
|
|
?CND103: ADD INTERNAL-MOVES,C-ELAPSED >INTERNAL-MOVES
|
|
IN? CHRONOMETER,ADVENTURER /?CCL113
|
|
SET 'MOVES,0
|
|
JUMP ?CND111
|
|
?CCL113: FSET? CHRONOMETER,MUNGEDBIT \?CCL115
|
|
SET 'MOVES,MUNGED-TIME
|
|
JUMP ?CND111
|
|
?CCL115: SET 'MOVES,INTERNAL-MOVES
|
|
?CND111: ZERO? P-WON /FALSE
|
|
ZERO? C-ELAPSED /?CND119
|
|
CALL1 CLOCKER >V
|
|
?CND119: SET 'P-PRSA-WORD,FALSE-VALUE
|
|
SET 'PRSA,FALSE-VALUE
|
|
SET 'PRSO,FALSE-VALUE
|
|
SET 'PRSI,FALSE-VALUE
|
|
RETURN PRSI
|
|
|
|
|
|
.FUNCT TOO-DARK-FOR-IT?
|
|
ZERO? LIT \FALSE
|
|
CALL HELD?,P-IT-OBJECT,WINNER
|
|
ZERO? STACK \FALSE
|
|
IN? WINNER,P-IT-OBJECT /FALSE
|
|
PRINT TOO-DARK
|
|
CRLF
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DONT-ALL,OBJ1,L
|
|
LOC OBJ1 >L
|
|
EQUAL? OBJ1,NOT-HERE-OBJECT \?CCL3
|
|
INC 'P-NOT-HERE
|
|
RTRUE
|
|
?CCL3: EQUAL? PRSA,V?TAKE \?CCL5
|
|
ZERO? PRSI /?CCL5
|
|
IN? PRSO,PRSI \TRUE
|
|
?CCL5: CALL2 ACCESSIBLE?,OBJ1
|
|
ZERO? STACK /TRUE
|
|
EQUAL? P-GETFLAGS,P-ALL \FALSE
|
|
ZERO? PRSI /?CCL15
|
|
EQUAL? PRSO,PRSI /TRUE
|
|
?CCL15: EQUAL? PRSA,V?TAKE \?CCL19
|
|
FSET? OBJ1,TAKEBIT /?CCL22
|
|
FSET? OBJ1,TRYTAKEBIT \TRUE
|
|
?CCL22: EQUAL? L,WINNER,HERE,PRSI /?CCL26
|
|
LOC WINNER
|
|
EQUAL? L,STACK /?CCL26
|
|
FSET? L,SURFACEBIT \TRUE
|
|
FSET? L,TAKEBIT /TRUE
|
|
RFALSE
|
|
?CCL26: ZERO? PRSI \FALSE
|
|
CALL2 HELD?,PRSO
|
|
ZERO? STACK /FALSE
|
|
RTRUE
|
|
?CCL19: EQUAL? PRSA,V?PUT-ON,V?PUT,V?DROP /?PRD41
|
|
EQUAL? PRSA,V?SGIVE,V?GIVE \?CCL39
|
|
?PRD41: IN? OBJ1,WINNER \TRUE
|
|
?CCL39: EQUAL? PRSA,V?PUT-ON,V?PUT \FALSE
|
|
IN? PRSO,WINNER /FALSE
|
|
CALL HELD?,PRSO,PRSI
|
|
ZERO? STACK \TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT CLOCKER-VERB?,VRB
|
|
EQUAL? VRB,V?BRIEF,V?SUPER-BRIEF,V?VERBOSE /FALSE
|
|
EQUAL? VRB,V?SAVE,V?RESTORE,V?SCORE /FALSE
|
|
EQUAL? VRB,V?SCRIPT,V?UNSCRIPT,V?TIME /FALSE
|
|
EQUAL? VRB,V?QUIT,V?RESTART,V?VERSION /FALSE
|
|
EQUAL? VRB,V?$RANDOM,V?$RECORD,V?$UNRECORD /FALSE
|
|
EQUAL? VRB,V?$COMMAND,V?HINT,V?HINTS-NO /FALSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT FAKE-ORPHAN,IT-WAS-USED,TMP,?TMP1
|
|
ICALL ORPHAN,P-SYNTAX,FALSE-VALUE
|
|
GET P-OTBL,P-VERBN >TMP
|
|
PRINTI "[Be specific: Wh"
|
|
ZERO? IT-WAS-USED /?CCL3
|
|
PRINTI "at object"
|
|
JUMP ?CND1
|
|
?CCL3: PRINTC 111
|
|
?CND1: PRINTI " do you want to "
|
|
ZERO? TMP \?CCL6
|
|
PRINTI "tell"
|
|
JUMP ?CND4
|
|
?CCL6: GETB P-VTBL,2
|
|
ZERO? STACK \?CCL8
|
|
GET TMP,0
|
|
PRINTB STACK
|
|
JUMP ?CND4
|
|
?CCL8: GETB TMP,2 >?TMP1
|
|
GETB TMP,3
|
|
ICALL WORD-PRINT,?TMP1,STACK
|
|
PUTB P-VTBL,2,0
|
|
?CND4: SET 'P-OFLAG,TRUE-VALUE
|
|
SET 'P-WON,FALSE-VALUE
|
|
GETB P-SYNTAX,P-SPREP1
|
|
ICALL2 PREP-PRINT,STACK
|
|
PRINTR "?]"
|
|
|
|
|
|
.FUNCT PERFORM-PRSA,O,I
|
|
CALL PERFORM,PRSA,O,I
|
|
RSTACK
|
|
|
|
|
|
.FUNCT PERFORM,A,O,I,V,OA,OO,OI
|
|
SET 'OA,PRSA
|
|
SET 'OO,PRSO
|
|
SET 'OI,PRSI
|
|
SET 'PRSA,A
|
|
ZERO? P-WALK-DIR \?CND1
|
|
EQUAL? A,V?WALK /?CND1
|
|
EQUAL? IT,I,O \?CND1
|
|
CALL2 VISIBLE?,P-IT-OBJECT
|
|
ZERO? STACK /?CCL9
|
|
EQUAL? IT,O \?CCL12
|
|
SET 'O,P-IT-OBJECT
|
|
JUMP ?CND1
|
|
?CCL12: SET 'I,P-IT-OBJECT
|
|
?CND1: SET 'PRSO,O
|
|
SET 'PRSI,I
|
|
EQUAL? A,V?WALK /?CND18
|
|
ZERO? P-WALK-DIR \?CND18
|
|
EQUAL? NOT-HERE-OBJECT,PRSO,PRSI \?CND18
|
|
CALL D-APPLY,STR?1,NOT-HERE-OBJECT-F >V
|
|
ZERO? V /?CND18
|
|
SET 'P-WON,FALSE-VALUE
|
|
?CND18: SET 'O,PRSO
|
|
SET 'I,PRSI
|
|
ICALL2 THIS-IS-IT,PRSI
|
|
ICALL2 THIS-IS-IT,PRSO
|
|
ZERO? V \?CND25
|
|
GETP WINNER,P?ACTION
|
|
CALL D-APPLY,STR?2,STACK >V
|
|
?CND25: ZERO? V \?CND27
|
|
GETP HERE,P?ACTION
|
|
CALL D-APPLY,STR?3,STACK,M-BEG >V
|
|
?CND27: ZERO? V \?CND29
|
|
GET PREACTIONS,A
|
|
CALL D-APPLY,STR?4,STACK >V
|
|
?CND29: ZERO? V \?CND31
|
|
ZERO? I /?CND31
|
|
GETP I,P?ACTION
|
|
CALL D-APPLY,STR?5,STACK >V
|
|
?CND31: ZERO? V \?CND35
|
|
ZERO? O /?CND35
|
|
EQUAL? A,V?WALK /?CND35
|
|
GETP O,P?ACTION
|
|
CALL D-APPLY,STR?6,STACK >V
|
|
?CND35: ZERO? V \?CND40
|
|
GET ACTIONS,A
|
|
CALL D-APPLY,FALSE-VALUE,STACK >V
|
|
?CND40: SET 'PRSA,OA
|
|
SET 'PRSO,OO
|
|
SET 'PRSI,OI
|
|
RETURN V
|
|
?CCL9: ZERO? I \?CCL15
|
|
ICALL2 FAKE-ORPHAN,TRUE-VALUE
|
|
RETURN 2
|
|
?CCL15: ICALL1 REFERRING
|
|
RETURN 2
|
|
|
|
|
|
.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 META-LOC,OBJ
|
|
?PRG1: ZERO? OBJ /FALSE
|
|
IN? OBJ,GLOBAL-OBJECTS \?CND3
|
|
RETURN GLOBAL-OBJECTS
|
|
?CND3: IN? OBJ,ROOMS \?CCL9
|
|
RETURN OBJ
|
|
?CCL9: LOC OBJ >OBJ
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT QUEUE,RTN,TICK,CINT
|
|
CALL2 INT,RTN >CINT
|
|
PUT CINT,C-TICK,TICK
|
|
RETURN CINT
|
|
|
|
|
|
.FUNCT INT,RTN,DEMON,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
|
|
ZERO? DEMON /?PEN6
|
|
SUB C-DEMONS,C-INTLEN >C-DEMONS
|
|
?PEN6: 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? P-WON /?CCL3
|
|
PUSH C-INTS
|
|
JUMP ?CND1
|
|
?CCL3: PUSH C-DEMONS
|
|
?CND1: ADD C-TABLE,STACK >C
|
|
ADD C-TABLE,C-TABLELEN >E
|
|
?PRG4: EQUAL? C,E \?CCL8
|
|
RETURN FLG
|
|
?CCL8: GET C,C-ENABLED?
|
|
ZERO? STACK /?CND6
|
|
GET C,C-TICK >TICK
|
|
ZERO? TICK /?CND6
|
|
EQUAL? TICK,-1 \?CCL13
|
|
GET C,C-RTN
|
|
CALL STACK
|
|
ZERO? STACK /?CND6
|
|
SET 'FLG,TRUE-VALUE
|
|
JUMP ?CND6
|
|
?CCL13: SUB TICK,C-ELAPSED >TICK
|
|
PUT C,C-TICK,TICK
|
|
GRTR? TICK,1 /?CND6
|
|
PUT C,C-TICK,0
|
|
GET C,C-RTN
|
|
CALL STACK
|
|
ZERO? STACK /?CND6
|
|
SET 'FLG,TRUE-VALUE
|
|
?CND6: ADD C,C-INTLEN >C
|
|
JUMP ?PRG4
|
|
|
|
|
|
.FUNCT REFERRING,HIM-HER
|
|
PRINTI "I don't see wh"
|
|
ZERO? HIM-HER /?CCL3
|
|
PRINTC 111
|
|
JUMP ?CND1
|
|
?CCL3: PRINTI "at"
|
|
?CND1: PRINTR " you're referring to."
|
|
|
|
.ENDI
|