planetfall/misc.zap

	.FUNCT	PICK-ONE,FROB
	GET	FROB,0
	RANDOM	STACK
	GET	FROB,STACK
	RSTACK	


	.FUNCT	GO
START::

?FCN:	PUTB	P-LEXV,0,59
	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
	SET	'HERE,DECK-NINE
	SET	'P-IT-LOC,DECK-NINE
	SET	'P-IT-OBJECT,POD-DOOR
	FSET?	HERE,TOUCHBIT /?CND4
	CALL	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:	CALL	V-LOOK
	CALL	MAIN-LOOP
	JUMP	?FCN


	.FUNCT	I-RANDOM-INTERRUPTS
	RANDOM	90
	ADD	STACK,240
	CALL	QUEUE,I-BLOWUP-FEINSTEIN,STACK
	PUT	STACK,0,1
	CALL	COMM-SETUP
	RANDOM	1000 >NUMBER-NEEDED
	RETURN	NUMBER-NEEDED


	.FUNCT	MAIN-LOOP,ICNT,OCNT,NUM,CNT,OBJ,TBL,V,PTBL,OBJ1,TMP,?TMP1
?PRG1:	SET	'C-ELAPSED,C-ELAPSED-DEFAULT
	SET	'CNT,0
	SET	'OBJ,FALSE-VALUE
	SET	'PTBL,TRUE-VALUE
	CALL	PARSER >P-WON
	ZERO?	P-WON /?CCL5
	GET	P-PRSI,P-MATCHLEN >ICNT
	GET	P-PRSO,P-MATCHLEN >OCNT
	ZERO?	P-IT-OBJECT /?CND6
	CALL	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
	CALL	PERFORM,PRSA,PRSO >V
	JUMP	?CND40
?CCL42:	ZERO?	NUM \?CCL44
	GETB	P-SYNTAX,P-SBITS
	BAND	STACK,P-SONUMS
	ZERO?	STACK \?CCL47
	CALL	PERFORM,PRSA >V
	SET	'PRSO,FALSE-VALUE
	JUMP	?CND40
?CCL47:	PRINTI	"There isn't anything to "
	GET	P-ITBL,P-VERBN >TMP
	ZERO?	P-OFLAG \?CTR49
	ZERO?	P-MERGED /?CCL50
?CTR49:	GET	TMP,0
	PRINTB	STACK
	JUMP	?CND48
?CCL50:	GETB	TMP,2 >?TMP1
	GETB	TMP,3
	CALL	WORD-PRINT,?TMP1,STACK
?CND48:	PRINTC	33
	CRLF	
	SET	'V,FALSE-VALUE
	JUMP	?CND40
?CCL44:	SET	'TMP,0
	SET	'ICNT,FALSE-VALUE
?PRG53:	IGRTR?	'CNT,NUM \?CCL57
	GRTR?	TMP,0 \?CCL60
	PRINTI	"The "
	EQUAL?	TMP,NUM /?CND61
	PRINTI	"other "
?CND61:	PRINTI	"object"
	EQUAL?	TMP,1 /?CND63
	PRINTC	115
?CND63:	PRINTI	" that you mentioned "
	EQUAL?	TMP,1 /?CCL67
	PRINTI	"are"
	JUMP	?CND65
?CCL67:	PRINTI	"is"
?CND65:	PRINTI	"n't here."
	CRLF	
	JUMP	?CND40
?CCL60:	ZERO?	ICNT \?CND40
	PRINTI	"There's nothing there."
	CRLF	
	JUMP	?CND40
?CCL57:	ZERO?	PTBL /?CCL71
	GET	P-PRSO,CNT >OBJ1
	JUMP	?CND69
?CCL71:	GET	P-PRSI,CNT >OBJ1
?CND69:	ZERO?	PTBL /?CCL74
	SET	'PRSO,OBJ1
	JUMP	?CND72
?CCL74:	SET	'PRSO,OBJ
?CND72:	ZERO?	PTBL /?CCL77
	SET	'PRSI,OBJ
	JUMP	?CND75
?CCL77:	SET	'PRSI,OBJ1
?CND75:	GRTR?	NUM,1 /?CCL79
	GET	P-ITBL,P-NC1
	GET	STACK,0
	EQUAL?	STACK,W?ALL \?CND78
?CCL79:	EQUAL?	OBJ1,NOT-HERE-OBJECT \?CCL84
	INC	'TMP
	JUMP	?PRG53
?CCL84:	EQUAL?	PRSA,V?TAKE \?CCL86
	ZERO?	PRSI /?CCL86
	GET	P-ITBL,P-NC1
	GET	STACK,0
	EQUAL?	STACK,W?ALL \?CCL86
	IN?	PRSO,PRSI \?PRG53
?CCL86:	EQUAL?	P-GETFLAGS,P-ALL \?CCL92
	EQUAL?	PRSA,V?TAKE \?CCL92
	LOC	OBJ1
	EQUAL?	STACK,WINNER,HERE \?PRG53
?CCL92:	EQUAL?	OBJ1,IT \?CCL98
	PRINTD	P-IT-OBJECT
	JUMP	?CND96
?CCL98:	PRINTD	OBJ1
?CND96:	PRINTI	": "
?CND78:	SET	'ICNT,TRUE-VALUE
	CALL	PERFORM,PRSA,PRSO,PRSI >V
	EQUAL?	V,M-FATAL \?PRG53
?CND40:	EQUAL?	V,M-FATAL /?CND101
	LOC	WINNER
	GETP	STACK,P?ACTION
	CALL	STACK,M-END >V
?CND101:	EQUAL?	PRSA,V?AGAIN /?CND103
	SET	'L-PRSA,PRSA
	SET	'L-PRSO,PRSO
	SET	'L-PRSI,PRSI
?CND103:	CALL	INT,I-POD-TRIP
	GET	STACK,C-ENABLED?
	ZERO?	STACK /?CCL107
	SET	'C-ELAPSED,54
	JUMP	?CND105
?CCL107:	GRTR?	SHUTTLE-VELOCITY,0 \?CCL109
	DIV	600,SHUTTLE-VELOCITY >C-ELAPSED
	JUMP	?CND105
?CCL109:	EQUAL?	PRSA,V?TELL /?CTR110
	CALL	TIMELESS-VERB?,PRSA
	ZERO?	STACK /?CCL111
?CTR110:	SET	'C-ELAPSED,0
	JUMP	?CND105
?CCL111:	EQUAL?	PRSA,V?AGAIN \?CND105
	CALL	TIMELESS-VERB?,L-PRSA
	ZERO?	STACK /?CND105
	SET	'C-ELAPSED,0
?CND105:	ADD	INTERNAL-MOVES,C-ELAPSED >INTERNAL-MOVES
	EQUAL?	V,M-FATAL \?CND3
	SET	'P-CONT,FALSE-VALUE
	JUMP	?CND3
?CCL5:	SET	'P-CONT,FALSE-VALUE
?CND3:	IN?	CHRONOMETER,ADVENTURER /?CCL121
	SET	'MOVES,0
	JUMP	?CND119
?CCL121:	FSET?	CHRONOMETER,MUNGEDBIT \?CCL123
	SET	'MOVES,MUNGED-TIME
	JUMP	?CND119
?CCL123:	SET	'MOVES,INTERNAL-MOVES
?CND119:	ZERO?	P-WON /?PRG1
	ZERO?	C-ELAPSED /?PRG1
	CALL	CLOCKER >V
	JUMP	?PRG1


	.FUNCT	TIMELESS-VERB?,VRB
	EQUAL?	VRB,V?BRIEF,V?SUPER-BRIEF,V?VERBOSE /TRUE
	EQUAL?	VRB,V?SAVE,V?RESTORE,V?SCORE /TRUE
	EQUAL?	VRB,V?SCRIPT,V?UNSCRIPT,V?TIME /TRUE
	EQUAL?	VRB,V?QUIT,V?RESTART,V?VERSION /TRUE
	EQUAL?	VRB,V?$RANDOM,V?$RECORD,V?$UNRECORD /TRUE
	EQUAL?	VRB,V?$COMMAND /TRUE
	RFALSE	


	.FUNCT	PERFORM,A,O=0,I=0,V,OA,OO,OI
	SET	'OA,PRSA
	SET	'OO,PRSO
	SET	'OI,PRSI
	EQUAL?	IT,I,O \?CND1
	PRINTI	"I don't see what you are referring to."
	CRLF	
	SET	'P-IT-OBJECT,FALSE-VALUE
	RETURN	2
?CND1:	SET	'PRSA,A
	SET	'PRSO,O
	ZERO?	PRSO /?CND5
	EQUAL?	PRSA,V?WALK /?CND5
	SET	'P-IT-OBJECT,PRSO
	SET	'P-IT-LOC,HERE
?CND5:	SET	'PRSI,I
	EQUAL?	NOT-HERE-OBJECT,PRSO,PRSI \?CCL11
	CALL	NOT-HERE-OBJECT-F >V
	ZERO?	V /?CCL11
	SET	'P-WON,FALSE-VALUE
	JUMP	?CND9
?CCL11:	SET	'O,PRSO
	ZERO?	O /?CCL15
	SET	'I,PRSI
	ZERO?	I /?CCL15
	CALL	NULL-F
	ZERO?	STACK /?CCL15
	PRINTI	"[in case last clause changed PRSx]"
	JUMP	?CND9
?CCL15:	GETP	WINNER,P?ACTION
	CALL	STACK >V
	ZERO?	V \?CND9
	LOC	WINNER
	GETP	STACK,P?ACTION
	CALL	STACK,M-BEG >V
	ZERO?	V \?CND9
	GET	PREACTIONS,A
	CALL	STACK >V
	ZERO?	V \?CND9
	ZERO?	I /?CCL26
	GETP	I,P?ACTION
	CALL	STACK >V
	ZERO?	V \?CND9
?CCL26:	ZERO?	O /?CCL30
	EQUAL?	A,V?WALK /?CCL30
	GETP	O,P?ACTION
	CALL	STACK >V
	ZERO?	V \?CND9
?CCL30:	GET	ACTIONS,A
	CALL	STACK >V
	ZERO?	V /?CND9
?CND9:	SET	'PRSA,OA
	SET	'PRSO,OO
	SET	'PRSI,OI
	RETURN	V


	.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
	CALL	INT,RTN >CINT
	PUT	CINT,C-TICK,TICK
	RETURN	CINT


	.FUNCT	INT,RTN,DEMON=0,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=0
	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	NULL-F,A1,A2
	RFALSE	

	.ENDI