seastalker/main.zil

395 lines
11 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

"MAIN for SEASTALKER
Copyright (C) 1984, 1985 Infocom, Inc. All rights reserved."
<GLOBAL P-WON <>>
<CONSTANT M-FATAL 2>
"<CONSTANT M-HANDLED 1>
<CONSTANT M-NOT-HANDLED <>>"
<CONSTANT M-BEG 1>
<CONSTANT M-END 6>
<CONSTANT M-ENTER 2>
<CONSTANT M-LOOK 3>
<CONSTANT M-FLASH 4>
<CONSTANT M-OBJDESC 5>
<ROUTINE GO ()
<SETG LIT T>
<PUTB ,P-LEXV 0 59>
<PUTB ,YES-LEXV 0 4>
<SETG SCORE 0>
<SETG HERE ,GAME>
<PUTB ,FIRST-NAME 0 3>
<PUTB ,FIRST-NAME 1 %<ASCII !\->>
<PUTB ,FIRST-NAME 2 %<ASCII !\->>
<PUTB ,FIRST-NAME 3 %<ASCII !\->>
<PUTB ,LAST-NAME 0 3>
<PUTB ,LAST-NAME 1 %<ASCII !\->>
<PUTB ,LAST-NAME 2 %<ASCII !\->>
<PUTB ,LAST-NAME 3 %<ASCII !\->>
;"<PUTB ,GAME-NAME 1 %<ASCII !\S>>
<PUTB ,GAME-NAME 2 %<ASCII !\E>>
<PUTB ,GAME-NAME 3 %<ASCII !\A>>
<PUTB ,GAME-NAME 4 %<ASCII !\S>>
<PUTB ,GAME-NAME 5 %<ASCII !\T>>
<PUTB ,GAME-NAME 6 %<ASCII !\A>>
<PUTB ,GAME-NAME 7 %<ASCII !\L>>
<PUTB ,GAME-NAME 8 %<ASCII !\K>>
<PUTB ,GAME-NAME 9 %<ASCII !\E>>
<PUTB ,GAME-NAME 10 %<ASCII !\R>>"
<SETG WINNER ,PLAYER>
<THIS-IS-IT ,VIDEOPHONE>
<THIS-IS-IT ,TIP>
<THIS-IS-IT ,SHARON>
<COND (<NOT <FSET? ,CENTER-OF-LAB ,TOUCHBIT>>
<INTRO>
<QUEUE-MAIN-EVENTS>)>
<SETG HERE ,CENTER-OF-LAB>
<MOVE ,TIP ,HERE>
<MOVE ,PLAYER ,HERE>
<MAIN-LOOP>
<AGAIN>>
<ROUTINE INTRO ("AUX" N)
<TELL
"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!" CR>
<REPEAT ()
<TELL CR>
<SET N <READ-NAME ,FIRST-NAME "Please type your first name.">>
<COND (<==? .N ,M-FATAL> <RFALSE>)>
<TELL "Hello " FN "! ">
<SET N <READ-NAME ,LAST-NAME "Now type your last name.">>
<COND (<==? .N ,M-FATAL> <RFALSE>)>
<TELL "Is " FN " " LN " right?">
<COND (<YES?> <RETURN>)>>
<TELL "Then let the story begin!">
<SET N 24>
<REPEAT () <COND (<DLESS? N 0> <RETURN>) (T <CRLF>)>>
<V-VERSION>
<CRLF>
<TELL
"\"" FN ", snap out of it!\" cries " D ,GLOBAL-TIP ", bursting into
" D ,YOUR-LABORATORY ". \"The alert signal is on!\"|
You look up from your plans for the " D ,SUB ", a top-secret submarine
that's still being tested. It's designed for capturing marine life on
the ocean floor. You notice the " D ,ALARM " on the " D ,VIDEOPHONE "
ringing. Someone's trying to reach you over the private " D ,VIDEOPHONE
" network of " D ,IU-GLOBAL "!|
" CR>>
<ROUTINE QUEUE-MAIN-EVENTS ()
<SETG ALARM-RINGING T>
<ENABLE <QUEUE I-ALARM-RINGING -1>>
<QUEUE I-SHOW-SONAR 0>
<QUEUE I-UPDATE-FREIGHTER 0>
<QUEUE I-UPDATE-SUB-POSITION 0>
<SETG OLD-HERE ,CENTER-OF-LAB>
<SETG TIP-FOLLOWS-YOU? T>
<ENABLE <QUEUE I-SNARK-ATTACKS <+ 250 <RANDOM 250>>>>
<ENABLE <QUEUE I-LAMP-ON-SCOPE 5>>
<ENABLE <QUEUE I-PROMPT-1 1>>
<ENABLE <QUEUE I-PROMPT-2 10>>
<ENABLE <QUEUE I-SHARON-GONE 25>>>
<ROUTINE MAIN-LOOP ("AUX" TRASH)
<REPEAT ()
<SET TRASH <MAIN-LOOP-1>>>>
<ROUTINE MAIN-LOOP-1 ("AUX" ICNT OCNT NUM CNT OBJ TBL V PTBL OBJ1 TMP)
#DECL ((CNT OCNT ICNT NUM) FIX (V) <OR 'T FIX FALSE> (OBJ)<OR FALSE OBJECT>
(OBJ1) OBJECT (TBL) TABLE (PTBL) <OR FALSE ATOM>)
<SET CNT 0>
<SET OBJ <>>
<SET PTBL T>
<COND (<NOT <==? ,QCONTEXT-ROOM ,HERE>>
<SETG QCONTEXT <>>)>
<COND (<SETG P-WON <PARSER>>
<SET ICNT <GET ,P-PRSI ,P-MATCHLEN>>
<SET NUM
<COND (<0? <SET OCNT <GET ,P-PRSO ,P-MATCHLEN>>> .OCNT)
(<G? .OCNT 1>
<SET TBL ,P-PRSO>
<COND (<0? .ICNT> <SET OBJ <>>)
(T <SET OBJ <GET ,P-PRSI 1>>)>
.OCNT)
(<G? .ICNT 1>
<SET PTBL <>>
<SET TBL ,P-PRSI>
<SET OBJ <GET ,P-PRSO 1>>
.ICNT)
(T 1)>>
<COND (<AND <NOT .OBJ> <1? .ICNT>> <SET OBJ <GET ,P-PRSI 1>>)>
<COND (<==? ,PRSA ,V?WALK>
<SET V <PERFORM ,PRSA ,PRSO>>)
(<0? .NUM>
<COND (<0? <BAND <GETB ,P-SYNTAX ,P-SBITS> ,P-SONUMS>>
<SET V <PERFORM ,PRSA>>
<SETG PRSO <>>)
(T
<TELL "(There isn't anything to ">
<SET TMP <GET ,P-ITBL ,P-VERBN>>
<COND (,P-OFLAG
<PRINTB <GET .TMP 0>>)
(T
<WORD-PRINT <GETB .TMP 2> <GETB .TMP 3>>)>
<TELL "!)" CR>
<SET V <>>)>)
(<AND .PTBL <G? .NUM 1> <VERB? COMPARE>>
<SET V <PERFORM ,PRSA ,OBJECT-PAIR>>)
(T
<SET TMP 0>
<REPEAT ()
<COND (<G? <SET CNT <+ .CNT 1>> .NUM>
<COND (<G? .TMP 0>
<TELL "The other thing">
<COND (<NOT <EQUAL? .TMP 1>>
<TELL "s">)>
<TELL " that you mentioned ">
<COND (<NOT <EQUAL? .TMP 1>>
<TELL "are">)
(T <TELL "is">)>
<TELL "n't here." CR>)>
<RETURN>)
(T
<COND (.PTBL <SET OBJ1 <GET ,P-PRSO .CNT>>)
(T <SET OBJ1 <GET ,P-PRSI .CNT>>)>
<COND (<G? .NUM 1>
<COND (<==? .OBJ1 ,NOT-HERE-OBJECT>
<SET TMP <+ .TMP 1>>
<AGAIN>)
(<==? .OBJ1 ,PLAYER> <AGAIN>)
;(<FSET? .OBJ1 ,DUPLICATE> <AGAIN>)
(T
<COND (<EQUAL? .OBJ1 ,IT>
<PRINTD ,P-IT-OBJECT>)
(T <PRINTD .OBJ1>)>
<TELL ": ">)>)>
<SET V <QCONTEXT-CHECK <COND (.PTBL .OBJ1)
(T .OBJ)>>>
<SET V
<PERFORM ,PRSA ;"? SETG PRSx to these?"
<COND (.PTBL .OBJ1) (T .OBJ)>
<COND (.PTBL .OBJ)(T .OBJ1)>>>
<COND (<==? .V ,M-FATAL> <RETURN>)>)>>)>
<COND (<==? .V ,M-FATAL> <SETG P-CONT <>>)>)
(T
<SETG P-CONT <>>)>
<COND (,P-WON
<COND (<NOT <GAME-VERB?>> <SET V <CLOCKER>>)>)>>
<ROUTINE QCONTEXT-CHECK (PRSO "AUX" OTHER (WHO <>) (N 0))
<COND (<OR <VERB? ;FIND HELP WHAT>
<AND <VERB? SHOW TELL-ABOUT>
<==? .PRSO ,PLAYER>>> ;"? more?"
<SET OTHER <FIRST? ,HERE>>
<REPEAT ()
<COND (<NOT .OTHER> <RETURN>)
(<AND <FSET? .OTHER ,PERSON>
<NOT <FSET? .OTHER ,INVISIBLE>>
<NOT <==? .OTHER ,PLAYER>>>
<SET N <+ 1 .N>>
<SET WHO .OTHER>)>
<SET OTHER <NEXT? .OTHER>>>
<COND (<AND <==? 1 .N> <NOT ,QCONTEXT>>
<SAID-TO .WHO>)>
<COND (<AND <QCONTEXT-GOOD?>
<==? ,WINNER ,PLAYER>> ;"? more?"
<SETG WINNER ,QCONTEXT>
<TELL "(said to " D ,QCONTEXT ")" CR>)>)>>
<ROUTINE QCONTEXT-GOOD? ()
<COND (<AND ,QCONTEXT
<NOT <FSET? ,QCONTEXT ,INVISIBLE>>
<==? ,HERE ,QCONTEXT-ROOM>
<==? ,HERE <META-LOC ,QCONTEXT>>>
<RTRUE>)>>
<ROUTINE SAID-TO (WHO)
<SETG QCONTEXT .WHO>
<SETG QCONTEXT-ROOM ,HERE>>
"<GLOBAL L-PRSA <>>
<GLOBAL L-PRSO <>>
<GLOBAL L-PRSI <>>"
<OBJECT OBJECT-PAIR
(DESC "such things")
(ACTION OBJECT-PAIR-F)>
<ROUTINE OBJECT-PAIR-F ("AUX" P1 P2)
<COND (<L? 2 <GET ,P-PRSO ,P-MATCHLEN>>
<COND (<VERB? COMPARE>
<TELL
"That's too many things to compare all at once!" CR>)>
<RTRUE>)
(<VERB? COMPARE>
<PERFORM ,PRSA <1 ,P-PRSO> <2 ,P-PRSO>>
<RTRUE>)>>
<ROUTINE THIS-IS-IT (OBJ)
<COND (<NOT .OBJ>
<RTRUE>)>
<COND (<AND <VERB? WALK> <==? .OBJ ,PRSO>>
<RTRUE>)>
<COND (<NOT <FSET? .OBJ ,PERSON>>
<COND (<NOT <EQUAL? .OBJ ,GLOBAL-HERE ,INTDIR>>
<SETG P-IT-OBJECT .OBJ>)>)
(<FSET? .OBJ ,FEMALE>
<SETG P-HER-OBJECT .OBJ>)
(T
<SETG P-HIM-OBJECT .OBJ>)>
<RTRUE>>
<ROUTINE FAKE-ORPHAN ("AUX" TMP)
<ORPHAN ,P-SYNTAX <>>
<TELL "(Be specific: what thing do you want to ">
<SET TMP <GET ,P-OTBL ,P-VERBN>>
<COND (<==? .TMP 0> <TELL "tell">)
(<0? <GETB ,P-VTBL 2>>
<PRINTB <GET .TMP 0>>)
(T
<WORD-PRINT <GETB .TMP 2> <GETB .TMP 3>>
<PUTB ,P-VTBL 2 0>)>
<SETG P-OFLAG T>
<SETG P-WON <>>
<TELL "?)" CR>>
<GLOBAL NOW-PRSI <>>
<ROUTINE TELL-D-LOC (OBJ)
<TELL D .OBJ>
<COND (<IN? .OBJ ,GLOBAL-OBJECTS> <TELL "(gl)">)
(<IN? .OBJ ,LOCAL-GLOBALS> <TELL "(lg)">)
(<IN? .OBJ ,ROOMS> <TELL "(rm)">)>>
<ROUTINE FIX-HIM-HER (HEM-OBJECT "AUX" V)
<SET V <GETP .HEM-OBJECT ,P?CHARACTER>>
<COND (<NOT <ACCESSIBLE? .HEM-OBJECT>>
;<COND (,DEBUG <TELL "[" D .HEM-OBJECT ":NA]" CR>)>
<RETURN <GET ,GLOBAL-CHARACTER-TABLE .V>>)>
<SET V <GET ,CHARACTER-TABLE .V>>
<COND (<EQUAL? ,HERE <LOC .V>>
;<COND (,DEBUG <TELL "[" D .HEM-OBJECT ":LO]" CR>)>
<RETURN .V>)>>
<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" V OA OO OI)
<COND (,DEBUG
<TELL "[Perform: ">
%<COND (<GASSIGNED? PREDGEN> '<TELL N .A>)
(T '<PRINC <NTH ,ACTIONS <+ <* .A 2> 1>>>)>
<COND (.O
<TELL "/">
<COND (<==? .A ,V?WALK> <TELL N .O>)
(T <TELL-D-LOC .O>)>)>
<COND (.I
<TELL "/">
<TELL-D-LOC .I>)>
<TELL "]" CR>)>
<SET OA ,PRSA>
<SET OO ,PRSO>
<SET OI ,PRSI>
<SETG PRSA .A>
<COND (<NOT <EQUAL? .A ,V?WALK>>
<COND (<AND <EQUAL? ,IT .I .O>
<NOT <ACCESSIBLE? ,P-IT-OBJECT>>>
<COND (<NOT .I> <FAKE-ORPHAN>)
(T <TELL
"(Sorry, but" THE ,P-IT-OBJECT " isn't here!)" CR>)>
<RFATAL>)>
<COND (<EQUAL? ,HER .I .O>
<COND (<SET V <FIX-HIM-HER ,P-HER-OBJECT>>
<COND (<==? ,HER .O> <SET O .V>)>
<COND (<==? ,HER .I> <SET I .V>)>)>)>
<COND (<EQUAL? ,HIM .I .O>
<COND (<SET V <FIX-HIM-HER ,P-HIM-OBJECT>>
<COND (<==? ,HIM .O> <SET O .V>)>
<COND (<==? ,HIM .I> <SET I .V>)>)>)>
<COND (<==? .O ,IT> <SET O ,P-IT-OBJECT>)
(<==? .O ,HER> <SET O ,P-HER-OBJECT>)
(<==? .O ,HIM> <SET O ,P-HIM-OBJECT>)>
<COND (<==? .I ,IT> <SET I ,P-IT-OBJECT>)
(<==? .I ,HER> <SET I ,P-HER-OBJECT>)
(<==? .I ,HIM> <SET I ,P-HIM-OBJECT>)>)>
<SETG PRSI .I>
<SETG PRSO .O>
<SET V <>>
<COND (<AND <NOT <EQUAL? .A ,V?WALK>>
<EQUAL? ,NOT-HERE-OBJECT ,PRSO ,PRSI>>
<SET V <D-APPLY "Not Here" ,NOT-HERE-OBJECT-F>>
<COND (.V
<SETG P-WON <>>)>)>
<THIS-IS-IT ,PRSI>
<THIS-IS-IT ,PRSO>
<SET O ,PRSO>
<SET I ,PRSI>
<COND (<ZERO? .V>
<SET V <DD-APPLY "Actor" ,WINNER <GETP ,WINNER ,P?ACTION>>>)>
<COND (<ZERO? .V>
<SET V <D-APPLY "Room (M-BEG)"
<GETP <LOC ,WINNER> ,P?ACTION>
,M-BEG>>)>
<COND (<ZERO? .V>
<SET V <D-APPLY "Preaction" <GET ,PREACTIONS .A>>>)>
<SETG NOW-PRSI T>
<COND (<AND <ZERO? .V>
.I>
<SET V <D-APPLY "PRSI" <GETP .I ,P?ACTION>>>)>
<SETG NOW-PRSI <>>
<COND (<AND <ZERO? .V>
.O
<NOT <==? .A ,V?WALK>>
<LOC .O>>
<SET V <GETP <LOC .O> ,P?CONTFCN>>
<COND (.V
<SET V <DD-APPLY "Container" <LOC .O> .V>>)>)>
<COND (<AND <ZERO? .V>
.O
<NOT <==? .A ,V?WALK>>>
<SET V <D-APPLY "PRSO" <GETP .O ,P?ACTION>>>)>
<COND (<ZERO? .V>
<SET V <D-APPLY <> <GET ,ACTIONS .A>>>)>
<COND (<NOT <==? .V ,M-FATAL>>
<COND (<NOT <GAME-VERB?>>
<SET V <D-APPLY "Room (M-END)"
<GETP <LOC ,WINNER> ,P?ACTION> ,M-END>>)>)>
<SETG PRSA .OA>
<SETG PRSO .OO>
<SETG PRSI .OI>
.V>
<ROUTINE DD-APPLY (STR OBJ FCN)
<COND (,DEBUG <TELL "[" D .OBJ "=]">)>
<D-APPLY .STR .FCN>>
<ROUTINE D-APPLY (STR FCN "OPTIONAL" (FOO <>) "AUX" RES)
<COND (<NOT .FCN> <>)
(T
<COND (,DEBUG
<COND (<NOT .STR>
<TELL "[Action:]" CR>)
(T <TELL "[" .STR ": ">)>)>
<SET RES
<COND (.FOO <APPLY .FCN .FOO>)
(T <APPLY .FCN>)>>
<COND (<AND ,DEBUG .STR>
<COND (<==? .RES ,M-FATAL>
<TELL "Fatal]" CR>)
(<NOT .RES>
<TELL "Not handled]" CR>)
(T <TELL "Handled]" CR>)>)>
.RES)>>