planetfall-gold/misc.zap

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