leathergoddesses/misc.zap

603 lines
12 KiB
Plaintext

.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