hollywoodhijinx/misc.zap
2019-04-14 02:06:26 -04:00

512 lines
10 KiB
Plaintext

.FUNCT APRINT,OBJ
FSET? OBJ,NARTICLEBIT \?ELS3
PRINTC 32
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
PRINTC 32
JUMP ?CND1
?ELS3: PRINTI " the "
?CND1: CALL DPRINT,OBJ
RSTACK
.FUNCT ARPRINT,OBJ
CALL APRINT,OBJ
PRINTR "."
.FUNCT TRPRINT,OBJ
CALL TPRINT,OBJ
PRINTR "."
.FUNCT DPRINT,OBJ
GETP OBJ,P?SDESC
ZERO? STACK /?ELS5
GETP OBJ,P?SDESC
PRINT STACK
RTRUE
?ELS5: PRINTD OBJ
RTRUE
.FUNCT ULTIMATELY-IN?,OBJ,C=0
ZERO? C \?CND1
SET 'C,WINNER
?CND1: ZERO? OBJ /FALSE
IN? OBJ,C /TRUE
IN? OBJ,ROOMS /FALSE
LOC OBJ
CALL ULTIMATELY-IN?,STACK,C
RSTACK
.FUNCT GO
START::
?FCN: SET 'LIT,TRUE-VALUE
SET 'WINNER,PLAYER
GETB 0,56
EQUAL? STACK,P-PLAYER \?ELS7
GETB 0,57
EQUAL? STACK,P-WINNER /?THN4
?ELS7: GETB 0,56
EQUAL? STACK,84 \?CND1
GETB 0,57
EQUAL? STACK,79 \?CND1
GETB 0,58
EQUAL? STACK,77 \?CND1
GETB 0,59
EQUAL? STACK,65 \?CND1
GETB 0,60
EQUAL? STACK,83 \?CND1
?THN4: SET 'P-VMERGE,PLAYER
?CND1: CALL QUEUE,I-SANDS-OF-TIME,599
CALL QUEUE,I-SUNRISE,547
SET 'P-NMERGE,P-DEBUG
SET 'WHICH-END-IS-UP,RIGHT-END
SET 'CLOSET-FLOOR,FOYER
MOVE PLAYER,SOUTH-JUNCTION
SET 'HERE,SOUTH-JUNCTION
CALL QUEUE,I-NOISE,10
CALL RESET-THEM
PRINTI "As night falls the black limousine turns off the highway. It has all happened so fast, you think to yourself. Your Aunt passing away without any warning, the funeral this afternoon, and now this unusual stipulation in her will. The limo pulls up to the front of the house. ""This is the end of the line,"" says the attorney, and you step out of the back of the limo. ""Remember, your Aunt Hildegarde's will stated you will inherit her entire fortune -- if you can find the ten 'treasures' in one night.""
He hands you a photo of Uncle Buddy and a letter, saying, ""Her will instructed that I give you this photo, with the poem, to point you in the right direction. Also this letter, and here, you'll need this."" He gives you a flashlight. ""Meet me at 9 a.m. in the living room with all the 'treasures' and you'll inherit her entire estate,"" he says as the limo pulls away and disappears into the night's darkness."
CRLF
CALL V-VERSION
CRLF
CALL V-LOOK
CALL DO-MAIN-LOOP
JUMP ?FCN
.FUNCT RESET-THEM
CALL PCLEAR
SET 'P-HIM-OBJECT,NOT-HERE-OBJECT
SET 'P-HER-OBJECT,NOT-HERE-OBJECT
SET 'P-THEM-OBJECT,NOT-HERE-OBJECT
RETURN P-THEM-OBJECT
.FUNCT PCLEAR
SET 'P-CONT,FALSE-VALUE
SET 'QUOTE-FLAG,FALSE-VALUE
RETURN 2
.FUNCT DO-MAIN-LOOP,X
?PRG1: CALL MAIN-LOOP >X
JUMP ?PRG1
.FUNCT MAIN-LOOP,ICNT,OCNT,NUM,CNT,OBJ,TBL,V,PTBL,OBJ1,TMP,X,?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? P-IT-OBJECT /?CND7
CALL ACCESSIBLE?,P-IT-OBJECT
ZERO? STACK /?CND7
SET 'TMP,FALSE-VALUE
?PRG12: IGRTR? 'CNT,ICNT /?REP13
GET P-PRSI,CNT
EQUAL? STACK,IT \?PRG12
PUT P-PRSI,CNT,P-IT-OBJECT
SET 'TMP,TRUE-VALUE
?REP13: ZERO? TMP \?CND22
SET 'CNT,0
?PRG25: IGRTR? 'CNT,OCNT /?CND22
GET P-PRSO,CNT
EQUAL? STACK,IT \?PRG25
PUT P-PRSO,CNT,P-IT-OBJECT
?CND22: SET 'CNT,0
?CND7: ZERO? OCNT \?ELS39
PUSH OCNT
JUMP ?CND35
?ELS39: GRTR? OCNT,1 \?ELS41
SET 'TBL,P-PRSO
ZERO? ICNT \?ELS44
SET 'OBJ,FALSE-VALUE
JUMP ?CND42
?ELS44: GET P-PRSI,1 >OBJ
?CND42: PUSH OCNT
JUMP ?CND35
?ELS41: GRTR? ICNT,1 \?ELS48
SET 'PTBL,FALSE-VALUE
SET 'TBL,P-PRSI
GET P-PRSO,1 >OBJ
PUSH ICNT
JUMP ?CND35
?ELS48: PUSH 1
?CND35: SET 'NUM,STACK
ZERO? OBJ \?CND51
EQUAL? ICNT,1 \?CND51
GET P-PRSI,1 >OBJ
?CND51: EQUAL? PRSA,V?WALK \?ELS58
CALL PERFORM,PRSA,PRSO >V
JUMP ?CND56
?ELS58: ZERO? NUM \?ELS60
GETB P-SYNTAX,P-SBITS
BAND STACK,P-SONUMS
ZERO? STACK \?ELS63
CALL PERFORM,PRSA >V
SET 'PRSO,FALSE-VALUE
JUMP ?CND56
?ELS63: ZERO? LIT \?ELS65
CALL PCLEAR
CALL TOO-DARK
JUMP ?CND56
?ELS65: CALL PCLEAR
PRINTI "[There isn't anything to "
GET P-ITBL,P-VERBN >TMP
EQUAL? PRSA,V?TELL \?ELS70
PRINTI "talk to"
JUMP ?CND68
?ELS70: ZERO? P-MERGED \?THN73
ZERO? P-OFLAG /?ELS72
?THN73: GET TMP,0
PRINTB STACK
JUMP ?CND68
?ELS72: GETB TMP,2 >?TMP1
GETB TMP,3
CALL WORD-PRINT,?TMP1,STACK >V
?CND68: PRINTI "!]"
CRLF
SET 'V,FALSE-VALUE
JUMP ?CND56
?ELS60: SET 'X,0
SET 'TMP,FALSE-VALUE
?PRG79: IGRTR? 'CNT,NUM \?ELS83
GRTR? X,0 \?ELS86
PRINTI "[The "
EQUAL? X,NUM /?CND87
PRINTI "other "
?CND87: PRINTI "object"
EQUAL? X,1 /?CND90
PRINTC 115
?CND90: PRINTI " that you mentioned "
EQUAL? X,1 /?ELS95
PRINTI "are"
JUMP ?CND93
?ELS95: PRINTI "is"
?CND93: PRINTI "n't here!]"
CRLF
JUMP ?CND56
?ELS86: ZERO? TMP \?CND56
CALL REFERRING
JUMP ?CND56
?ELS83: ZERO? PTBL /?ELS104
GET P-PRSO,CNT >OBJ1
JUMP ?CND102
?ELS104: GET P-PRSI,CNT >OBJ1
?CND102: GRTR? NUM,1 /?THN111
GET P-ITBL,P-NC1
GET STACK,0
EQUAL? STACK,W?ALL,W?EVERYTHING \?CND108
?THN111: EQUAL? OBJ1,NOT-HERE-OBJECT \?ELS115
INC 'X
JUMP ?PRG79
?ELS115: EQUAL? P-GETFLAGS,P-ALL \?ELS117
CALL DONT-ALL?,OBJ1,OBJ
ZERO? STACK \?PRG79
?ELS117: CALL ACCESSIBLE?,OBJ1
ZERO? STACK /?PRG79
EQUAL? OBJ1,PLAYER /?PRG79
EQUAL? OBJ1,IT \?ELS128
FSET? P-IT-OBJECT,NARTICLEBIT /?CND129
PRINTI "The "
?CND129: CALL DPRINT,P-IT-OBJECT
JUMP ?CND126
?ELS128: FSET? OBJ1,NARTICLEBIT /?CND134
PRINTI "The "
?CND134: CALL DPRINT,OBJ1
?CND126: PRINTI ": "
?CND108: SET 'TMP,TRUE-VALUE
ZERO? PTBL /?ELS141
PUSH OBJ1
JUMP ?CND137
?ELS141: PUSH OBJ
?CND137: CALL QCONTEXT-CHECK,STACK >V
ZERO? PTBL /?ELS149
PUSH OBJ1
JUMP ?CND145
?ELS149: PUSH OBJ
?CND145: SET 'PRSO,STACK
ZERO? PTBL /?ELS157
PUSH OBJ
JUMP ?CND153
?ELS157: PUSH OBJ1
?CND153: SET 'PRSI,STACK
CALL PERFORM,PRSA,PRSO,PRSI >V
EQUAL? V,M-FATAL \?PRG79
?CND56: EQUAL? V,M-FATAL \?CND4
SET 'P-CONT,FALSE-VALUE
JUMP ?CND4
?ELS6: SET 'P-CONT,FALSE-VALUE
?CND4: ZERO? P-WON /?CND169
CALL GAME-VERB?
ZERO? STACK \?CND169
CALL CLOCKER >V
?CND169: SET 'PRSA,FALSE-VALUE
SET 'PRSO,FALSE-VALUE
SET 'PRSI,FALSE-VALUE
RETURN PRSI
.FUNCT DONT-ALL?,O,I,L
LOC O >L
EQUAL? O,I /TRUE
EQUAL? PRSA,V?TAKE \?ELS7
ZERO? I /?ELS12
CALL ULTIMATELY-IN?,O,I
ZERO? STACK /TRUE
?ELS12: ZERO? I \?ELS16
CALL ULTIMATELY-IN?,O
ZERO? STACK \TRUE
?ELS16: FSET? O,TAKEBIT /?ELS20
FSET? O,TRYTAKEBIT \TRUE
?ELS20: ZERO? I /?ELS24
EQUAL? L,I \TRUE
CALL SEE-INSIDE?,I
ZERO? STACK /TRUE
RFALSE
?ELS24: CALL META-LOC,O
EQUAL? STACK,PLAYER /FALSE
EQUAL? L,HERE /FALSE
FSET? L,SURFACEBIT /FALSE
FSET? L,ACTORBIT \TRUE
RFALSE
?ELS7: EQUAL? PRSA,V?PUT-ON,V?PUT,V?DROP /?THN47
EQUAL? PRSA,V?THROW \FALSE
?THN47: FSET? O,TAKEBIT \TRUE
EQUAL? L,PLAYER,WINNER \TRUE
RFALSE
.FUNCT GAME-VERB?,V=0
ZERO? V \?CND1
SET 'V,PRSA
?CND1: EQUAL? V,V?BRIEF,V?SCORE,V?VERBOSE /TRUE
EQUAL? V,V?QUIT,V?RESTART,V?RESTORE /TRUE
EQUAL? V,V?SAVE,V?SCRIPT,V?SUPER-BRIEF /TRUE
EQUAL? V,V?TELL,V?UNSCRIPT,V?VERSION /TRUE
EQUAL? V,V?TIME \FALSE
RTRUE
.FUNCT QCONTEXT-CHECK,PRSO,OTHER,WHO=0,N=0
EQUAL? PRSA,V?HELP /?THN6
EQUAL? PRSA,V?TELL \FALSE
EQUAL? PRSO,PLAYER \FALSE
?THN6: FIRST? HERE >OTHER /?KLU31
?KLU31:
?PRG10: ZERO? OTHER /?REP11
FSET? OTHER,ACTORBIT \?CND12
EQUAL? OTHER,PLAYER /?CND12
INC 'N
SET 'WHO,OTHER
?CND12: NEXT? OTHER >OTHER /?PRG10
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
CALL SPOKEN-TO,QCONTEXT
RSTACK
.FUNCT SAID-TO,WHO
SET 'QCONTEXT,WHO
LOC WHO >QCONTEXT-ROOM
RETURN QCONTEXT-ROOM
.FUNCT SPOKEN-TO,WHO
CALL PCLEAR
PRINTI "[spoken to"
CALL TPRINT,WHO
PRINTR "]"
.FUNCT QCONTEXT-GOOD?
ZERO? QCONTEXT /FALSE
FSET? QCONTEXT,ACTORBIT \FALSE
EQUAL? HERE,QCONTEXT-ROOM \FALSE
CALL META-LOC,QCONTEXT
EQUAL? HERE,STACK /TRUE
RFALSE
.FUNCT ACCESSIBLE?,OBJ
FSET? OBJ,INVISIBLE /FALSE
CALL META-LOC,OBJ
EQUAL? STACK,WINNER,HERE,GLOBAL-OBJECTS /TRUE
CALL VISIBLE?,OBJ
ZERO? STACK /FALSE
RTRUE
.FUNCT VISIBLE?,OBJ,L
LOC OBJ >L
ZERO? L /FALSE
FSET? OBJ,INVISIBLE /FALSE
EQUAL? L,GLOBAL-OBJECTS /FALSE
EQUAL? L,PLAYER,HERE,WINNER /TRUE
EQUAL? L,LOCAL-GLOBALS \?ELS13
CALL GLOBAL-IN?,OBJ,HERE
ZERO? STACK \TRUE
?ELS13: CALL SEE-INSIDE?,L
ZERO? STACK /FALSE
CALL VISIBLE?,L
ZERO? STACK /FALSE
RTRUE
.FUNCT SEE-INSIDE?,CONTAINER
ZERO? P-MOBY-FLAG \TRUE
FSET? CONTAINER,SURFACEBIT /TRUE
FSET? CONTAINER,CONTBIT \?ELS10
FSET? CONTAINER,OPENBIT /TRUE
FSET? CONTAINER,TRANSBIT \FALSE
RTRUE
?ELS10: FSET? CONTAINER,ACTORBIT \FALSE
EQUAL? CONTAINER,PLAYER /FALSE
RTRUE
.FUNCT META-LOC,OBJ
?PRG1: ZERO? OBJ /FALSE
IN? OBJ,GLOBAL-OBJECTS \?ELS7
RETURN GLOBAL-OBJECTS
?ELS7: IN? OBJ,ROOMS \?ELS9
RETURN OBJ
?ELS9: LOC OBJ >OBJ
JUMP ?PRG1
.FUNCT DEQUEUE,RTN
CALL QUEUED?,RTN >RTN
ZERO? RTN /FALSE
PUT RTN,C-RTN,0
RTRUE
.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: SUB C-INTS,C-INTLEN >C-INTS
ADD C-TABLE,C-INTS >INT
?CND6: PUT INT,C-RTN,RTN
JUMP ?REP2
?ELS5: GET C,C-RTN
EQUAL? STACK,RTN \?ELS13
SET 'INT,C
JUMP ?REP2
?ELS13: GET C,C-RTN
ZERO? STACK \?CND3
SET 'INT,C
?CND3: ADD C,C-INTLEN >C
JUMP ?PRG1
?REP2: GRTR? INT,CLOCK-HAND \?CND16
ADD TICK,3
SUB 0,STACK >TICK
?CND16: PUT INT,C-TICK,TICK
RETURN INT
.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 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,PLAYER
?PRG5: EQUAL? CLOCK-HAND,E \?ELS9
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 /?CND7
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
?CND7: ADD CLOCK-HAND,C-INTLEN >CLOCK-HAND
ZERO? Q? \?PRG5
ADD C-INTS,C-INTLEN >C-INTS
JUMP ?PRG5
.FUNCT FIXED-FONT-ON
GET 0,8
BOR STACK,2
PUT 0,8,STACK
RTRUE
.FUNCT FIXED-FONT-OFF
GET 0,8
BAND STACK,-3
PUT 0,8,STACK
RTRUE
.ENDI