.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