beyondzork/rarities.zap

1912 lines
42 KiB
Plaintext

.FUNCT DESCRIBE-INTNUM,OBJ
PRINTD INTNUM
PRINTC SP
PRINTN P-NUMBER
RTRUE
.FUNCT BE-SPECIFIC
PRINTI "[Be specific: what do you want to "
RTRUE
.FUNCT TO-DO-THING-USE,STR1,STR2
PRINTI "[To "
PRINT STR1
PRINTC SP
PRINTB W?SOMETHING
PRINTI ", use the command: "
PRINT STR2
PRINTR " THING.]"
.FUNCT CANT-USE,PTR,BUF,?TMP1
SET 'QUOTE-FLAG,FALSE-VALUE
SET 'P-OFLAG,FALSE-VALUE
MUL PTR,2
ADD P-LEXV,STACK >BUF
PRINTI "[This story can't understand the word """
GETB BUF,2 >?TMP1
GETB BUF,3
ICALL WORD-PRINT,?TMP1,STACK
PRINTR """ when you use it that way.]"
.FUNCT DONT-UNDERSTAND
PRINTR "[Please try to express that another way.]"
.FUNCT NOT-IN-SENTENCE,STR
PRINTI "[There aren't "
PRINT STR
PRINTR " in that sentence.]"
.FUNCT WALLS-F
EQUAL? HERE,IN-GARDEN /?CND1
FSET? HERE,INDOORS /?CND1
ICALL2 CANT-SEE-ANY,WALLS
RETURN 2
?CND1: CALL1 HANDLE-WALLS?
ZERO? STACK \TRUE
ICALL2 USELESS,WALLS
RETURN 2
.FUNCT HANDLE-WALLS?,X
ZERO? NOW-PRSI? /?CCL3
INTBL? PRSA,PUTVERBS,NUMPUTS >X \FALSE
ICALL1 PRSO-SLIDES-OFF-PRSI
RTRUE
?CCL3: INTBL? PRSA,E-VERBS,CLIMB-ON-VERBS >X /?CTR6
EQUAL? PRSA,V?LOOK-BEHIND,V?LOOK-UNDER \?CCL7
?CTR6: EQUAL? HERE,IN-GARDEN \?CND10
ICALL1 CTHE-PRINT
PRINTR " is much too high."
?CND10: ICALL1 IMPOSSIBLE
RTRUE
?CCL7: INTBL? PRSA,X-VERBS,CLIMB-DOWN-VERBS >X \?CCL13
ICALL1 NOT-ON
RTRUE
?CCL13: INTBL? PRSA,HURTVERBS,NHVERBS >X /?CTR14
INTBL? PRSA,MOVEVERBS,NMVERBS >X \?CCL15
?CTR14: ICALL1 CTHE-PRINT
PRINTR " isn't affected."
?CCL15: INTBL? PRSA,TALKVERBS,NTVERBS >X \FALSE
PRINTI "Talking to walls"
ICALL1 WONT-HELP
RETURN 2
.FUNCT CEILING-F
FSET? HERE,INDOORS /?CCL3
ICALL2 CANT-SEE-ANY,CEILING
RETURN 2
?CCL3: EQUAL? PRSA,V?LOOK-UNDER \FALSE
ICALL1 V-LOOK
RTRUE
.FUNCT HANDS-F,X
ZERO? NOW-PRSI? /?CCL3
EQUAL? PRSA,V?SCRAPE-ON \?CCL6
ZERO? MOSS-TIMER /?CCL6
ICALL1 DO-MOSS
RTRUE
?CCL6: EQUAL? PRSA,V?TIE,V?PUT,V?PUT-ON /?CCL9
EQUAL? PRSA,V?EMPTY-INTO \FALSE
?CCL9: ICALL1 WASTE-OF-TIME
RTRUE
?CCL3: EQUAL? PRSA,V?EXAMINE,V?LOOK-ON \?CCL13
ZERO? MOSS-TIMER /?CND14
ICALL1 DO-MOSS
RTRUE
?CND14: PRINT CYOUR
FSET? PRSO,MUNGED \?CND16
PRINTI "long, slender "
?CND16: PRINTR "fingers are still there."
?CCL13: EQUAL? PRSA,V?COUNT \?CCL19
PRINTI "You still have "
CALL NOUN-USED?,W?FINGERS,W?FINGER
ZERO? STACK /?CCL22
PRINTI "ten"
JUMP ?CND20
?CCL22: PRINTI "two"
?CND20: PRINTR " of them."
?CCL19: EQUAL? PRSA,V?LOOK-INSIDE,V?SEARCH \?CCL24
ICALL1 V-INVENTORY
RTRUE
?CCL24: EQUAL? PRSA,V?PUT,V?PUT-UNDER,V?PUT-BEHIND \?CCL26
ICALL PERFORM,V?REACH-IN,PRSI
RTRUE
?CCL26: EQUAL? PRSA,V?PUT-ON \?CCL28
ICALL PERFORM,V?TOUCH,PRSI
RTRUE
?CCL28: EQUAL? PRSA,V?SCRATCH \?CCL30
ZERO? MOSS-TIMER /?CND31
ICALL1 DO-MOSS
RTRUE
?CND31: PRINTI "Your hand isn't itchy"
PRINT AT-MOMENT
RTRUE
?CCL30: INTBL? PRSA,HAVEVERBS,NHAVES >X \FALSE
ICALL1 IMPOSSIBLE
RTRUE
.FUNCT FEET-F,X
ZERO? NOW-PRSI? /?CCL3
INTBL? PRSA,PUTVERBS,NUMPUTS >X \FALSE
ICALL1 WASTE-OF-TIME
RTRUE
?CCL3: EQUAL? PRSA,V?PUT-ON \?CCL7
ICALL PERFORM,V?STAND-ON,PRSI
RTRUE
?CCL7: INTBL? PRSA,HAVEVERBS,NHAVES >X \FALSE
ICALL1 IMPOSSIBLE
RTRUE
.FUNCT MOUTH-F,X
ZERO? NOW-PRSI? /?CCL3
EQUAL? PRSA,V?PUT,V?PUT-ON,V?THROW \?CCL6
ICALL PERFORM,V?EAT,PRSO
RTRUE
?CCL6: EQUAL? PRSA,V?TOUCH-TO \?CND1
ICALL PERFORM,V?TASTE,PRSO
RTRUE
?CCL3: EQUAL? PRSA,V?REACH-IN \?CCL9
PRINTR "How rude."
?CCL9: EQUAL? PRSA,V?OPEN,V?OPEN-WITH,V?CLOSE \?CCL11
ICALL1 NO-NEED
RTRUE
?CCL11: EQUAL? PRSA,V?RAPE,V?KICK,V?KISS \?CCL13
PRINTR "Good luck."
?CCL13: INTBL? PRSA,HAVEVERBS,NHAVES >X \?CND1
ICALL1 IMPOSSIBLE
RTRUE
?CND1: ICALL2 USELESS,MOUTH
RETURN 2
.FUNCT EYES-F,X
ZERO? NOW-PRSI? \?CND1
EQUAL? PRSA,V?OPEN \?CCL4
PRINTR "They are."
?CCL4: EQUAL? PRSA,V?CLOSE \?CCL6
EQUAL? LAST-MONSTER,DORN \?CCL9
FSET? LAST-MONSTER,MUNGED /?CCL9
PRINTI "Something about "
ICALL2 THE-PRINT,LAST-MONSTER
PRINTR "'s roving gaze forces your eyes to snap open."
?CCL9: ZERO? LAST-MONSTER /?CND7
PRINTI "That won't make "
ICALL2 THE-PRINT,LAST-MONSTER
PRINTR " go away."
?CND7: ICALL1 V-SLEEP
RTRUE
?CCL6: INTBL? PRSA,HAVEVERBS,NHAVES >X \?CND1
ICALL1 IMPOSSIBLE
RTRUE
?CND1: ICALL2 USELESS,EYES
RETURN 2
.FUNCT HEAD-F,X
ZERO? NOW-PRSI? /?CCL3
EQUAL? PRSA,V?PUT-ON \?CCL3
EQUAL? PRSO,HELM \?CND6
ICALL PERFORM,V?WEAR,PRSO
RTRUE
?CND6: ICALL1 WASTE-OF-TIME
RTRUE
?CCL3: INTBL? PRSA,HAVEVERBS,NHAVES >X \?CND1
ICALL1 IMPOSSIBLE
RTRUE
?CND1: ICALL2 USELESS,HEAD
RETURN 2
.FUNCT ME-F,CONTEXT,ANY,OBJ,NXT,X
ZERO? NOW-PRSI? /?CCL3
EQUAL? PRSA,V?THROW,V?THROW-OVER \?CCL6
ICALL1 WASTE-OF-TIME
RTRUE
?CCL6: EQUAL? PRSA,V?COVER \?CCL8
ICALL PERFORM,V?STAND-ON,PRSO
RTRUE
?CCL8: EQUAL? PRSA,V?PUT-ON,V?WRAP-AROUND \?CCL10
FSET? PRSO,CLOTHING \?CND11
ICALL PERFORM,V?WEAR,PRSO
RTRUE
?CND11: ICALL1 IMPOSSIBLE
RTRUE
?CCL10: EQUAL? PRSA,V?PUT \FALSE
ICALL PERFORM,V?TASTE,PRSO
RTRUE
?CCL3: EQUAL? PRSA,V?EXAMINE,V?LOOK-ON,V?SEARCH \?CCL15
PRINTI "You're "
FIRST? WINNER >OBJ /?PRG17
?PRG17: ZERO? OBJ /?REP18
NEXT? OBJ >NXT /?BOGUS21
?BOGUS21: FSET? OBJ,WORN \?CND22
SET 'ANY,TRUE-VALUE
MOVE OBJ,DUMMY-OBJECT
?CND22: SET 'OBJ,NXT
JUMP ?PRG17
?REP18: ZERO? ANY \?CND24
PRINTR "not wearing anything special."
?CND24: PRINTI "wearing "
ICALL2 CONTENTS,DUMMY-OBJECT
PRINT PERIOD
ICALL MOVE-ALL,DUMMY-OBJECT,WINNER
RTRUE
?CCL15: EQUAL? PRSA,V?NAME \?CCL27
PRINTI "You already have a name. It's "
ICALL2 PRINT-TABLE,CHARNAME
PRINT PERIOD
RETURN 2
?CCL27: EQUAL? PRSA,V?LISTEN,V?SMELL \?CCL31
PRINT CANT
PRINTR "help doing that."
?CCL31: EQUAL? PRSA,V?FIND,V?FOLLOW \?CCL33
PRINT STR?533
RTRUE
?CCL33: EQUAL? PRSA,V?RAPE,V?KISS \?CCL35
PRINTR "Desperate?"
?CCL35: EQUAL? PRSA,V?HIT \?CCL37
PRINTR "You're indispensable."
?CCL37: INTBL? PRSA,HURTVERBS,NHVERBS >X \?CCL39
PRINTI "Punishing "
EQUAL? WINNER,PLAYER \?CCL42
PRINTI "your"
JUMP ?CND40
?CCL42: FSET? WINNER,FEMALE \?CCL44
PRINTI "her"
JUMP ?CND40
?CCL44: FSET? WINNER,PERSON \?CCL46
PRINTI "him"
JUMP ?CND40
?CCL46: PRINTI "it"
?CND40: PRINTI "self that way"
ICALL1 WONT-HELP
RTRUE
?CCL39: CALL1 YOU-F
ZERO? STACK /FALSE
RTRUE
.FUNCT YOU-F,X
EQUAL? PRSA,V?WHO,V?WHAT,V?WHERE \?CCL3
PRINTR "Good question."
?CCL3: EQUAL? PRSA,V?UNDRESS \?CCL5
ICALL1 INAPPROPRIATE
RTRUE
?CCL5: EQUAL? PRSA,V?EAT,V?TASTE,V?DRINK /?CTR6
EQUAL? PRSA,V?DRINK-FROM /?CTR6
INTBL? PRSA,HAVEVERBS,NHAVES >X \FALSE
?CTR6: ICALL1 IMPOSSIBLE
RTRUE
.FUNCT INAPPROPRIATE
PRINTR "That would hardly be an appropriate thing to do."
.FUNCT WONT-HELP
PRINTR " isn't likely to help matters."
.FUNCT GLOBAL-ROOM-F,X
FSET? HERE,INDOORS \?CCL3
CALL NOUN-USED?,W?LANDSCAPE,W?HORIZON
ZERO? STACK /?CCL3
ICALL1 CANT-SEE-MUCH
RTRUE
?CCL3: EQUAL? PRSA,V?EXAMINE,V?LOOK-ON,V?LOOK-INSIDE \?CCL7
ICALL1 V-LOOK
RTRUE
?CCL7: INTBL? PRSA,E-VERBS,ENTER-VERBS >X /?CTR8
EQUAL? PRSA,V?DROP,V?EXIT \?CCL9
?CTR8: ICALL1 V-WALK-AROUND
RETURN 2
?CCL9: EQUAL? PRSA,V?WALK-AROUND \FALSE
PRINTI "Walking around the area reveals nothing new"
PRINT PTAB
PRINTI "[If you want to go somewhere, simply indicate a "
PRINTD INTDIR
PRINTR ".]"
.FUNCT CANT-SEE-ANY,THING,STRING?
ASSIGNED? 'THING /?CND1
SET 'THING,NOT-HERE-OBJECT
?CND1: SET 'CLOCK-WAIT?,TRUE-VALUE
ICALL1 PCLEAR
ICALL2 THIS-IS-IT,NOT-HERE-OBJECT
PRINT CANT
EQUAL? PRSA,V?LISTEN \?CCL5
PRINTB W?HEAR
JUMP ?CND3
?CCL5: EQUAL? PRSA,V?SMELL \?CCL7
PRINTB W?SMELL
JUMP ?CND3
?CCL7: PRINTB W?SEE
?CND3: PRINTC SP
ZERO? STRING? /?CCL10
PRINT THING
JUMP ?CND8
?CCL10: FSET? THING,PROPER \?CCL13
PRINT LTHE
JUMP ?CND11
?CCL13: FSET? THING,NOARTICLE /?CND11
PRINTI "any "
?CND11: ICALL2 DPRINT,THING
?CND8: PRINTR " here."
.FUNCT HOW?
PRINTR "A noble idea. How do you intend to do it?"
.FUNCT NOT-LIKELY,OBJ
ASSIGNED? 'OBJ /?CND1
SET 'OBJ,PRSO
?CND1: PRINTI "It"
CALL2 PICK-NEXT,LIKELIES
PRINT STACK
PRINTI " that "
ICALL2 THE-PRINT,OBJ
RTRUE
.FUNCT YOUD-HAVE-TO,STR,OBJ
ASSIGNED? 'OBJ /?CND1
SET 'OBJ,PRSO
?CND1: ICALL2 THIS-IS-IT,OBJ
EQUAL? WINNER,PLAYER \?CCL5
PRINTI "You'd "
JUMP ?CND3
?CCL5: ICALL2 CTHE-PRINT,WINNER
PRINTI " would "
?CND3: PRINTI "have to "
PRINT STR
PRINTC SP
ICALL2 THE-PRINT,OBJ
PRINTR " to do that."
.FUNCT GROUND-F,OBJ,NXT,X
EQUAL? HERE,IN-SKY \?CCL3
INTBL? PRSA,TOUCHVERBS,NTOUCHES >X \?CCL3
ICALL1 CANT-FROM-HERE
RTRUE
?CCL3: ZERO? NOW-PRSI? /?CCL7
EQUAL? PRSA,V?PUT-ON,V?PUT,V?THROW /?CTR9
EQUAL? PRSA,V?THROW-OVER \?CCL10
?CTR9: ICALL PERFORM,V?DROP,PRSO
RTRUE
?CCL10: EQUAL? PRSA,V?WRITE-ON \FALSE
EQUAL? PRSO,GLYPH,GGLYPH /?CND14
ICALL1 IMPOSSIBLE
RTRUE
?CND14: ICALL1 WRITE-GLYPH
RTRUE
?CCL7: EQUAL? PRSA,V?EXAMINE,V?LOOK-ON,V?SEARCH \?CCL17
FIRST? HERE >OBJ \?CND18
?PRG20: NEXT? OBJ >NXT /?BOGUS22
?BOGUS22: FSET? OBJ,NODESC /?CCL24
FSET? OBJ,TAKEABLE /?CND23
?CCL24: MOVE OBJ,C-OBJECT
?CND23: SET 'OBJ,NXT
ZERO? OBJ \?PRG20
?CND18: PRINT YOU-SEE
ICALL2 CONTENTS,HERE
PRINTI " on the "
ICALL1 GROUND-WORD
PRINT PERIOD
ICALL MOVE-ALL,C-OBJECT,HERE
RTRUE
?CCL17: EQUAL? PRSA,V?CROSS \?CCL30
ICALL1 V-WALK-AROUND
RTRUE
?CCL30: EQUAL? PRSA,V?LOOK-UNDER \?CCL32
PRINTR "Unfortunately, you left your X-ray glasses at home."
?CCL32: EQUAL? PRSA,V?DIG,V?DIG-UNDER \FALSE
PRINTI "You dig around with "
ICALL1 THEI-PRINT
ICALL1 BUT-FIND-NOTHING
RTRUE
.FUNCT FLOOR-F,X
FSET? HERE,INDOORS /?CND1
ICALL2 CANT-SEE-ANY,FLOOR
RETURN 2
?CND1: GETB CAVE-ROOMS,0 >X
INTBL? HERE,CAVE-ROOMS+1,X,1 >X /?CND5
EQUAL? HERE,IN-LAIR,NE-CAVE,SE-CAVE /?CND5
EQUAL? PRSA,V?DIG,V?DIG-UNDER \?CND5
PRINT CANT
PRINTR "do that here."
?CND5: CALL1 GROUND-F
RSTACK
.FUNCT NO-NEED
PRINT DONT
PRINTR "need to do that."
.FUNCT NOT-IN,THING
ASSIGNED? 'THING /?CND1
SET 'THING,PRSO
?CND1: ICALL2 THIS-IS-IT,THING
PRINTI "You're not in "
ICALL2 THE-PRINT,THING
PRINT PERIOD
RTRUE
.FUNCT NOT-ON,THING
ASSIGNED? 'THING /?CND1
SET 'THING,PRSO
?CND1: ICALL2 THIS-IS-IT,THING
PRINTI "You're not on "
ICALL2 THE-PRINT,THING
PRINT PERIOD
RTRUE
.FUNCT ALREADY-IN,THING
ASSIGNED? 'THING /?CND1
SET 'THING,PRSO
?CND1: ICALL2 THIS-IS-IT,THING
PRINT ALREADY
PRINTI "in "
ICALL2 THE-PRINT,THING
PRINT PERIOD
RTRUE
.FUNCT ALREADY-ON,THING
ASSIGNED? 'THING /?CND1
SET 'THING,PRSO
?CND1: ICALL2 THIS-IS-IT,THING
PRINT ALREADY
PRINTI "on "
ICALL2 THE-PRINT,THING
PRINT PERIOD
RTRUE
.FUNCT ALREADY-AT-TOP,OBJ
ASSIGNED? 'OBJ /?CND1
SET 'OBJ,PRSO
?CND1: ICALL ALREADY-AT,STR?859,OBJ
RTRUE
.FUNCT ALREADY-AT-BOTTOM,OBJ
ASSIGNED? 'OBJ /?CND1
SET 'OBJ,PRSO
?CND1: ICALL ALREADY-AT,STR?860,OBJ
RTRUE
.FUNCT ALREADY-AT,STR,OBJ
ASSIGNED? 'OBJ /?CND1
SET 'OBJ,PRSO
?CND1: ICALL2 THIS-IS-IT,OBJ
PRINT ALREADY
PRINTI "at the "
PRINT STR
PRINTI " of "
ICALL2 THE-PRINT,OBJ
PRINT PERIOD
RTRUE
.FUNCT CANT-SEE-MUCH
PRINT STR?760
PRINTR "from here."
.FUNCT NOT-A,STR
PRINTI "You're an adventurer, not a "
PRINT STR
PRINT PERIOD
RTRUE
.FUNCT OPEN-CLOSED,THING,VOWEL
ASSIGNED? 'THING /?CND1
SET 'THING,PRSO
?CND1: FSET? THING,OPENED \?CCL5
ZERO? VOWEL /?CND6
PRINTC 110
?CND6: PRINTI " open "
JUMP ?CND3
?CCL5: PRINTI " closed "
?CND3: ICALL2 DPRINT,THING
RTRUE
.FUNCT CANT-FROM-HERE
PRINT IMPOSSIBLY
PRINTI "do that"
ICALL1 STANDING
RTRUE
.FUNCT STANDING,X
ASSIGNED? 'X /?CND1
PRINTI " from where you're "
?CND1: LOC PLAYER
EQUAL? STACK,SADDLE,PEW \?CCL5
PRINTI "sitt"
JUMP ?CND3
?CCL5: PRINTB W?STAND
?CND3: PRINTI "ing"
ASSIGNED? 'X /TRUE
PRINT PERIOD
RTRUE
.FUNCT IS-ARE,THING
ASSIGNED? 'THING /?CND1
SET 'THING,PRSO
?CND1: PRINTC SP
FSET? THING,PLURAL \?CND3
PRINTI "are "
RTRUE
?CND3: PRINTI "is "
RTRUE
.FUNCT ISNT-ARENT,THING
ASSIGNED? 'THING /?CND1
SET 'THING,PRSO
?CND1: PRINTC SP
FSET? THING,PLURAL \?CCL5
PRINTI "are"
JUMP ?CND3
?CCL5: PRINTI "is"
?CND3: PRINTI "n't"
RTRUE
.FUNCT FIRMLY-ATTACHED,THING,TO,STR
ZERO? STR \?CCL3
ICALL2 THIS-IS-IT,THING
ICALL2 CTHE-PRINT,THING
ICALL2 IS-ARE,THING
JUMP ?CND1
?CCL3: ICALL2 THIS-IS-IT,TO
PRINT XTHE
PRINT THING
PRINT SIS
?CND1: CALL2 PICK-NEXT,FIRMS
PRINT STACK
PRINTI "ly "
CALL2 PICK-NEXT,ATTACHES
PRINT STACK
PRINT STO
ICALL2 THE-PRINT,TO
PRINT PERIOD
RTRUE
.FUNCT HERE-F,X
ZERO? NOW-PRSI? /?CCL3
INTBL? PRSA,PUTVERBS,NUMPUTS >X \FALSE
ICALL PERFORM,V?DROP,PRSO
RTRUE
?CCL3: EQUAL? PRSA,V?EXAMINE,V?LOOK-ON,V?LOOK-INSIDE /?CTR6
EQUAL? PRSA,V?SEARCH \?CCL7
?CTR6: ICALL1 V-LOOK
RTRUE
?CCL7: EQUAL? PRSA,V?LOOK-BEHIND,V?LOOK-OUTSIDE \?CCL11
ICALL1 CANT-SEE-MUCH
RTRUE
?CCL11: EQUAL? PRSA,V?ENTER,V?WALK-TO,V?FIND \?CCL13
ICALL1 ALREADY-IN
RTRUE
?CCL13: INTBL? PRSA,E-VERBS,CLIMB-ON-VERBS >X /?CTR14
INTBL? PRSA,X-VERBS,CLIMB-DOWN-VERBS >X \FALSE
?CTR14: ICALL1 V-WALK-AROUND
RTRUE
.FUNCT GLOBAL-HOLE-F
EQUAL? PRSA,V?DIG,V?SDIG \?CND1
ICALL1 WASTE-OF-TIME
RTRUE
?CND1: PRINT CANT
PRINTR "see any here."
.FUNCT SOUND-F,X
GETP HERE,P?HEAR >X
ZERO? X /?CCL3
ZERO? NOW-PRSI? \?CND4
ICALL PERFORM,PRSA,X,PRSI
RTRUE
?CND4: ICALL PERFORM,PRSA,PRSO,X
RTRUE
?CCL3: INTBL? PRSA,SEEVERBS,NSVERBS >X /?CTR6
INTBL? PRSA,TOUCHVERBS,NTOUCHES >X \FALSE
?CTR6: ICALL1 IMPOSSIBLE
RTRUE
.FUNCT GCORNER-F,X
FSET? HERE,INDOORS /?CCL3
ICALL2 CANT-SEE-ANY,GCORNER
RETURN 2
?CCL3: ZERO? NOW-PRSI? /?CCL7
INTBL? PRSA,PUTVERBS,NUMPUTS >X \FALSE
ICALL PERFORM,V?DROP,PRSO
RTRUE
?CCL7: EQUAL? PRSA,V?EXAMINE,V?LOOK-INSIDE,V?LOOK-ON /?CTR10
EQUAL? PRSA,V?SEARCH,V?LOOK-BEHIND,V?LOOK-UNDER \?CCL11
?CTR10: ICALL1 V-LOOK
RTRUE
?CCL11: INTBL? PRSA,E-VERBS,ENTER-VERBS >X \?CCL15
PRINT ALREADY
PRINTI "close enough to "
ICALL1 THE-PRINT
PRINT PERIOD
RTRUE
?CCL15: INTBL? PRSA,X-VERBS,EXIT-VERBS >X \FALSE
ICALL1 V-WALK-AROUND
RTRUE
.FUNCT RL-F,X
ZERO? NOW-PRSI? \FALSE
INTBL? PRSA,E-VERBS,CLIMB-ON-VERBS >X /?CTR4
INTBL? PRSA,X-VERBS,CLIMB-DOWN-VERBS >X \FALSE
?CTR4: ICALL1 V-WALK-AROUND
RTRUE
.FUNCT GAME-F
EQUAL? PRSA,V?TOUCH,V?READ,V?EXAMINE \?CND1
PRINTI "[That's what you're doing.]"
CRLF
RETURN 2
?CND1: ICALL2 USELESS,GAME
RETURN 2
.FUNCT READ-YES-LEXV,KEY
COPYT YES-LEXV,0,YES-LEXV-LENGTH
PUTB YES-LEXV,0,2
COPYT YES-INBUF,0,YES-INBUF-LENGTH
PUTB YES-INBUF,0,12
?PRG1: COLOR INCOLOR,BGND
READ YES-INBUF,YES-LEXV >KEY
EQUAL? KEY,EOL,LF \?PRG1
COLOR FORE,BGND
RFALSE
.FUNCT YES-WORD?,WORD
ZERO? WORD /FALSE
EQUAL? WORD,W?Y,W?YES,W?YUP /TRUE
EQUAL? WORD,W?OKAY,W?OK,W?SURE /TRUE
RFALSE
.FUNCT NO-WORD?,WORD
ZERO? WORD /FALSE
EQUAL? WORD,W?N,W?NO,W?NOPE /TRUE
EQUAL? WORD,W?NEGATIVE,W?NAY /TRUE
RFALSE
.FUNCT YES?,WORD,TBL
COLOR FORE,BGND
CRLF
?PRG1: CRLF
PRINTI "[Please type YES or NO.] >"
ICALL1 READ-YES-LEXV
GETB YES-LEXV,P-LEXWORDS
ZERO? STACK /?PRG1
GET YES-LEXV,P-LEXSTART >WORD
ZERO? WORD /?PRG1
CALL2 YES-WORD?,WORD
ZERO? STACK \TRUE
CALL2 NO-WORD?,WORD
ZERO? STACK /?PRG1
RFALSE
.FUNCT STARTUP,X,TBL,CNT
GETB VOCAB,0
ADD STACK,2
COPYT VOCAB,VOCAB2,STACK
ICALL1 DEFAULT-SOFTS
GET MACHINE-COLORS,HOST >TBL
ZERO? TBL /?CND1
GET TBL,1 >TBL
GETB TBL,0 >BGND
GETB TBL,1 >FORE
GETB TBL,2 >INCOLOR
GETB TBL,3 >GCOLOR
?CND1: EQUAL? HOST,DEC-20 \?CND3
CLEAR -1
CRLF
PRINTI "Is this a VT220?"
CALL1 YES?
ZERO? STACK \?CND3
SET 'VT100,TRUE-VALUE
ICALL1 SETUP-APPLE-MODE
?CND3: COLOR FORE,BGND
CLEAR -1
CRLF
PRINT STR?573
CRLF
PRINT STR?861
PRINTI "begin a new game, restore a saved game, or quit?"
CRLF
CRLF
?PRG7: COLOR FORE,BGND
PRINTI "[Type BEGIN, RESTORE or QUIT.] >"
ICALL1 READ-YES-LEXV
GETB YES-LEXV,P-LEXWORDS
ZERO? STACK /?PRG7
GET YES-LEXV,P-LEXSTART >X
ZERO? X /?PRG7
EQUAL? X,W?BEGIN,W?B,W?RESTART \?CCL15
ICALL1 PROLOGUE
CLEAR -1
RTRUE
?CCL15: EQUAL? X,W?RESTORE \?CCL17
ICALL1 V-RESTORE
CRLF
JUMP ?PRG7
?CCL17: EQUAL? X,W?Q,W?QUIT \?PRG7
CRLF
QUIT
RFALSE
.FUNCT SHOW-MENU-ITEM,LINE,INV,X
ADD LINE,7
ICALL CENTER,STACK,35
COLOR GCOLOR,BGND
HLIGHT H-NORMAL
ZERO? INV /?CND1
ZERO? COLORS? /?CCL5
EQUAL? FORE,GCOLOR /?CCL5
COLOR FORE,BGND
JUMP ?CND1
?CCL5: HLIGHT H-INVERSE
?CND1: GET MENU-LIST,LINE
PRINT STACK
RFALSE
.FUNCT SETUP-CHARACTER,LAST,X,STAT
PUTB DBOX,0,SP
COPYT DBOX,DBOX+1,-1551
?PRG1: COLOR FORE,BGND
CLEAR -1
SPLIT 14
FSET? PLAYER,NAMED \?CND3
ICALL2 SHOW-RANK,WIDTH
?CND3: ICALL1 TO-TOP-WINDOW
COLOR FORE,BGND
ICALL CENTER,5,15
PRINTI "Character Setup"
SET 'STAT,0
?PRG5: ICALL2 SHOW-MENU-ITEM,STAT
IGRTR? 'STAT,4 \?PRG5
ICALL1 USE-ARROWS
PRINT STR?862
SET 'STAT,LAST
?PRG9: ICALL1 TO-TOP-WINDOW
ICALL SHOW-MENU-ITEM,STAT,1
ICALL1 TO-BOTTOM-WINDOW
CALL1 DO-INPUT >X
EQUAL? X,DOWN-ARROW,SP,UP-ARROW \?CCL13
ICALL1 TO-TOP-WINDOW
ICALL2 SHOW-MENU-ITEM,STAT
EQUAL? X,UP-ARROW \?CND14
DLESS? 'STAT,0 \?PRG9
SET 'STAT,4
JUMP ?PRG9
?CND14: IGRTR? 'STAT,4 \?PRG9
SET 'STAT,0
JUMP ?PRG9
?CCL13: EQUAL? X,EOL,LF \?CND11
ZERO? STAT \?CCL23
ICALL1 QUICK-SETUP
JUMP ?REP10
?CCL23: EQUAL? STAT,1 \?CCL25
ICALL1 PICK-A-CHAR
JUMP ?REP10
?CCL25: EQUAL? STAT,2 \?CCL27
ICALL1 ROLL-YOUR-OWN
JUMP ?REP10
?CCL27: EQUAL? STAT,3 \?CND21
ICALL1 MANUAL
CRLF
ZERO? POTENTIAL /?REP10
CRLF
PRINTI "Your unused Potential has been evenly distributed."
CRLF
?REP10: ICALL1 TO-BOTTOM-WINDOW
CRLF
ZERO? STAT /?REP2
SET 'LAST,STAT
PRINT STR?863
PRINTI "these are the attributes you want?"
CALL1 YES?
ZERO? STACK /?PRG1
ICALL1 GET-SEX
ICALL1 GET-NAME
FSET PLAYER,NAMED
ICALL2 SHOW-RANK,WIDTH
PRINT STR?863
ICALL2 PRINT-TABLE,CHARNAME
PRINTI " is the character you want?"
CALL1 YES?
ZERO? STACK /?PRG1
?REP2: SET 'SAY-STAT,TRUE-VALUE
COPYT STATS,MAXSTATS,16
ZERO? STAT /?CND37
PRINT STR?861
PRINTI "save this character before you proceed?"
CALL1 YES?
ZERO? STACK /?CND37
PUTB OOPS-INBUF,1,0
SAVE >X
ZERO? X \?CCL43
ICALL2 FAILED,STR?567
JUMP ?CND37
?CND21: CRLF
CRLF
ICALL1 V-QUIT
ICALL1 TO-TOP-WINDOW
ICALL2 SHOW-MENU-ITEM,STAT
ICALL1 USE-ARROWS
PRINT STR?862
SET 'STAT,0
JUMP ?PRG9
?CND11: SOUND 2
JUMP ?PRG9
?CCL43: EQUAL? X,1 \?CCL45
ICALL2 COMPLETED,STR?567
?CND37: SET 'CHECKSUM,0
SET 'STAT,ENDURANCE
?PRG46: GET STATS,STAT
ADD CHECKSUM,STACK >CHECKSUM
IGRTR? 'STAT,LUCK \?PRG46
GRTR? CHECKSUM,66 \?CND50
ICALL1 CHEATER
RFALSE
?CCL45: ICALL1 INITVARS
RFALSE
?CND50: CRLF
PRINTI "Press any key to begin the story. >"
INPUT 1 >X
RFALSE
.FUNCT QUICK-SETUP
GET CSTATS,0
COPYT STACK,STATS,12
COPYT DEFAULT-NAME,CHARNAME,DEFAULT-NAME-LENGTH
FSET PLAYER,NAMED
FCLEAR PLAYER,FEMALE
ICALL2 SHOW-RANK,WIDTH
RFALSE
.FUNCT SETUP-TOP,NOCLEAR,STAT
CLEAR S-WINDOW
PUT STATS,EXPERIENCE,BEGINNERS-EXPERIENCE
FSET? PLAYER,NAMED \?CND1
ICALL2 SHOW-RANK,WIDTH
?CND1: ZERO? VT220 \?CCL5
ICALL1 APPLE-BARS
JUMP ?CND3
?CCL5: SUB WIDTH,BARWIDTH
DIV STACK,2
SUB STACK,1
ICALL STATBARS,3,STACK,LUCK
?CND3: SET 'IN-DBOX,SHOWING-STATS
RFALSE
.FUNCT APPLE-BARS,Y,X,STAT
ASSIGNED? 'Y /?CND1
SET 'Y,4
?CND1: SET 'BARY,Y
ASSIGNED? 'X /?CND3
SUB WIDTH,18
DIV STACK,2 >X
?CND3: SET 'BARX,X
ICALL1 TO-TOP-WINDOW
SUB BARX,1
CURSET 3,STACK
HLIGHT H-INVERSE
PRINTT DBOX,APPBOX,8
CURSET BARY,BARX
PRINTT BAR-LABELS,LABEL-WIDTH,ARMOR-CLASS
?PRG5: GET STATS,STAT
ICALL BAR-NUMBER,STAT,STACK
IGRTR? 'STAT,LUCK \?PRG5
ICALL1 TO-BOTTOM-WINDOW
RFALSE
.FUNCT PICK-A-CHAR,CHAR,LMARGIN,NX,NY,NTBL,X
CLEAR S-WINDOW
FSET? PLAYER,NAMED \?CND1
ICALL2 SHOW-RANK,WIDTH
?CND1: SET 'X,BARWIDTH
ZERO? VT220 \?CND3
SET 'X,APPBOX
?CND3: ADD BARMAR,X
SUB WIDTH,STACK
DIV STACK,2 >NX
SUB NX,1 >LMARGIN
SET 'IN-DBOX,SHOWING-STATS
ICALL1 TO-TOP-WINDOW
ZERO? VT220 \?PRG7
COLOR FORE,BGND
ICALL DO-CURSET,3,LMARGIN
HLIGHT H-INVERSE
PRINTT DBOX,9,8
?PRG7: ADD CHAR,4
ICALL DO-CURSET,STACK,NX
GET CNAMES,CHAR
PRINT STACK
IGRTR? 'CHAR,5 \?PRG7
GET CSTATS,0
COPYT STACK,STATS,12
ADD LMARGIN,BARMAR
ADD STACK,1 >X
ZERO? VT220 \?CCL13
ICALL APPLE-BARS,4,X
JUMP ?CND11
?CCL13: ICALL STATBARS,4,X,LUCK
?CND11: ICALL1 USE-ARROWS
PRINTI "select the character you want"
ICALL1 PRESS-RETURN
ICALL1 TO-TOP-WINDOW
SET 'CHAR,0
?PRG14: ADD CHAR,4 >NY
GET CNAMES,CHAR >NTBL
ICALL DO-CURSET,NY,NX
COLOR FORE,BGND
ZERO? VT220 \?CCL18
HLIGHT H-NORMAL
JUMP ?CND16
?CCL18: ZERO? COLORS? /?CCL19
EQUAL? FORE,GCOLOR \?CND16
?CCL19: HLIGHT H-INVERSE
?CND16: HLIGHT H-MONO
PRINT NTBL
GET CSTATS,CHAR
COPYT STACK,STATS,12
HLIGHT H-NORMAL
SET 'X,ENDURANCE
?PRG22: GET STATS,X
ICALL STAT-ROUTINE,X,STACK
IGRTR? 'X,LUCK \?PRG22
ICALL1 TO-BOTTOM-WINDOW
?PRG26: CALL1 DO-INPUT >X
EQUAL? X,EOL,LF \?CCL30
ICALL1 SETUP-TOP
RFALSE
?CCL30: EQUAL? X,DOWN-ARROW,SP,UP-ARROW \?CND28
ICALL1 TO-TOP-WINDOW
ICALL DO-CURSET,NY,NX
COLOR FORE,BGND
ZERO? VT220 \?CCL34
HLIGHT H-INVERSE
JUMP ?CND32
?CCL34: HLIGHT H-NORMAL
ZERO? COLORS? /?CND32
COLOR GCOLOR,BGND
?CND32: HLIGHT H-MONO
PRINT NTBL
EQUAL? X,UP-ARROW /?CND37
IGRTR? 'CHAR,5 \?PRG14
SET 'CHAR,0
JUMP ?PRG14
?CND37: DLESS? 'CHAR,0 \?PRG14
SET 'CHAR,5
JUMP ?PRG14
?CND28: SOUND S-BOOP
JUMP ?PRG26
.FUNCT USE-ARROWS,X
ICALL1 TO-BOTTOM-WINDOW
CRLF
CRLF
PRINTI "Use the "
EQUAL? HOST,MACINTOSH \?CCL3
PRINTI "[SPACE] bar to "
RFALSE
?CCL3: ZERO? VT220 /?CCL5
FONT F-NEWFONT >X
PRINTC 92
JUMP ?CND1
?CCL5: EQUAL? HOST,IBM \?CCL7
PRINTC 24
JUMP ?CND1
?CCL7: EQUAL? HOST,APPLE-2C \?CCL9
FONT F-NEWFONT >X
PRINTC 75
JUMP ?CND1
?CCL9: PRINTI "UP"
?CND1: FONT F-DEFAULT >X
PRINT AND
ZERO? VT220 /?CCL12
FONT F-NEWFONT >X
PRINTC 93
JUMP ?CND10
?CCL12: EQUAL? HOST,IBM \?CCL14
PRINTC 25
JUMP ?CND10
?CCL14: EQUAL? HOST,APPLE-2C \?CCL16
FONT F-NEWFONT >X
PRINTC 74
JUMP ?CND10
?CCL16: PRINTI "DOWN arrow"
?CND10: FONT F-DEFAULT >X
PRINTI " keys to "
RFALSE
.FUNCT PRESS-RETURN
PRINT PERIOD
CRLF
PRINTI "Press [RETURN] when you're finished. >"
RTRUE
.FUNCT MANUAL,A,OA,X,NX,Y,Z,BX,OBX,OP,KEY,TBL
SET 'A,ENDURANCE
?PRG1: PUT STATS,A,1
IGRTR? 'A,ARMOR-CLASS \?PRG1
ICALL1 SETUP-TOP
SET 'POTENTIAL,INIT-POTENTIAL
ICALL1 TO-TOP-WINDOW
ADD BARY,7 >Y
ZERO? VT220 \?CCL7
SUB BARX,1
CURSET Y,STACK
HLIGHT H-INVERSE
PRINTT DBOX,APPBOX,2
CURSET Y,BARX
PRINTI " Potential"
ICALL BAR-NUMBER,7,POTENTIAL
JUMP ?CND5
?CCL7: ADD BARY,ARMOR-CLASS
ICALL DO-CURSET,STACK,BARX
PRINTT DBOX,BARWIDTH
ICALL DO-CURSET,Y,BARX
COLOR FORE,BGND
PRINTI " Potential"
ICALL RAWBAR,7,POTENTIAL
?CND5: ICALL1 USE-ARROWS
PRINTI "select an attribute. Then use the "
EQUAL? HOST,MACINTOSH \?CCL10
PRINTC 43
JUMP ?CND8
?CCL10: ZERO? VT220 /?CCL12
FONT F-NEWFONT >Z
PRINTC 33
JUMP ?CND8
?CCL12: EQUAL? HOST,IBM \?CCL14
PRINTC 27
JUMP ?CND8
?CCL14: EQUAL? HOST,APPLE-2C \?CCL16
FONT F-NEWFONT >Z
PRINTC 72
JUMP ?CND8
?CCL16: PRINTI "LEFT"
?CND8: FONT F-DEFAULT >Z
PRINT AND
EQUAL? HOST,MACINTOSH \?CCL19
PRINTC 45
JUMP ?CND17
?CCL19: ZERO? VT220 /?CCL21
FONT F-NEWFONT >Z
PRINTC 34
JUMP ?CND17
?CCL21: EQUAL? HOST,IBM \?CCL23
PRINTC 26
JUMP ?CND17
?CCL23: EQUAL? HOST,APPLE-2C \?CCL25
FONT F-NEWFONT >Z
PRINTC 85
JUMP ?CND17
?CCL25: PRINTI "RIGHT arrow"
?CND17: FONT F-DEFAULT >Z
PRINTI " keys to adjust that attribute"
ICALL1 PRESS-RETURN
SET 'OP,-1
SET 'OA,-1
SET 'A,ENDURANCE
?PRG26: ICALL1 TO-TOP-WINDOW
MUL A,LABEL-WIDTH
ADD BAR-LABELS,STACK >TBL
EQUAL? A,OA /?CND28
SET 'OA,A
ADD BARY,A
ICALL DO-CURSET,STACK,BARX
COLOR FORE,BGND
ZERO? VT220 /?CND30
HLIGHT H-INVERSE
?CND30: PRINTT TBL,LABEL-WIDTH
HLIGHT H-NORMAL
HLIGHT H-MONO
COLOR GCOLOR,BGND
?CND28: EQUAL? OP,POTENTIAL /?CND32
ICALL STAT-ROUTINE,7,POTENTIAL
SET 'OP,POTENTIAL
?CND32: ICALL1 TO-BOTTOM-WINDOW
CALL1 DO-INPUT >KEY
EQUAL? KEY,EOL,LF /?REP27
ICALL1 TO-TOP-WINDOW
EQUAL? KEY,UP-ARROW,DOWN-ARROW,SP \?CCL38
ADD BARY,A
ICALL DO-CURSET,STACK,BARX
COLOR FORE,BGND
ZERO? VT220 \?CND39
HLIGHT H-INVERSE
?CND39: PRINTT TBL,LABEL-WIDTH
HLIGHT H-NORMAL
HLIGHT H-MONO
COLOR GCOLOR,BGND
EQUAL? KEY,UP-ARROW \?CND41
DLESS? 'A,ENDURANCE \?PRG26
SET 'A,LUCK
JUMP ?PRG26
?CND41: IGRTR? 'A,LUCK \?PRG26
SET 'A,ENDURANCE
JUMP ?PRG26
?CCL38: EQUAL? KEY,LEFT-ARROW,45,95 \?CCL48
EQUAL? POTENTIAL,INIT-POTENTIAL /?CCL48
GET STATS,A >X
GRTR? X,1 \?CND36
INC 'POTENTIAL
SUB X,1 >NX
PUT STATS,A,NX
ICALL STAT-ROUTINE,A,NX
JUMP ?PRG26
?CCL48: ZERO? POTENTIAL /?CND36
EQUAL? KEY,RIGHT-ARROW,43,61 \?CND36
DEC 'POTENTIAL
GET STATS,A >X
ADD X,1 >NX
PUT STATS,A,NX
ICALL STAT-ROUTINE,A,NX
JUMP ?PRG26
?CND36: SOUND 2
JUMP ?PRG26
?REP27: ICALL1 TO-TOP-WINDOW
ICALL1 FUDGE-STATS
COPYT STATS,MAXSTATS,16
SET 'A,ENDURANCE
?PRG55: GET STATS,A
ICALL STAT-ROUTINE,A,STACK
IGRTR? 'A,LUCK \?PRG55
ZERO? VT220 \?CCL61
SUB BARX,1
ICALL DO-CURSET,Y,STACK
PRINTT DBOX,18,2
HLIGHT H-INVERSE
JUMP ?CND59
?CCL61: ICALL DO-CURSET,Y,BARX
HLIGHT H-NORMAL
HLIGHT H-MONO
PRINTT DBOX,BARWIDTH
COLOR FORE,BGND
?CND59: ICALL DO-CURSET,BARY,BARX
PRINTT BAR-LABELS,LABEL-WIDTH,ARMOR-CLASS
ICALL1 TO-BOTTOM-WINDOW
RFALSE
.FUNCT ROLL-YOUR-OWN,STAT,XSTAT,OLD,DELTA,STAT-ORDER,X
SET 'STAT,ENDURANCE
?PRG1: PUT STATS,STAT,1
IGRTR? 'STAT,ARMOR-CLASS \?PRG1
ICALL1 SETUP-TOP
ICALL1 TO-BOTTOM-WINDOW
CRLF
CRLF
PRINTI "A new set of attributes will appear each time you press the [SPACE] bar."
CRLF
CRLF
PRINTI "Press [RETURN] to select a set that you like. >"
PUT AUX-TABLE,0,7
ADD AUX-TABLE,4 >STAT-ORDER
SET 'STAT,ENDURANCE
?PRG5: PUT STAT-ORDER,STAT,STAT
IGRTR? 'STAT,LUCK \?PRG5
ADD AUX-TABLE,20 >STAT-ORDER
?PRG9: ICALL1 TO-TOP-WINDOW
PUT AUX-TABLE,1,0
SET 'STAT,ENDURANCE
?PRG11: CALL2 PICK-ONE,AUX-TABLE
PUTB STAT-ORDER,STAT,STACK
IGRTR? 'STAT,LUCK \?PRG11
SET 'POTENTIAL,66
SET 'STAT,ENDURANCE
?PRG15: GETB STAT-ORDER,STAT >XSTAT
SET 'DELTA,1
ZERO? POTENTIAL /?CND17
RANDOM 11 >DELTA
DEC 'DELTA
SUB SPREAD,DELTA
ADD AVERAGE,STACK >DELTA
GRTR? DELTA,POTENTIAL \?CND19
SET 'DELTA,POTENTIAL
?CND19: SUB POTENTIAL,DELTA >POTENTIAL
?CND17: PUT STATS,XSTAT,DELTA
IGRTR? 'STAT,LUCK \?PRG15
ICALL1 FUDGE-STATS
SET 'STAT,ENDURANCE
?PRG23: GET STATS,STAT
ICALL STAT-ROUTINE,STAT,STACK
IGRTR? 'STAT,LUCK \?PRG23
ICALL1 TO-BOTTOM-WINDOW
?PRG27: INPUT 1 >X
EQUAL? X,EOL,LF /FALSE
EQUAL? X,SP /?PRG9
SOUND S-BOOP
JUMP ?PRG27
.FUNCT FUDGE-STATS,TOTAL,STAT
ZERO? POTENTIAL /FALSE
SET 'TOTAL,POTENTIAL
?PRG3: GET STATS,STAT
ADD STACK,1
PUT STATS,STAT,STACK
DLESS? 'TOTAL,1 /FALSE
IGRTR? 'STAT,LUCK \?PRG3
SET 'STAT,ENDURANCE
JUMP ?PRG3
.FUNCT GET-NAME,CNT,PTR,APO,DASH,BAD,ANY,CAP,SPACE,LEN,X,CHAR
FSET? PLAYER,NAMED /?CND1
COPYT DEFAULT-NAME,CHARNAME,DEFAULT-NAME-LENGTH
?CND1: CRLF
PRINTI "Finally, you must select a Name for your character.
By what Name shall your character be known?"
?PRG3: COPYT P-INBUF,0,P-INBUF-LENGTH
PUTB P-INBUF,0,80
CRLF
CRLF
PRINTI "[The default is """
ICALL2 PRINT-TABLE,CHARNAME
PRINTI ".""] >"
?PRG5: COLOR INCOLOR,BGND
READ P-INBUF,0 >X
EQUAL? X,EOL,LF /?REP6
SOUND 2
JUMP ?PRG5
?REP6: COLOR FORE,BGND
GETB P-INBUF,1 >LEN
ZERO? LEN /?REP4
ADD LEN,1 >X
SET 'PTR,2
SET 'APO,0
SET 'DASH,0
SET 'BAD,0
SET 'ANY,0
?PRG11: GETB P-INBUF,PTR >CHAR
GRTR? CHAR,96 \?CCL15
LESS? CHAR,123 \?CCL15
INC 'ANY
JUMP ?CND13
?CCL15: EQUAL? CHAR,SP /?CND13
EQUAL? CHAR,39 \?CCL20
INC 'APO
JUMP ?CND13
?CCL20: EQUAL? CHAR,45 \?CCL22
INC 'DASH
?CND13: IGRTR? 'PTR,X \?PRG11
?REP12: ZERO? ANY /?CTR26
ZERO? BAD \?CTR26
GRTR? APO,1 /?CTR26
GRTR? DASH,1 \?CCL27
?CTR26: ICALL2 BAD-NAME,STR?864
JUMP ?PRG3
?CCL22: INC 'BAD
JUMP ?REP12
?CCL27: GRTR? LEN,CHARNAME-LENGTH \?CND25
ICALL2 BAD-NAME,STR?552
JUMP ?PRG3
?CND25: COPYT CHARNAME,0,25
SET 'CNT,0
SET 'PTR,2
SET 'CAP,1
SET 'SPACE,0
SET 'ANY,0
?PRG33: GETB P-INBUF,PTR >CHAR
EQUAL? CHAR,SP \?CCL37
INC 'CAP
INC 'SPACE
ZERO? ANY /?CND35
EQUAL? SPACE,1 \?CND35
INC 'CNT
PUTB CHARNAME,CNT,SP
JUMP ?CND35
?CCL37: INC 'ANY
SET 'SPACE,0
EQUAL? CHAR,39,45 \?CCL44
INC 'CAP
JUMP ?CND42
?CCL44: ZERO? CAP /?CND42
SET 'CAP,0
SUB CHAR,SP >CHAR
?CND42: INC 'CNT
PUTB CHARNAME,CNT,CHAR
?CND35: IGRTR? 'PTR,X \?PRG33
PUTB CHARNAME,0,CNT
CRLF
PRINTI "Is """
ICALL2 PRINT-TABLE,CHARNAME
PRINTI """ correct?"
CALL1 YES?
ZERO? STACK \?REP4
ICALL2 BAD-NAME,STR?865
JUMP ?PRG3
?REP4: FSET PLAYER,NAMED
ICALL2 SHOW-RANK,WIDTH
RFALSE
.FUNCT BAD-NAME,STR
CRLF
PRINTI "That name is "
PRINT STR
PRINTI ". Please supply another."
RFALSE
.FUNCT GET-SEX,WORD
CRLF
PRINTI "Shall your character be male or female?"
?PRG1: CRLF
CRLF
PRINTI "[The default is "
FSET? PLAYER,FEMALE \?CND3
PRINTI "FE"
?CND3: PRINTI "MALE.] >"
ICALL1 READ-YES-LEXV
GETB YES-LEXV,P-LEXWORDS
ZERO? STACK /TRUE
GET YES-LEXV,P-LEXSTART >WORD
EQUAL? WORD,W?M,W?MALE,W?MAN /FALSE
EQUAL? WORD,W?F,W?FEMALE,W?WOMAN \?CND7
FSET PLAYER,FEMALE
RFALSE
?CND7: CRLF
PRINTI "[Please type MALE or FEMALE.]"
JUMP ?PRG1
.FUNCT WAY-TO-TALK
ICALL1 PCLEAR
LOC RIDDLE
EQUAL? HERE,STACK \?CND1
PRINT STR?512
CRLF
RTRUE
?CND1: ICALL2 SEE-MANUAL,STR?866
RTRUE
.FUNCT NOT-AVAILABLE
ICALL1 NYMPH-APPEARS
PRINTI "Sorry, that feature isn't available. Consult your "
ICALL2 ITALICIZE,STR?867
PRINTI " manual for more information"
PRINT STR?515
RTRUE
.FUNCT USELESS,THING,STRING
ICALL1 NYMPH-APPEARS
PRINT DONT
PRINTI "need to refer to "
ASSIGNED? 'STRING \?CCL3
PRINT LTHE
PRINT THING
JUMP ?CND1
?CCL3: ASSIGNED? 'THING \?CCL5
ICALL2 THE-PRINT,THING
JUMP ?CND1
?CCL5: PRINTD PSEUDO-OBJECT
?CND1: ICALL1 TO-COMPLETE
RTRUE
.FUNCT TO-COMPLETE
PRINTI " to complete this story"
PRINT STR?515
RTRUE
.FUNCT NYMPH-APPEARS,STR
ICALL1 PCLEAR
PRINT XA
ASSIGNED? 'STR /?CCL3
PRINTI "technical"
JUMP ?CND1
?CCL3: PRINT STR
?CND1: PRINTI " nymph appears on your keyboard. """
RTRUE
.FUNCT SEE-MANUAL,STR
ICALL1 NYMPH-APPEARS
PRINTI "Refer to your "
ICALL2 ITALICIZE,STR?867
PRINTI " manual for the correct way to "
PRINT STR
PRINT STR?515
RTRUE
.FUNCT REFER-TO-PACKAGE,OBJ
ASSIGNED? 'OBJ /?CND1
SET 'OBJ,PRSO
?CND1: ICALL2 NYMPH-APPEARS,STR?868
PRINTI "You'll find "
EQUAL? PRSA,V?EXAMINE \?CCL5
PRINTI "a drawing of "
ICALL2 THE-PRINT,OBJ
JUMP ?CND3
?CCL5: PRINTI "that information"
?CND3: PRINTI " in your "
ICALL2 ITALICIZE,STR?867
PRINTI " package"
PRINT STR?515
RTRUE
.FUNCT NONE-TO-BE-SEEN
PRINTR "There are none to be seen."
.FUNCT GENERIC-MONSTER-F,TBL,LEN,X
ASSIGNED? 'LEN /?CND1
GET TBL,0 >LEN
?CND1: ADD TBL,2 >TBL
ZERO? LAST-MONSTER /?CND3
INTBL? LAST-MONSTER,TBL,LEN >X \?CND3
RETURN LAST-MONSTER
?CND3: INTBL? P-IT-OBJECT,TBL,LEN >X \?PRG8
RETURN P-IT-OBJECT
?PRG8: DLESS? 'LEN,0 /FALSE
GET TBL,LEN >X
FSET? X,LIVING \?PRG8
FSET? X,SLEEPING /?PRG8
RETURN X
.FUNCT NOBODY-TO-ASK
ICALL1 PCLEAR
PRINTR "There's nobody here to ask."
.FUNCT TALK-TO-SELF
ICALL1 PCLEAR
LOC RIDDLE
EQUAL? HERE,STACK \?CND1
PRINT STR?512
CRLF
RTRUE
?CND1: PRINTR "[You must address characters directly.]"
.FUNCT DESCRIBE-DEATH,OBJ
FSET? OBJ,MUNGED \?CND1
PRINTI "Defeated"
RTRUE
?CND1: PRINTD OBJ
RTRUE
.FUNCT KILL-URGRUE
PRINTI ", directly into the core of the shadow!
The thing within stands revealed to you for one brief instant. Then your sanity is spared by a blinding flash and concussion that throws you hard against the far wall..."
ICALL1 CARRIAGE-RETURNS
PRINT XTHE
PRINTI "sound of sobbing jolts you to your senses.
In the corner lies a feeble old man, bent with grief. His robes are tattered, his white hair scorched by flame. You slowly rise and draw closer, bending low to touch his shoulder"
PRINT PTAB
ICALL1 CLAMP
PRINT TAB
PRINTI """I can always count on fools like you for sympathy,"" chuckles the not-so-feeble old man as he holds your windpipe shut. ""Still, though your mind is weak, your body is young and strong. It will make a suitable vessel until I can find another grue."" He grabs your hair, pulls your head back and directs your eyes into his own. ""Relax. This won't hurt a bit.""
Your fear turns to resentment, then to rage as the old man violates your mind, absorbing your compassion like a sponge as he fights to take possession of your soul."
CRLF
ICALL UPDATE-STAT,WINNING-COMPASSION,COMPASSION
PRINT TAB
PRINTI """Enough!""
The fingers on your neck drop away, "
GET STATS,COMPASSION
ZERO? STACK /?CND1
ICALL2 VANISH,URGRUE
ICALL2 DEQUEUE,I-URGRUE
FCLEAR URGRUE,LIVING
SET 'LAST-MONSTER,FALSE-VALUE
PRINTI "leaving you gasping but alive. You stumble backwards to find the old man leaning against the wall, breathing hard, his eyes brimming with tears.
""Enough,"" he cries again, gesturing towards the exit. ""Take what you want and leave this place! I cannot bring myself to murder one so virtuous. Go!"" His voice is bitter with despair. ""Leave me to wallow in Compassion.""
With these last words, the broken man fades into nothingness."
CRLF
GETP URGRUE,P?VALUE
ICALL UPDATE-STAT,STACK,EXPERIENCE,TRUE-VALUE
RTRUE
?CND1: PRINTI "and the carcass of your former self slumps to the ground. You kick it aside with a chuckle, and pause to admire your new, young body in the floating mirror. Then you saunter off down the passageway with the Coconut of Quendor under your arm, looking for a couple of baby grues to strangle. There's no faster way to burn off unwanted Compassion"
FSET DEATH,MUNGED
ICALL1 JIGS-UP
RTRUE
.FUNCT JIGS-UP
SET 'HERE,DEATH
MOVE PLAYER,HERE
ICALL1 RELOOK
ICALL1 OPTIONS
RFALSE
.FUNCT OPTIONS,U,WORD,KEY
ZERO? CAN-UNDO /?CND1
ZERO? LAST-MONSTER \?CND1
INC 'U
?CND1: PRINT STR?861
ZERO? U /?CND4
PRINTI "undo your last command, "
?CND4: PRINTI "restore a previously saved game, restart from the beginning, or quit?"
CRLF
CRLF
?PRG6: PRINTI "[Type "
ZERO? U /?CND8
PRINTI "UNDO, "
?CND8: PRINTI "RESTORE, RESTART or QUIT.] >"
CALL1 READ-YES-LEXV >KEY
GET YES-LEXV,P-LEXSTART >WORD
GETB YES-LEXV,P-LEXWORDS
ZERO? STACK /?PRG6
ZERO? U /?CCL14
EQUAL? WORD,W?UNDO \?CCL14
ICALL1 V-UNDO
JUMP ?PRG6
?CCL14: EQUAL? WORD,W?RESTORE \?CCL18
ICALL1 V-RESTORE
JUMP ?PRG6
?CCL18: EQUAL? WORD,W?RESTART \?CCL20
RESTART
ICALL2 FAILED,STR?565
JUMP ?PRG6
?CCL20: EQUAL? WORD,W?QUIT,W?Q \?PRG6
CRLF
QUIT
JUMP ?PRG6
.FUNCT ASIDE-FROM,OBJ
ASSIGNED? 'OBJ /?CND1
SET 'OBJ,ME
?CND1: RANDOM 100
LESS? 50,STACK /?CCL5
PRINTI "Besides "
JUMP ?CND3
?CCL5: PRINTI "Aside from "
?CND3: ICALL2 THE-PRINT,OBJ
PRINT LYOU-SEE
RTRUE
.FUNCT GONE-NOW,OBJ,STR
ZERO? STR \?CCL3
ICALL2 CTHE-PRINT,OBJ
JUMP ?CND1
?CCL3: PRINT XTHE
PRINT OBJ
?CND1: PRINTR " you saw here before is gone now."
.FUNCT HOLLOW-VOICE,STR
ICALL1 PCLEAR
PRINT STR?512
PRINTI " That Name is "
PRINT STR
PRINTR ". Choose another!"""
.FUNCT V-COLOR,TBL,PAL,CNT
EQUAL? PRSO,ROOMS \?CND1
GET MACHINE-COLORS,HOST >TBL
ZERO? COLORS? \?CCL5
EQUAL? HOST,ATARI-ST \?CCL5
SET 'TBL,ST-MONO
JUMP ?CND3
?CCL5: ZERO? COLORS? /?CCL8
ZERO? TBL /?CCL8
GET TBL,0 >CNT
ZERO? CNT /?CND3
LESS? CNT,2 \?CND3
?CCL8: ICALL1 NOT-AVAILABLE
RTRUE
?CND3: GET TBL,PALLETTE >TBL
GETB TBL,0 >BGND
GETB TBL,1 >FORE
GETB TBL,2 >INCOLOR
GETB TBL,3 >GCOLOR
ICALL1 V-REFRESH
CRLF
PRINTI "[Color pallette "
PRINTN PALLETTE
PRINTI " of "
PRINTN CNT
PRINTI ".]"
CRLF
IGRTR? 'PALLETTE,CNT \TRUE
SET 'PALLETTE,1
RTRUE
?CND1: ICALL1 DONT-UNDERSTAND
RTRUE
.FUNCT PROLOGUE,X,Y
CLEAR -1
CRLF
PRINTI """Our doom is sealed.""
Y'Gael turned away from the window overlooking the Great Sea. ""The Guildmaster nears the end of his final quest,"" she said softly. ""When he succeeds, for succeed he will, our powers shall cease to be.""
The silence was unbroken for a long minute. Then a tiny voice near the door peeped, ""Forever?""
"""
HLIGHT H-ITALIC
PRINTI "No"
HLIGHT H-NORMAL
PRINTI "."" The old woman leaned forward on her staff. ""The Age of Science will endure long; no one in this room can hope to outlive it. But our knowledge need not die with us -- if we act at once to preserve our priceless heritage.""
""Wherein lies your hope, Y'Gael?"" demanded a salamander in the front row. ""What Magick is proof against the death of Magick itself?""
Y'Gael's dry chuckle stilled the murmur of the crowd. ""You forget your own history, Gustar. Are you not author of the definitive scroll on the Coconut of Quendor?""
A tumult of amphibious croaks and squeals drowned out Gustar's retort. Y'Gael hobbled over to a table laden with mystical artifacts, selected a small stone and raised it high.
""The Coconut is our only hope,"" she cried, her eyes shining in the stone's violet aura. ""Its seed embodies the essence of our wisdom. Its shell is impervious to the ravages of Time. We must reclaim it from the Implementors, and hide it away before its secrets are forgotten!""
The shrill voice of a newt rose above the cheering. ""And who will steal this Coconut from the Implementors?"" he scoffed. ""You, Y'Gael?""
The violet aura faded at his words. ""Not I, Orkan,"" replied Y'Gael, shaking the lifeless stone and replacing it with a sigh. ""The fabric of Magick is unravelling. We dare not rely on its protection. Another champion must be sought; an innocent unskilled in the lore of enchantment, who cannot know the price of failure, or recognize the face of death.""
Orkan's squeak was skeptical. ""Suppose your champion succeeds in this hopeless quest. What will become of the Coconut?""
Y'Gael turned to face the sea once more. ""It will await the coming of a better age,"" she replied, her voice trembling with emotion. ""An age beyond Magick, beyond Science ...""
"
INPUT 1 >X
SUB WIDTH,52
DIV STACK,2 >X
SUB HEIGHT,8
DIV STACK,2 >Y
CLEAR -1
SPLIT 20
ICALL1 TO-TOP-WINDOW
ADD X,10
ICALL DO-CURSET,Y,STACK
ICALL1 BIG-ZORK
INC 'Y
ADD X,15
ICALL DO-CURSET,Y,STACK
ICALL1 SAY-COCO
ADD Y,2 >Y
ADD X,15
ICALL DO-CURSET,Y,STACK
PRINTI "An Interactive Fantasy"
INC 'Y
ICALL DO-CURSET,Y,X
PRINT STR?573
INC 'Y
ADD X,2
ICALL DO-CURSET,Y,STACK
ICALL1 TRADEMARK
ICALL1 TO-BOTTOM-WINDOW
INPUT 1 >X
RFALSE
.FUNCT BIG-ZORK
ZERO? COLORS? /?CCL3
COLOR FORE,BGND
JUMP ?CND1
?CCL3: EQUAL? HOST,MACINTOSH /?CND1
HLIGHT H-BOLD
?CND1: PRINTI "B E Y O N D Z O R K"
RFALSE
.FUNCT SAY-COCO
COLOR INCOLOR,BGND
HLIGHT H-NORMAL
HLIGHT H-MONO
PRINT STR?572
COLOR FORE,BGND
RFALSE
.FUNCT TRADEMARK
ICALL2 ITALICIZE,STR?869
PRINTI " is a registered trademark of Infocom, Inc."
RTRUE
.FUNCT V-$CREDITS,X
CLEAR -1
SUB HEIGHT,1
SPLIT STACK
ICALL1 TO-TOP-WINDOW
ICALL CENTER,2,33
ICALL1 BIG-ZORK
ICALL CENTER,3,22
ICALL1 SAY-COCO
ICALL CENTER,5,17
PRINTI "by Brian Moriarty"
ICALL CENTER,7,7
COLOR INCOLOR,BGND
PRINTI "Testing"
COLOR FORE,BGND
ICALL CENTER,8,53
PRINTI "Gary Brennan Max Buxton Liz Cyr-Jones Jacob Galley"
ICALL CENTER,9,70
PRINTI "Tyler Gore Matt Hillman Katie Kendall Martin Price Joe Prosser"
ICALL CENTER,10,44
PRINTI "Steve Meretzky Tom Veldran Steve Watkins"
ICALL CENTER,12,48
COLOR INCOLOR,BGND
PRINTI "Package Project Manager Copywriter"
ICALL CENTER,13,56
COLOR FORE,BGND
PRINTI "Carl Genatossio Jon Palace Elizabeth Langosy"
SET 'X,15
GRTR? HEIGHT,23 \?CND1
ICALL CENTER,X,57
COLOR INCOLOR,BGND
PRINTI "Cover Map & Book Photography Production"
INC 'X
ICALL CENTER,X,63
COLOR FORE,BGND
PRINTI "John Gamache Bruce Hutchinson Steve Grohe Angela Crews"
ADD X,2 >X
?CND1: ICALL CENTER,X,18
COLOR INCOLOR,BGND
PRINTI "Micro Interpreters"
INC 'X
ICALL CENTER,X,47
COLOR FORE,BGND
PRINTI "Tim Anderson Jon Arnold Duncan Blanchard"
INC 'X
ICALL CENTER,X,34
PRINTI "Linde Dynneson Andy Kaluzniacki"
ADD X,2 >X
COLOR INCOLOR,BGND
ICALL CENTER,X,20
PRINTI "Z Development System"
INC 'X
ICALL CENTER,X,43
COLOR FORE,BGND
PRINTI "Tim Anderson Dave Lebling Chris Reeve"
ICALL1 TO-BOTTOM-WINDOW
INPUT 1 >X
ICALL1 V-REFRESH
RTRUE
.FUNCT TIMESTOP
ICALL2 CTHE-PRINT,URGRUE
PRINTI " clears its throat. ""Girgol it is, then.""
The speed and pitch of "
ICALL2 THE-PRINT,URGRUE
PRINTI "'s triumphant laughter increase as a web of evil Magick engulfs you. Eons of history flicker past in mere seconds of subjective time, until the Final Conflagration brings your long-forgotten existence to a merciful end"
ICALL1 JIGS-UP
RFALSE
.FUNCT SAY-ERROR,STR
PRINTI "[Error @ "
PRINT STR
PRINTR "]"
.FUNCT ENDING,X,LEVEL
PRINTI "A devastating ground shock sends you sprawling! The roof of the cavern gives way at the same moment, and you watch helplessly as tons of granite crumble all around you.."
LOC COCO >X
ZERO? X /?CCL2
EQUAL? X,PLAYER /?CND1
IN? X,PLAYER /?CND1
?CCL2: ICALL1 JIGS-UP
RFALSE
?CND1: PRINT PERIOD
ICALL1 CARRIAGE-RETURNS
CLEAR -1
COLOR FORE,BGND
CRLF
PRINTI """Is "
FSET? PLAYER,FEMALE \?CND7
PRINTC 115
?CND7: PRINTI "he still alive?""
The voice at your ear is familiar. You decide to open one eye.
""Apparently."" "
PRINT CTHELADY
PRINTI " probes your left ankle with her fingers, and you wince with pain. ""Close call, though. What did you call that spell, your Worship?""
"""
ICALL2 ITALICIZE,STR?870
PRINTI ". Turns granite to fettucine."" Cardinal Toolbox wipes his mouth. ""Any left?""
""Gluttony is a sin,"" retorts "
ICALL2 THE-PRINT,OWOMAN
PRINTI ", helping you to your feet. ""Is everything ready?""
The old sailor dabs a final touch of color onto the canvas, then signs his work with a chuckle. ""All set, Y'Gael.""
""Very well."" The old woman hands you a slim golden wand and nods at the easel. ""Here. You need the experience.""
The painting shimmers with Magick as the wand's rays play across its surface. You watch with growing wonder as the skillful strokes and flourishes become one with the sea and sky, artfully blending with your surroundings until it's hard to tell where one begins and the other ends.
""Cast off, Mister Clutchcake!"" cries the old sailor, taking his place behind the wheel. ""Let's be underway while the tide's still with us!""
""Aye, Captain!"" The cook from the Rusty Lantern chops the mooring rope with a meat cleaver, and your magnificent galleon glides away from the wharf and high into the sky, held aloft by planes of sparkling Magick. The village of Grubbo-by-the-Sea dwindles off the stern; you can just see the little hilltop where your adventure began, so long ago.
The woman called Y'Gael weighs the Coconut of Quendor thoughtfully in her hand. ""Better go below and take a nap,"" she suggests as you stifle a yawn. ""You're going to need it.""
"
INPUT 1 >X
CLEAR -1
SPLIT 14
PUTB DBOX,0,SP
COPYT DBOX,DBOX+1,-1551
ICALL2 SHOW-RANK,WIDTH
ZERO? VT220 \?CCL11
ICALL1 APPLE-BARS
JUMP ?CND9
?CCL11: SUB WIDTH,BARWIDTH
DIV STACK,2
SUB STACK,1
ICALL STATBARS,3,STACK,LUCK
?CND9: CRLF
PRINTI "Thus ends the story of "
ICALL2 ITALICIZE,STR?867
PRINTI ": "
HLIGHT H-ITALIC
PRINT STR?572
HLIGHT H-NORMAL
PRINT PERIOD
CRLF
PRINTI "Your final rank is "
CALL1 ANNOUNCE-RANK >LEVEL
PRINTI " in "
PRINTN MOVES
PRINTI " moves, "
ZERO? RANK \?CND12
SUB 9,LEVEL >LEVEL
PRINTN LEVEL
PRINTI " level"
EQUAL? LEVEL,1 /?CND14
PRINTC 115
?CND14: PRINTI " below "
?CND12: PRINTI "the highest possible rank."
CRLF
ICALL1 OPTIONS
RTRUE
.FUNCT CHEATER
CRLF
ICALL1 NYMPH-APPEARS
PRINTI "Shame on you"
PRINT STR?515
CRLF
QUIT
RFALSE
.ENDI