seastalker/main.zap

	.FUNCT	GO
START::

?FCN:	SET	'LIT,1
	PUTB	P-LEXV,0,59
	PUTB	YES-LEXV,0,4
	SET	'SCORE,0
	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
	SET	'HERE,CENTER-OF-LAB
	CALL	THIS-IS-IT,VIDEOPHONE
	MOVE	TIP,HERE
	CALL	THIS-IS-IT,TIP
	CALL	THIS-IS-IT,SHARON
	FSET?	HERE,TOUCHBIT /?CND1
	CALL	QUEUE-MAIN-EVENTS
	CALL	INTRO
?CND1:	MOVE	PLAYER,HERE
	ZERO?	RESTORED-DURING-NAME-INPUT \?CND4
	CALL	V-LOOK
?CND4:	CALL	MAIN-LOOP
	JUMP	?FCN


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

Welcome to junior-level 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,1
	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,HERE
	SET	'TIP-FOLLOWS-YOU?,1
	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,ICNT,OCNT,NUM,CNT,OBJ,TBL,V,PTBL,OBJ1,TMP,?TMP1
?PRG1:	SET	'CNT,0
	SET	'OBJ,0
	SET	'PTBL,1
	EQUAL?	QCONTEXT-ROOM,HERE /?CND3
	SET	'QCONTEXT,0
?CND3:	CALL	PARSER >P-WON
	ZERO?	P-WON /?ELS8
	GET	P-PRSI,P-MATCHLEN >ICNT
	GET	P-PRSO,P-MATCHLEN >OCNT
	ZERO?	OCNT \?ELS13
	PUSH	OCNT
	JUMP	?CND9
?ELS13:	GRTR?	OCNT,1 \?ELS15
	SET	'TBL,P-PRSO
	ZERO?	ICNT \?ELS18
	SET	'OBJ,0
	JUMP	?CND16
?ELS18:	GET	P-PRSI,1 >OBJ
?CND16:	PUSH	OCNT
	JUMP	?CND9
?ELS15:	GRTR?	ICNT,1 \?ELS22
	SET	'PTBL,0
	SET	'TBL,P-PRSI
	GET	P-PRSO,1 >OBJ
	PUSH	ICNT
	JUMP	?CND9
?ELS22:	PUSH	1
?CND9:	SET	'NUM,STACK
	ZERO?	OBJ \?CND25
	EQUAL?	ICNT,1 \?CND25
	GET	P-PRSI,1 >OBJ
?CND25:	EQUAL?	PRSA,V?WALK \?ELS32
	CALL	PERFORM,PRSA,PRSO >V
	JUMP	?CND30
?ELS32:	ZERO?	NUM \?ELS34
	GETB	P-SYNTAX,P-SBITS
	BAND	STACK,P-SONUMS
	ZERO?	STACK \?ELS37
	CALL	PERFORM,PRSA >V
	SET	'PRSO,0
	JUMP	?CND30
?ELS37:	PRINTI	"(There isn't anything to "
	GET	P-ITBL,P-VERBN >TMP
	ZERO?	P-OFLAG /?ELS44
	GET	TMP,0
	PRINTB	STACK
	JUMP	?CND42
?ELS44:	GETB	TMP,2 >?TMP1
	GETB	TMP,3
	CALL	WORD-PRINT,?TMP1,STACK
?CND42:	PRINTI	"!)"
	CRLF	
	SET	'V,0
	JUMP	?CND30
?ELS34:	ZERO?	PTBL /?ELS51
	GRTR?	NUM,1 \?ELS51
	EQUAL?	PRSA,V?COMPARE \?ELS51
	CALL	PERFORM,PRSA,OBJECT-PAIR >V
	JUMP	?CND30
?ELS51:	SET	'TMP,0
?PRG56:	IGRTR?	'CNT,NUM \?ELS60
	GRTR?	TMP,0 \?REP57
	PRINTI	"The other thing"
	EQUAL?	TMP,1 /?CND66
	PRINTI	"s"
?CND66:	PRINTI	" that you mentioned "
	EQUAL?	TMP,1 /?ELS75
	PRINTI	"are"
	JUMP	?CND73
?ELS75:	PRINTI	"is"
?CND73:	PRINTI	"n't here."
	CRLF	
	JUMP	?REP57
?ELS60:	ZERO?	PTBL /?ELS88
	GET	P-PRSO,CNT >OBJ1
	JUMP	?CND86
?ELS88:	GET	P-PRSI,CNT >OBJ1
?CND86:	GRTR?	NUM,1 \?CND92
	EQUAL?	OBJ1,NOT-HERE-OBJECT \?ELS97
	INC	'TMP
	JUMP	?PRG56
?ELS97:	EQUAL?	OBJ1,PLAYER \?ELS99
	JUMP	?PRG56
?ELS99:	EQUAL?	OBJ1,IT \?ELS104
	PRINTD	P-IT-OBJECT
	JUMP	?CND102
?ELS104:	PRINTD	OBJ1
?CND102:	PRINTI	": "
?CND92:	ZERO?	PTBL /?ELS113
	PUSH	OBJ1
	JUMP	?CND109
?ELS113:	PUSH	OBJ
?CND109:	CALL	QCONTEXT-CHECK,STACK >V
	ZERO?	PTBL /?ELS121
	PUSH	OBJ1
	JUMP	?CND117
?ELS121:	PUSH	OBJ
?CND117:	SET	'?TMP1,STACK
	ZERO?	PTBL /?ELS129
	PUSH	OBJ
	JUMP	?CND125
?ELS129:	PUSH	OBJ1
?CND125:	CALL	PERFORM,PRSA,?TMP1,STACK >V
	EQUAL?	V,M-FATAL \?PRG56
	JUMP	?CND30
?REP57:	
?CND30:	EQUAL?	V,M-FATAL \?CND6
	SET	'P-CONT,0
	JUMP	?CND6
?ELS8:	SET	'P-CONT,0
?CND6:	ZERO?	P-WON /?PRG1
	CALL	GAME-VERB?
	ZERO?	STACK \?PRG1
	CALL	CLOCKER >V
	JUMP	?PRG1


	.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
	RTRUE	


	.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,0
	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,1
	SET	'P-WON,0
	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
	CALL	NOT-ACCESSIBLE?,HEM-OBJECT
	ZERO?	STACK /?CND1
	GETP	HEM-OBJECT,P?CHARACTER
	GET	GLOBAL-CHARACTER-TABLE,STACK
	RSTACK	
?CND1:	GETP	HEM-OBJECT,P?CHARACTER
	GET	CHARACTER-TABLE,STACK >V
	LOC	V
	EQUAL?	HERE,STACK \FALSE
	RETURN	V


	.FUNCT	PERFORM,A,O=0,I=0,V,OA,OO,OI,?TMP1
	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	NOT-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
	EQUAL?	A,V?WALK /?ELS87
	EQUAL?	NOT-HERE-OBJECT,PRSO,PRSI \?ELS87
	CALL	D-APPLY,STR?7,NOT-HERE-OBJECT-F >V
	ZERO?	V /?ELS87
	SET	'P-WON,0
	JUMP	?CND85
?ELS87:	CALL	THIS-IS-IT,PRSI
	ZERO?	STACK /?ELS91
	CALL	THIS-IS-IT,PRSO
	ZERO?	STACK /?ELS91
	SET	'O,PRSO
	SET	'I,PRSI
	CALL	NULL-F
	ZERO?	STACK /?ELS91
	CALL	NULL-F
	JUMP	?CND85
?ELS91:	GETP	WINNER,P?ACTION
	CALL	DD-APPLY,STR?8,WINNER,STACK >V
	ZERO?	V /?ELS95
	JUMP	?CND85
?ELS95:	LOC	WINNER
	GETP	STACK,P?ACTION
	CALL	D-APPLY,STR?9,STACK,M-BEG >V
	ZERO?	V /?ELS97
	JUMP	?CND85
?ELS97:	GET	PREACTIONS,A
	CALL	D-APPLY,STR?10,STACK >V
	ZERO?	V /?ELS99
	JUMP	?CND85
?ELS99:	ZERO?	I /?ELS101
	SET	'NOW-PRSI,1
	GETP	I,P?ACTION
	CALL	D-APPLY,STR?11,STACK >V
	ZERO?	V /?ELS101
	JUMP	?CND85
?ELS101:	SET	'NOW-PRSI,0
	ZERO?	O /?ELS105
	EQUAL?	A,V?WALK /?ELS105
	LOC	O
	ZERO?	STACK /?ELS105
	LOC	O
	GETP	STACK,P?CONTFCN
	ZERO?	STACK /?ELS105
	LOC	O >?TMP1
	LOC	O
	GETP	STACK,P?CONTFCN
	CALL	DD-APPLY,STR?12,?TMP1,STACK >V
	ZERO?	V /?ELS105
	JUMP	?CND85
?ELS105:	ZERO?	O /?ELS109
	EQUAL?	A,V?WALK /?ELS109
	GETP	O,P?ACTION
	CALL	D-APPLY,STR?13,STACK >V
	ZERO?	V /?ELS109
	JUMP	?CND85
?ELS109:	GET	ACTIONS,A
	CALL	D-APPLY,0,STACK >V
	ZERO?	V /?CND85
?CND85:	EQUAL?	V,M-FATAL /?CND114
	LOC	WINNER
	EQUAL?	STACK,PRSO \?CND117
	SET	'PRSO,0
?CND117:	LOC	WINNER
	GETP	STACK,P?ACTION
	CALL	D-APPLY,STR?14,STACK,M-END >V
?CND114:	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