395 lines
11 KiB
Plaintext
395 lines
11 KiB
Plaintext
"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)>>
|