seastalker/main.zap

	.FUNCT	GO
START::

?FCN:	SET	'LIT,TRUE-VALUE
	PUTB	P-LEXV,0,59
	PUTB	YES-LEXV,0,4
	SET	'SCORE,0
	SET	'HERE,GAME
	PUTB	FIRST-NAME,0,3
	PUTB	FIRST-NAME,1,45
	PUTB	FIRST-NAME,2,45
	PUTB	FIRST-NAME,3,45
	PUTB	LAST-NAME,0,3
	PUTB	LAST-NAME,1,45
	PUTB	LAST-NAME,2,45
	PUTB	LAST-NAME,3,45
	SET	'WINNER,PLAYER
	CALL	THIS-IS-IT,VIDEOPHONE
	CALL	THIS-IS-IT,TIP
	CALL	THIS-IS-IT,SHARON
	FSET?	CENTER-OF-LAB,TOUCHBIT /?CND1
	CALL	INTRO
	CALL	QUEUE-MAIN-EVENTS
?CND1:	SET	'HERE,CENTER-OF-LAB
	MOVE	TIP,HERE
	MOVE	PLAYER,HERE
	CALL	MAIN-LOOP
	JUMP	?FCN


	.FUNCT	INTRO,N
	PRINTI	"Copyright (c) 1984, 1985 Infocom, Inc. All rights reserved.

Welcome to interactive fiction from Infocom!

In this story, you're the hero or heroine, so we'll use your name!"
	CRLF	
?PRG3:	CRLF	
	CALL	READ-NAME,FIRST-NAME,STR?5 >N
	EQUAL?	N,M-FATAL /FALSE
	PRINTI	"Hello "
	CALL	PRINT-NAME,FIRST-NAME
	PRINTI	"! "
	CALL	READ-NAME,LAST-NAME,STR?6 >N
	EQUAL?	N,M-FATAL /FALSE
	PRINTI	"Is "
	CALL	PRINT-NAME,FIRST-NAME
	PRINTI	" "
	CALL	PRINT-NAME,LAST-NAME
	PRINTI	" right?"
	CALL	YES?
	ZERO?	STACK /?PRG3
	PRINTI	"Then let the story begin!"
	SET	'N,24
?PRG22:	DLESS?	'N,0 \?ELS26
	JUMP	?REP23
?ELS26:	CRLF	
	JUMP	?PRG22
?REP23:	CALL	V-VERSION
	CRLF	
	PRINTI	""""
	CALL	PRINT-NAME,FIRST-NAME
	PRINTI	", snap out of it!"" cries "
	PRINTD	GLOBAL-TIP
	PRINTI	", bursting into "
	PRINTD	YOUR-LABORATORY
	PRINTI	". ""The alert signal is on!""
You look up from your plans for the "
	PRINTD	SUB
	PRINTI	", a top-secret submarine that's still being tested. It's designed for capturing marine life on the ocean floor. You notice the "
	PRINTD	ALARM
	PRINTI	" on the "
	PRINTD	VIDEOPHONE
	PRINTI	" ringing. Someone's trying to reach you over the private "
	PRINTD	VIDEOPHONE
	PRINTI	" network of "
	PRINTD	IU-GLOBAL
	PRINTR	"!
"


	.FUNCT	QUEUE-MAIN-EVENTS
	SET	'ALARM-RINGING,TRUE-VALUE
	CALL	QUEUE,I-ALARM-RINGING,-1
	PUT	STACK,0,1
	CALL	QUEUE,I-SHOW-SONAR,0
	CALL	QUEUE,I-UPDATE-FREIGHTER,0
	CALL	QUEUE,I-UPDATE-SUB-POSITION,0
	SET	'OLD-HERE,CENTER-OF-LAB
	SET	'TIP-FOLLOWS-YOU?,TRUE-VALUE
	RANDOM	250
	ADD	250,STACK
	CALL	QUEUE,I-SNARK-ATTACKS,STACK
	PUT	STACK,0,1
	CALL	QUEUE,I-LAMP-ON-SCOPE,5
	PUT	STACK,0,1
	CALL	QUEUE,I-PROMPT-1,1
	PUT	STACK,0,1
	CALL	QUEUE,I-PROMPT-2,10
	PUT	STACK,0,1
	CALL	QUEUE,I-SHARON-GONE,25
	PUT	STACK,0,1
	RTRUE	


	.FUNCT	MAIN-LOOP,TRASH
?PRG1:	CALL	MAIN-LOOP-1 >TRASH
	JUMP	?PRG1


	.FUNCT	MAIN-LOOP-1,ICNT,OCNT,NUM,CNT,OBJ,TBL,V,PTBL,OBJ1,TMP,?TMP1
	SET	'CNT,0
	SET	'OBJ,FALSE-VALUE
	SET	'PTBL,TRUE-VALUE
	EQUAL?	QCONTEXT-ROOM,HERE /?CND1
	SET	'QCONTEXT,FALSE-VALUE
?CND1:	CALL	PARSER >P-WON
	ZERO?	P-WON /?ELS6
	GET	P-PRSI,P-MATCHLEN >ICNT
	GET	P-PRSO,P-MATCHLEN >OCNT
	ZERO?	OCNT \?ELS11
	PUSH	OCNT
	JUMP	?CND7
?ELS11:	GRTR?	OCNT,1 \?ELS13
	SET	'TBL,P-PRSO
	ZERO?	ICNT \?ELS16
	SET	'OBJ,FALSE-VALUE
	JUMP	?CND14
?ELS16:	GET	P-PRSI,1 >OBJ
?CND14:	PUSH	OCNT
	JUMP	?CND7
?ELS13:	GRTR?	ICNT,1 \?ELS20
	SET	'PTBL,FALSE-VALUE
	SET	'TBL,P-PRSI
	GET	P-PRSO,1 >OBJ
	PUSH	ICNT
	JUMP	?CND7
?ELS20:	PUSH	1
?CND7:	SET	'NUM,STACK
	ZERO?	OBJ \?CND23
	EQUAL?	ICNT,1 \?CND23
	GET	P-PRSI,1 >OBJ
?CND23:	EQUAL?	PRSA,V?WALK \?ELS30
	CALL	PERFORM,PRSA,PRSO >V
	JUMP	?CND28
?ELS30:	ZERO?	NUM \?ELS32
	GETB	P-SYNTAX,P-SBITS
	BAND	STACK,P-SONUMS
	ZERO?	STACK \?ELS35
	CALL	PERFORM,PRSA >V
	SET	'PRSO,FALSE-VALUE
	JUMP	?CND28
?ELS35:	PRINTI	"(There isn't anything to "
	GET	P-ITBL,P-VERBN >TMP
	ZERO?	P-OFLAG /?ELS42
	GET	TMP,0
	PRINTB	STACK
	JUMP	?CND40
?ELS42:	GETB	TMP,2 >?TMP1
	GETB	TMP,3
	CALL	WORD-PRINT,?TMP1,STACK
?CND40:	PRINTI	"!)"
	CRLF	
	SET	'V,FALSE-VALUE
	JUMP	?CND28
?ELS32:	ZERO?	PTBL /?ELS49
	GRTR?	NUM,1 \?ELS49
	EQUAL?	PRSA,V?COMPARE \?ELS49
	CALL	PERFORM,PRSA,OBJECT-PAIR >V
	JUMP	?CND28
?ELS49:	SET	'TMP,0
?PRG54:	IGRTR?	'CNT,NUM \?ELS58
	GRTR?	TMP,0 \?REP55
	PRINTI	"The other thing"
	EQUAL?	TMP,1 /?CND64
	PRINTI	"s"
?CND64:	PRINTI	" that you mentioned "
	EQUAL?	TMP,1 /?ELS73
	PRINTI	"are"
	JUMP	?CND71
?ELS73:	PRINTI	"is"
?CND71:	PRINTI	"n't here."
	CRLF	
	JUMP	?REP55
?ELS58:	ZERO?	PTBL /?ELS86
	GET	P-PRSO,CNT >OBJ1
	JUMP	?CND84
?ELS86:	GET	P-PRSI,CNT >OBJ1
?CND84:	GRTR?	NUM,1 \?CND90
	EQUAL?	OBJ1,NOT-HERE-OBJECT \?ELS95
	INC	'TMP
	JUMP	?PRG54
?ELS95:	EQUAL?	OBJ1,PLAYER \?ELS97
	JUMP	?PRG54
?ELS97:	EQUAL?	OBJ1,IT \?ELS102
	PRINTD	P-IT-OBJECT
	JUMP	?CND100
?ELS102:	PRINTD	OBJ1
?CND100:	PRINTI	": "
?CND90:	ZERO?	PTBL /?ELS111
	PUSH	OBJ1
	JUMP	?CND107
?ELS111:	PUSH	OBJ
?CND107:	CALL	QCONTEXT-CHECK,STACK >V
	ZERO?	PTBL /?ELS119
	PUSH	OBJ1
	JUMP	?CND115
?ELS119:	PUSH	OBJ
?CND115:	SET	'?TMP1,STACK
	ZERO?	PTBL /?ELS127
	PUSH	OBJ
	JUMP	?CND123
?ELS127:	PUSH	OBJ1
?CND123:	CALL	PERFORM,PRSA,?TMP1,STACK >V
	EQUAL?	V,M-FATAL \?PRG54
	JUMP	?CND28
?REP55:	
?CND28:	EQUAL?	V,M-FATAL \?CND4
	SET	'P-CONT,FALSE-VALUE
	JUMP	?CND4
?ELS6:	SET	'P-CONT,FALSE-VALUE
?CND4:	ZERO?	P-WON /FALSE
	CALL	GAME-VERB?
	ZERO?	STACK \FALSE
	CALL	CLOCKER >V
	RETURN	V


	.FUNCT	QCONTEXT-CHECK,PRSO,OTHER,WHO=0,N=0
	EQUAL?	PRSA,V?WHAT,V?HELP /?THN6
	EQUAL?	PRSA,V?TELL-ABOUT,V?SHOW \FALSE
	EQUAL?	PRSO,PLAYER \FALSE
?THN6:	FIRST?	HERE >OTHER /?KLU33
?KLU33:	
?PRG10:	ZERO?	OTHER \?ELS14
	JUMP	?REP11
?ELS14:	FSET?	OTHER,PERSON \?CND12
	FSET?	OTHER,INVISIBLE /?CND12
	EQUAL?	OTHER,PLAYER /?CND12
	INC	'N
	SET	'WHO,OTHER
?CND12:	NEXT?	OTHER >OTHER /?KLU34
?KLU34:	JUMP	?PRG10
?REP11:	EQUAL?	1,N \?CND19
	ZERO?	QCONTEXT \?CND19
	CALL	SAID-TO,WHO
?CND19:	CALL	QCONTEXT-GOOD?
	ZERO?	STACK /FALSE
	EQUAL?	WINNER,PLAYER \FALSE
	SET	'WINNER,QCONTEXT
	PRINTI	"(said to "
	PRINTD	QCONTEXT
	PRINTR	")"


	.FUNCT	QCONTEXT-GOOD?
	ZERO?	QCONTEXT /FALSE
	FSET?	QCONTEXT,INVISIBLE /FALSE
	EQUAL?	HERE,QCONTEXT-ROOM \FALSE
	CALL	META-LOC,QCONTEXT
	EQUAL?	HERE,STACK /TRUE
	RFALSE


	.FUNCT	SAID-TO,WHO
	SET	'QCONTEXT,WHO
	SET	'QCONTEXT-ROOM,HERE
	RETURN	QCONTEXT-ROOM


	.FUNCT	OBJECT-PAIR-F,P1,P2,?TMP1
	GET	P-PRSO,P-MATCHLEN
	LESS?	2,STACK \?ELS5
	EQUAL?	PRSA,V?COMPARE \TRUE
	PRINTR	"That's too many things to compare all at once!"
?ELS5:	EQUAL?	PRSA,V?COMPARE \FALSE
	GET	P-PRSO,1 >?TMP1
	GET	P-PRSO,2
	CALL	PERFORM,PRSA,?TMP1,STACK
	RTRUE	


	.FUNCT	THIS-IS-IT,OBJ
	ZERO?	OBJ /TRUE
	EQUAL?	PRSA,V?WALK \?CND4
	EQUAL?	OBJ,PRSO /TRUE
?CND4:	FSET?	OBJ,PERSON /?ELS11
	EQUAL?	OBJ,GLOBAL-HERE,INTDIR /TRUE
	SET	'P-IT-OBJECT,OBJ
	RTRUE	
?ELS11:	FSET?	OBJ,FEMALE \?ELS16
	SET	'P-HER-OBJECT,OBJ
	RTRUE	
?ELS16:	SET	'P-HIM-OBJECT,OBJ
	RTRUE	


	.FUNCT	FAKE-ORPHAN,TMP,?TMP1
	CALL	ORPHAN,P-SYNTAX,FALSE-VALUE
	PRINTI	"(Be specific: what thing do you want to "
	GET	P-OTBL,P-VERBN >TMP
	ZERO?	TMP \?ELS5
	PRINTI	"tell"
	JUMP	?CND3
?ELS5:	GETB	P-VTBL,2
	ZERO?	STACK \?ELS9
	GET	TMP,0
	PRINTB	STACK
	JUMP	?CND3
?ELS9:	GETB	TMP,2 >?TMP1
	GETB	TMP,3
	CALL	WORD-PRINT,?TMP1,STACK
	PUTB	P-VTBL,2,0
?CND3:	SET	'P-OFLAG,TRUE-VALUE
	SET	'P-WON,FALSE-VALUE
	PRINTR	"?)"


	.FUNCT	TELL-D-LOC,OBJ
	PRINTD	OBJ
	IN?	OBJ,GLOBAL-OBJECTS \?ELS7
	PRINTI	"(gl)"
	RTRUE	
?ELS7:	IN?	OBJ,LOCAL-GLOBALS \?ELS11
	PRINTI	"(lg)"
	RTRUE	
?ELS11:	IN?	OBJ,ROOMS \FALSE
	PRINTI	"(rm)"
	RTRUE	


	.FUNCT	FIX-HIM-HER,HEM-OBJECT,V
	GETP	HEM-OBJECT,P?CHARACTER >V
	CALL	ACCESSIBLE?,HEM-OBJECT
	ZERO?	STACK \?CND1
	GET	GLOBAL-CHARACTER-TABLE,V
	RSTACK	
?CND1:	GET	CHARACTER-TABLE,V >V
	LOC	V
	EQUAL?	HERE,STACK \FALSE
	RETURN	V


	.FUNCT	PERFORM,A,O=0,I=0,V,OA,OO,OI
	ZERO?	DEBUG /?CND1
	PRINTI	"[Perform: "
	PRINTN	A
	ZERO?	O /?CND9
	PRINTI	"/"
	EQUAL?	A,V?WALK \?ELS17
	PRINTN	O
	JUMP	?CND9
?ELS17:	CALL	TELL-D-LOC,O
?CND9:	ZERO?	I /?CND22
	PRINTI	"/"
	CALL	TELL-D-LOC,I
?CND22:	PRINTI	"]"
	CRLF	
?CND1:	SET	'OA,PRSA
	SET	'OO,PRSO
	SET	'OI,PRSI
	SET	'PRSA,A
	EQUAL?	A,V?WALK /?CND30
	EQUAL?	IT,I,O \?CND33
	CALL	ACCESSIBLE?,P-IT-OBJECT
	ZERO?	STACK \?CND33
	ZERO?	I \?ELS40
	CALL	FAKE-ORPHAN
	RETURN	2
?ELS40:	PRINTI	"(Sorry, but"
	CALL	PRINTT,P-IT-OBJECT
	PRINTI	" isn't here!)"
	CRLF	
	RETURN	2
?CND33:	EQUAL?	HER,I,O \?CND47
	CALL	FIX-HIM-HER,P-HER-OBJECT >V
	ZERO?	V /?CND47
	EQUAL?	HER,O \?CND53
	SET	'O,V
?CND53:	EQUAL?	HER,I \?CND50
	SET	'I,V
?CND50:	
?CND47:	EQUAL?	HIM,I,O \?CND59
	CALL	FIX-HIM-HER,P-HIM-OBJECT >V
	ZERO?	V /?CND59
	EQUAL?	HIM,O \?CND65
	SET	'O,V
?CND65:	EQUAL?	HIM,I \?CND62
	SET	'I,V
?CND62:	
?CND59:	EQUAL?	O,IT \?ELS73
	SET	'O,P-IT-OBJECT
	JUMP	?CND71
?ELS73:	EQUAL?	O,HER \?ELS75
	SET	'O,P-HER-OBJECT
	JUMP	?CND71
?ELS75:	EQUAL?	O,HIM \?CND71
	SET	'O,P-HIM-OBJECT
?CND71:	EQUAL?	I,IT \?ELS80
	SET	'I,P-IT-OBJECT
	JUMP	?CND30
?ELS80:	EQUAL?	I,HER \?ELS82
	SET	'I,P-HER-OBJECT
	JUMP	?CND30
?ELS82:	EQUAL?	I,HIM \?CND30
	SET	'I,P-HIM-OBJECT
?CND30:	SET	'PRSI,I
	SET	'PRSO,O
	SET	'V,FALSE-VALUE
	EQUAL?	A,V?WALK /?CND85
	EQUAL?	NOT-HERE-OBJECT,PRSO,PRSI \?CND85
	CALL	D-APPLY,STR?7,NOT-HERE-OBJECT-F >V
	ZERO?	V /?CND85
	SET	'P-WON,FALSE-VALUE
?CND85:	CALL	THIS-IS-IT,PRSI
	CALL	THIS-IS-IT,PRSO
	SET	'O,PRSO
	SET	'I,PRSI
	ZERO?	V \?CND94
	GETP	WINNER,P?ACTION
	CALL	DD-APPLY,STR?8,WINNER,STACK >V
?CND94:	ZERO?	V \?CND97
	LOC	WINNER
	GETP	STACK,P?ACTION
	CALL	D-APPLY,STR?9,STACK,M-BEG >V
?CND97:	ZERO?	V \?CND100
	GET	PREACTIONS,A
	CALL	D-APPLY,STR?10,STACK >V
?CND100:	SET	'NOW-PRSI,TRUE-VALUE
	ZERO?	V \?CND103
	ZERO?	I /?CND103
	GETP	I,P?ACTION
	CALL	D-APPLY,STR?11,STACK >V
?CND103:	SET	'NOW-PRSI,FALSE-VALUE
	ZERO?	V \?CND108
	ZERO?	O /?CND108
	EQUAL?	A,V?WALK /?CND108
	LOC	O
	ZERO?	STACK /?CND108
	LOC	O
	GETP	STACK,P?CONTFCN >V
	ZERO?	V /?CND108
	LOC	O
	CALL	DD-APPLY,STR?12,STACK,V >V
?CND108:	ZERO?	V \?CND117
	ZERO?	O /?CND117
	EQUAL?	A,V?WALK /?CND117
	GETP	O,P?ACTION
	CALL	D-APPLY,STR?13,STACK >V
?CND117:	ZERO?	V \?CND122
	GET	ACTIONS,A
	CALL	D-APPLY,FALSE-VALUE,STACK >V
?CND122:	EQUAL?	V,M-FATAL /?CND125
	CALL	GAME-VERB?
	ZERO?	STACK \?CND125
	LOC	WINNER
	GETP	STACK,P?ACTION
	CALL	D-APPLY,STR?14,STACK,M-END >V
?CND125:	SET	'PRSA,OA
	SET	'PRSO,OO
	SET	'PRSI,OI
	RETURN	V


	.FUNCT	DD-APPLY,STR,OBJ,FCN
	ZERO?	DEBUG /?CND1
	PRINTI	"["
	PRINTD	OBJ
	PRINTI	"=]"
?CND1:	CALL	D-APPLY,STR,FCN
	RSTACK	


	.FUNCT	D-APPLY,STR,FCN,FOO=0,RES
	ZERO?	FCN /FALSE
	ZERO?	DEBUG /?CND8
	ZERO?	STR \?ELS14
	PRINTI	"[Action:]"
	CRLF	
	JUMP	?CND8
?ELS14:	PRINTI	"["
	PRINT	STR
	PRINTI	": "
?CND8:	ZERO?	FOO /?ELS25
	CALL	FCN,FOO
	JUMP	?CND21
?ELS25:	CALL	FCN
?CND21:	SET	'RES,STACK
	ZERO?	DEBUG /?CND29
	ZERO?	STR /?CND29
	EQUAL?	RES,M-FATAL \?ELS36
	PRINTI	"Fatal]"
	CRLF	
	RETURN	RES
?ELS36:	ZERO?	RES \?ELS40
	PRINTI	"Not handled]"
	CRLF	
	RETURN	RES
?ELS40:	PRINTI	"Handled]"
	CRLF	
?CND29:	RETURN	RES

	.ENDI