.FUNCT PICK-ONE,TBL,LENGTH,CNT,RND,MSG,RFROB GET TBL,0 >LENGTH GET TBL,1 >CNT DEC 'LENGTH ADD TBL,2 >TBL MUL CNT,2 ADD TBL,STACK >RFROB SUB LENGTH,CNT RANDOM STACK >RND GET RFROB,RND >MSG GET RFROB,1 PUT RFROB,RND,STACK PUT RFROB,1,MSG INC 'CNT EQUAL? CNT,LENGTH \?CND1 SET 'CNT,0 ?CND1: PUT TBL,0,CNT RETURN MSG .FUNCT DPRINT,OBJ EQUAL? OBJ,SULTANS-WIFE \?ELS5 PRINTI "Sultan" ZERO? MALE /?ELS8 PRINTI "'s wife #" JUMP ?CND6 ?ELS8: PRINTI "ess' husband #" ?CND6: PRINTN CHOICE-NUMBER RTRUE ?ELS5: FSET? OBJ,UNTEEDBIT \?ELS13 GETP OBJ,P?NO-T-DESC PRINT STACK RTRUE ?ELS13: GETP OBJ,P?SDESC ZERO? STACK /?ELS15 GETP OBJ,P?SDESC PRINT STACK RTRUE ?ELS15: PRINTD OBJ RTRUE .FUNCT DPRINT-SIDEKICK CALL DPRINT,SIDEKICK RSTACK .FUNCT APRINT,OBJ FSET? OBJ,NARTICLEBIT \?ELS3 PRINTI " " JUMP ?CND1 ?ELS3: FSET? OBJ,VOWELBIT \?ELS5 PRINTI " an " JUMP ?CND1 ?ELS5: PRINTI " a " ?CND1: CALL DPRINT,OBJ RSTACK .FUNCT TPRINT,OBJ FSET? OBJ,NARTICLEBIT \?ELS3 PRINTI " " JUMP ?CND1 ?ELS3: PRINTI " the " ?CND1: CALL DPRINT,OBJ RSTACK .FUNCT TPRINT-PRSO CALL TPRINT,PRSO RSTACK .FUNCT TPRINT-PRSI CALL TPRINT,PRSI RSTACK .FUNCT ARPRINT,OBJ CALL APRINT,OBJ PRINT PERIOD-CR RTRUE .FUNCT TRPRINT,OBJ CALL TPRINT,OBJ PRINT PERIOD-CR RTRUE .FUNCT GO START:: ?FCN: SET 'HERE,WARNING USL PRINTI " Some material in this story may not be suitable for children, especially the parts involving sex, which no one should know anything about until reaching the age of eighteen (twenty-one in certain states). This story is also unsuitable for censors, members of the Moral Majority, and anyone else who thinks that sex is dirty rather than fun. The attitudes expressed and language used in this story are representative only of the views of the author, and in no way represent the views of Infocom, Inc. or its employees, many of whom are children, censors, and members of the Moral Majority. (But very few of whom, based on last year's Christmas Party, think that sex is dirty.) By now, all the folks who might be offended by " PRINT LGOP-CAPS PRINTI " have whipped their disk out of their drive and, evidence in hand, are indignantly huffing toward their dealer, their lawyer, or their favorite repression-oriented politico. So.." PRINT HIT-RETURN PRINTI "begin!" READ P-INBUF,P-LEXV CALL CLEAR-SCREEN SET 'WINNER,PROTAGONIST SET 'HERE,JOES-BAR USL PRINTI "The place: Upper Sandusky, Ohio. The time: 1936. The beer: at a nickel a mug, you don't ask for brand names. All you know is that your fifth one tasted as bad as the first." CRLF CRLF CALL V-VERSION CRLF CALL V-LOOK CALL I-URGE CALL MAIN-LOOP JUMP ?FCN .FUNCT CLEAR-SCREEN,CNT=24 ?PRG1: CRLF DEC 'CNT ZERO? CNT \?PRG1 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 CALL PARSER >P-WON ZERO? P-WON /?ELS3 GET P-PRSI,P-MATCHLEN >ICNT GET P-PRSO,P-MATCHLEN >OCNT ZERO? P-IT-OBJECT /?CND4 CALL ACCESSIBLE?,P-IT-OBJECT ZERO? STACK /?CND4 SET 'TMP,FALSE-VALUE ?PRG9: IGRTR? 'CNT,ICNT \?ELS13 JUMP ?REP10 ?ELS13: GET P-PRSI,CNT EQUAL? STACK,IT \?PRG9 CALL TOO-DARK-FOR-IT? ZERO? STACK \TRUE PUT P-PRSI,CNT,P-IT-OBJECT SET 'TMP,TRUE-VALUE ?REP10: ZERO? TMP \?CND22 SET 'CNT,0 ?PRG25: IGRTR? 'CNT,OCNT \?ELS29 JUMP ?CND22 ?ELS29: GET P-PRSO,CNT EQUAL? STACK,IT \?PRG25 CALL TOO-DARK-FOR-IT? ZERO? STACK \TRUE PUT P-PRSO,CNT,P-IT-OBJECT ?CND22: SET 'CNT,0 ?CND4: ZERO? OCNT \?ELS42 PUSH OCNT JUMP ?CND38 ?ELS42: GRTR? OCNT,1 \?ELS44 SET 'TBL,P-PRSO ZERO? ICNT \?ELS47 SET 'OBJ,FALSE-VALUE JUMP ?CND45 ?ELS47: GET P-PRSI,1 >OBJ ?CND45: PUSH OCNT JUMP ?CND38 ?ELS44: GRTR? ICNT,1 \?ELS51 SET 'PTBL,FALSE-VALUE SET 'TBL,P-PRSI GET P-PRSO,1 >OBJ PUSH ICNT JUMP ?CND38 ?ELS51: PUSH 1 ?CND38: SET 'NUM,STACK ZERO? OBJ \?CND54 EQUAL? ICNT,1 \?CND54 GET P-PRSI,1 >OBJ ?CND54: EQUAL? PRSA,V?WALK \?ELS61 CALL PERFORM-PRSA,PRSO >V JUMP ?CND59 ?ELS61: ZERO? NUM \?ELS63 GETB P-SYNTAX,P-SBITS BAND STACK,P-SONUMS ZERO? STACK \?ELS66 CALL PERFORM-PRSA >V SET 'PRSO,FALSE-VALUE JUMP ?CND59 ?ELS66: ZERO? LIT \?ELS68 PRINT TOO-DARK CRLF CALL STOP JUMP ?CND59 ?ELS68: PRINTI "There isn't anything to " GET P-ITBL,P-VERBN >TMP EQUAL? PRSA,V?TELL \?ELS73 PRINTI "talk to" JUMP ?CND71 ?ELS73: ZERO? P-OFLAG \?THN76 ZERO? P-MERGED /?ELS75 ?THN76: GET TMP,0 PRINTB STACK JUMP ?CND71 ?ELS75: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK ?CND71: PRINTI "!" CRLF SET 'V,FALSE-VALUE CALL STOP JUMP ?CND59 ?ELS63: SET 'P-NOT-HERE,0 SET 'P-MULT,FALSE-VALUE GRTR? NUM,1 \?CND82 SET 'P-MULT,TRUE-VALUE ?CND82: SET 'TMP,FALSE-VALUE ?PRG85: IGRTR? 'CNT,NUM \?ELS89 GRTR? P-NOT-HERE,0 \?ELS92 PRINTI "[The " EQUAL? P-NOT-HERE,NUM /?CND93 PRINTI "other " ?CND93: PRINTI "object" EQUAL? P-NOT-HERE,1 /?CND96 PRINTI "s" ?CND96: PRINTI " that you mentioned " EQUAL? P-NOT-HERE,1 /?ELS101 PRINTI "are" JUMP ?CND99 ?ELS101: PRINTI "is" ?CND99: PRINTI "n't here.]" CRLF JUMP ?REP86 ?ELS92: ZERO? TMP \?REP86 CALL REFERRING JUMP ?REP86 ?ELS89: ZERO? PTBL /?ELS110 GET P-PRSO,CNT >OBJ1 JUMP ?CND108 ?ELS110: GET P-PRSI,CNT >OBJ1 ?CND108: ZERO? PTBL /?ELS118 PUSH OBJ1 JUMP ?CND114 ?ELS118: PUSH OBJ ?CND114: SET 'PRSO,STACK ZERO? PTBL /?ELS126 PUSH OBJ JUMP ?CND122 ?ELS126: PUSH OBJ1 ?CND122: SET 'PRSI,STACK GRTR? NUM,1 /?THN133 GET P-ITBL,P-NC1 GET STACK,0 EQUAL? STACK,W?ALL,W?EVERYT \?CND130 ?THN133: CALL DONT-ALL,OBJ1 ZERO? STACK /?ELS137 JUMP ?PRG85 ?ELS137: EQUAL? OBJ1,IT \?ELS142 CALL DPRINT,P-IT-OBJECT JUMP ?CND140 ?ELS142: EQUAL? OBJ1,HIM \?ELS144 CALL DPRINT,P-HIM-OBJECT JUMP ?CND140 ?ELS144: EQUAL? OBJ1,HER \?ELS146 CALL DPRINT,P-HER-OBJECT JUMP ?CND140 ?ELS146: CALL DPRINT,OBJ1 ?CND140: PRINTI ": " ?CND130: SET 'TMP,TRUE-VALUE CALL PERFORM-PRSA,PRSO,PRSI >V EQUAL? V,M-FATAL \?PRG85 JUMP ?CND59 ?REP86: ?CND59: EQUAL? V,M-FATAL \?CND152 SET 'P-CONT,FALSE-VALUE ?CND152: CALL CLOCKER-VERB? ZERO? STACK /?CND1 EQUAL? PRSA,V?TELL /?CND1 ZERO? P-WON /?CND1 GETP HERE,P?ACTION CALL STACK,M-END >V JUMP ?CND1 ?ELS3: SET 'P-CONT,FALSE-VALUE ?CND1: ZERO? P-WON /?CND162 CALL CLOCKER-VERB? ZERO? STACK /?CND166 CALL CLOCKER >V ?CND166: SET 'P-PRSA-WORD,FALSE-VALUE SET 'PRSA,FALSE-VALUE SET 'PRSO,FALSE-VALUE SET 'PRSI,FALSE-VALUE ?CND162: ZERO? AWAITING-FAKE-ORPHAN /FALSE ZERO? P-OFLAG \FALSE CALL ORPHAN-VERB RSTACK .FUNCT TOO-DARK-FOR-IT? ZERO? LIT \FALSE CALL ULTIMATELY-IN?,P-IT-OBJECT,WINNER ZERO? STACK \FALSE IN? WINNER,P-IT-OBJECT /FALSE PRINT TOO-DARK CRLF RTRUE .FUNCT DONT-ALL,OBJ1,L LOC OBJ1 >L EQUAL? OBJ1,NOT-HERE-OBJECT \?ELS5 INC 'P-NOT-HERE RTRUE ?ELS5: EQUAL? PRSA,V?TAKE \?ELS7 ZERO? PRSI /?ELS7 IN? PRSO,PRSI \TRUE ?ELS7: CALL ACCESSIBLE?,OBJ1 ZERO? STACK /TRUE EQUAL? P-GETFLAGS,P-ALL \FALSE ZERO? PRSI /?ELS18 EQUAL? PRSO,PRSI /TRUE ?ELS18: EQUAL? PRSA,V?TAKE \?ELS22 FSET? OBJ1,TAKEBIT /?ELS27 FSET? OBJ1,TRYTAKEBIT \TRUE ?ELS27: EQUAL? L,WINNER,HERE,PRSI /?ELS31 LOC WINNER EQUAL? L,STACK /?ELS31 FSET? L,SURFACEBIT \TRUE FSET? L,TAKEBIT /TRUE RFALSE ?ELS31: ZERO? PRSI \FALSE CALL ULTIMATELY-IN?,PRSO ZERO? STACK /FALSE RTRUE ?ELS22: EQUAL? PRSA,V?PUT-ON,V?PUT,V?DROP /?THN53 EQUAL? PRSA,V?SGIVE,V?GIVE \?ELS50 ?THN53: IN? OBJ1,WINNER \TRUE ?ELS50: EQUAL? PRSA,V?PUT-ON,V?PUT \FALSE IN? PRSO,WINNER /FALSE CALL ULTIMATELY-IN?,PRSO,PRSI ZERO? STACK \TRUE RFALSE .FUNCT CLOCKER-VERB? EQUAL? PRSA,V?STATUS,V?HELP,V?VERSION /FALSE EQUAL? PRSA,V?$COMMAND,V?$UNRECORD,V?$RECORD /FALSE EQUAL? PRSA,V?RESTORE,V?SAVE,V?$RANDOM /FALSE EQUAL? PRSA,V?SCRIPT,V?QUIT,V?RESTART /FALSE EQUAL? PRSA,V?SUPER-BRIEF,V?BRIEF,V?UNSCRIPT /FALSE EQUAL? PRSA,V?TAME,V?LEWD,V?VERBOSE /FALSE EQUAL? PRSA,V?SUGGESTIVE \TRUE RFALSE .FUNCT FAKE-ORPHAN,IT-WAS-USED=0,TMP,?TMP1 CALL ORPHAN,P-SYNTAX,FALSE-VALUE GET P-OTBL,P-VERBN >TMP PRINTI "[Be specific: Wh" ZERO? IT-WAS-USED /?ELS3 PRINTI "at object" JUMP ?CND1 ?ELS3: PRINTI "o" ?CND1: PRINTI " do you want to " ZERO? TMP \?ELS9 PRINTI "tell" JUMP ?CND7 ?ELS9: GETB P-VTBL,2 ZERO? STACK \?ELS11 GET TMP,0 PRINTB STACK JUMP ?CND7 ?ELS11: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK PUTB P-VTBL,2,0 ?CND7: SET 'P-OFLAG,TRUE-VALUE SET 'P-WON,FALSE-VALUE GETB P-SYNTAX,P-SPREP1 CALL PREP-PRINT,STACK PRINTR "?]" .FUNCT PERFORM-PRSA,O=0,I=0 CALL PERFORM,PRSA,O,I RSTACK .FUNCT PERFORM,A,O=0,I=0,V,OA,OO,OI SET 'OA,PRSA SET 'OO,PRSO SET 'OI,PRSI SET 'PRSA,A EQUAL? IT,O,I \?CND1 CALL VISIBLE?,P-IT-OBJECT ZERO? STACK /?ELS6 EQUAL? IT,O \?ELS9 SET 'O,P-IT-OBJECT JUMP ?CND4 ?ELS9: SET 'I,P-IT-OBJECT JUMP ?CND4 ?ELS6: ZERO? I \?ELS16 CALL FAKE-ORPHAN,TRUE-VALUE RETURN 8 ?ELS16: CALL REFERRING RETURN 8 ?CND4: ?CND1: EQUAL? HIM,O,I \?CND21 CALL VISIBLE?,P-HIM-OBJECT ZERO? STACK /?ELS26 EQUAL? HIM,O \?ELS29 SET 'O,P-HIM-OBJECT JUMP ?CND24 ?ELS29: SET 'I,P-HIM-OBJECT JUMP ?CND24 ?ELS26: ZERO? I \?ELS36 CALL FAKE-ORPHAN RETURN 8 ?ELS36: CALL REFERRING,TRUE-VALUE RETURN 8 ?CND24: ?CND21: EQUAL? HER,O,I \?CND41 CALL VISIBLE?,P-HER-OBJECT ZERO? STACK /?ELS46 EQUAL? HER,O \?ELS49 SET 'O,P-HER-OBJECT JUMP ?CND44 ?ELS49: SET 'I,P-HER-OBJECT JUMP ?CND44 ?ELS46: ZERO? I \?ELS56 CALL FAKE-ORPHAN RETURN 8 ?ELS56: CALL REFERRING,TRUE-VALUE RETURN 8 ?CND44: ?CND41: SET 'PRSO,O SET 'PRSI,I EQUAL? A,V?WALK /?ELS63 EQUAL? NOT-HERE-OBJECT,PRSO,PRSI \?ELS63 CALL D-APPLY,STR?1,NOT-HERE-OBJECT-F >V ZERO? V /?ELS63 SET 'P-WON,FALSE-VALUE JUMP ?CND61 ?ELS63: SET 'O,PRSO SET 'I,PRSI CALL THIS-IS-IT,PRSI CALL THIS-IS-IT,PRSO GETP WINNER,P?ACTION CALL D-APPLY,STR?2,STACK >V ZERO? V /?ELS70 JUMP ?CND61 ?ELS70: GET PREACTIONS,A CALL D-APPLY,STR?3,STACK >V ZERO? V /?ELS72 JUMP ?CND61 ?ELS72: ZERO? I /?ELS74 GETP I,P?ACTION CALL D-APPLY,STR?4,STACK >V ZERO? V /?ELS74 JUMP ?CND61 ?ELS74: ZERO? O /?ELS78 EQUAL? A,V?WALK /?ELS78 GETP O,P?ACTION CALL D-APPLY,STR?5,STACK >V ZERO? V /?ELS78 JUMP ?CND61 ?ELS78: GET ACTIONS,A CALL D-APPLY,FALSE-VALUE,STACK >V ZERO? V /?CND61 ?CND61: SET 'PRSA,OA SET 'PRSO,OO SET 'PRSI,OI RETURN V .FUNCT D-APPLY,STR,FCN,FOO=0,RES ZERO? FCN /FALSE ZERO? FOO /?ELS12 CALL FCN,FOO JUMP ?CND8 ?ELS12: CALL FCN ?CND8: SET 'RES,STACK RETURN RES .FUNCT DEQUEUE,RTN CALL QUEUED?,RTN >RTN ZERO? RTN /FALSE PUT RTN,C-RTN,0 RTRUE .FUNCT QUEUED?,RTN,C,E ADD C-TABLE,C-TABLELEN >E ADD C-TABLE,C-INTS >C ?PRG1: EQUAL? C,E /FALSE GET C,C-RTN EQUAL? STACK,RTN \?CND3 GET C,C-TICK ZERO? STACK /FALSE RETURN C ?CND3: ADD C,C-INTLEN >C JUMP ?PRG1 .FUNCT RUNNING?,RTN,C,E ADD C-TABLE,C-TABLELEN >E ADD C-TABLE,C-INTS >C ?PRG1: EQUAL? C,E /FALSE GET C,C-RTN EQUAL? STACK,RTN \?CND3 GET C,C-TICK ZERO? STACK /FALSE GET C,C-TICK GRTR? STACK,1 \TRUE RFALSE ?CND3: ADD C,C-INTLEN >C JUMP ?PRG1 .FUNCT QUEUE,RTN,TICK,C,E,INT=0 ADD C-TABLE,C-TABLELEN >E ADD C-TABLE,C-INTS >C ?PRG1: EQUAL? C,E \?ELS5 ZERO? INT /?ELS8 SET 'C,INT JUMP ?CND6 ?ELS8: LESS? C-INTS,C-INTLEN \?CND12 PRINTI "**Too many ints!**" CRLF ?CND12: SUB C-INTS,C-INTLEN >C-INTS LESS? C-INTS,C-MAXINTS \?CND15 SET 'C-MAXINTS,C-INTS ?CND15: ADD C-TABLE,C-INTS >INT ?CND6: PUT INT,C-RTN,RTN JUMP ?REP2 ?ELS5: GET C,C-RTN EQUAL? STACK,RTN \?ELS19 SET 'INT,C JUMP ?REP2 ?ELS19: GET C,C-RTN ZERO? STACK \?CND3 SET 'INT,C ?CND3: ADD C,C-INTLEN >C JUMP ?PRG1 ?REP2: GRTR? INT,CLOCK-HAND \?CND22 ADD TICK,3 SUB 0,STACK >TICK ?CND22: PUT INT,C-TICK,TICK RETURN INT .FUNCT CLOCKER,E,TICK,RTN,FLG=0,Q?=0,OWINNER ZERO? CLOCK-WAIT /?CND1 SET 'CLOCK-WAIT,FALSE-VALUE RFALSE ?CND1: ADD C-TABLE,C-INTS >CLOCK-HAND ADD C-TABLE,C-TABLELEN >E SET 'OWINNER,WINNER SET 'WINNER,PROTAGONIST ?PRG5: EQUAL? CLOCK-HAND,E \?ELS9 SET 'CLOCK-HAND,E INC 'MOVES SET 'WINNER,OWINNER RETURN FLG ?ELS9: GET CLOCK-HAND,C-RTN ZERO? STACK /?CND7 GET CLOCK-HAND,C-TICK >TICK LESS? TICK,-1 \?ELS14 SUB 0,TICK SUB STACK,3 PUT CLOCK-HAND,C-TICK,STACK SET 'Q?,CLOCK-HAND JUMP ?CND7 ?ELS14: ZERO? TICK /?CND7 GRTR? TICK,0 \?CND17 DEC 'TICK PUT CLOCK-HAND,C-TICK,TICK ?CND17: ZERO? TICK /?CND20 SET 'Q?,CLOCK-HAND ?CND20: GRTR? TICK,0 /?CND12 GET CLOCK-HAND,C-RTN >RTN ZERO? TICK \?CND26 PUT CLOCK-HAND,C-RTN,0 ?CND26: CALL RTN ZERO? STACK /?CND29 SET 'FLG,TRUE-VALUE ?CND29: ZERO? Q? \?CND7 GET CLOCK-HAND,C-RTN ZERO? STACK /?CND7 SET 'Q?,TRUE-VALUE ?CND12: ?CND7: ADD CLOCK-HAND,C-INTLEN >CLOCK-HAND ZERO? Q? \?PRG5 ADD C-INTS,C-INTLEN >C-INTS JUMP ?PRG5 .ENDI