zorkzero/fenshire.zap

949 lines
23 KiB
Plaintext

.SEGMENT "FENSHIRE"
.FUNCT DIRIGIBLE-ENTER-F,RARG
IN? DIRIGIBLE,HERE \?CCL3
RETURN GONDOLA
?CCL3: ZERO? RARG \FALSE
ICALL1 V-WALK-AROUND
RFALSE
.FUNCT DIRIGIBLE-HANGAR-F,RARG
ZERO? DEMO-VERSION? /FALSE
EQUAL? RARG,M-END \FALSE
CALL1 END-DEMO
RSTACK
.FUNCT DIRIGIBLE-F
EQUAL? PRSA,V?PUT-THROUGH,V?THROW-FROM \?CCL3
EQUAL? PRSI,DIRIGIBLE \?CCL3
CALL PERFORM-PRSA,PRSO,GONDOLA
RSTACK
?CCL3: EQUAL? PRSA,V?EXAMINE \?CCL7
EQUAL? HERE,GONDOLA \?CCL10
CALL1 V-LOOK
RSTACK
?CCL10: GETP DIRIGIBLE,P?LDESC
PRINT STACK
CRLF
RTRUE
?CCL7: EQUAL? PRSA,V?LOOK-INSIDE \?CCL12
EQUAL? HERE,GONDOLA \?CCL15
PRINT LOOK-AROUND
RTRUE
?CCL15: PRINTR "You can't see much from out here."
?CCL12: EQUAL? PRSA,V?ENTER \FALSE
CALL2 GOTO,GONDOLA
RSTACK
.FUNCT GONDOLA-F,RARG
EQUAL? RARG,M-LOOK \?CCL3
PRINTI "You are in the luxurious gondola of the dirigible. A window wraps completely around the gondola. "
PRINT GONDOLA-CONTROLS-DESC
RTRUE
?CCL3: ZERO? RARG \FALSE
EQUAL? PRSA,V?EXAMINE \?CCL7
CALL2 PERFORM-PRSA,DIRIGIBLE
RSTACK
?CCL7: EQUAL? PRSA,V?ENTER \?CCL9
EQUAL? HERE,GONDOLA /?CCL9
CALL2 DO-WALK,P?IN
RSTACK
?CCL9: EQUAL? PRSA,V?EXIT,V?LEAP-OFF \?CCL13
EQUAL? HERE,GONDOLA \?CCL13
CALL2 DO-WALK,P?OUT
RSTACK
?CCL13: EQUAL? PRSA,V?LOOK-INSIDE \?CCL17
CALL2 PERFORM-PRSA,DIRIGIBLE
RSTACK
?CCL17: EQUAL? PRSA,V?PUT-THROUGH,V?THROW-FROM \FALSE
EQUAL? PRSI,GLOBAL-HERE,GONDOLA \FALSE
IN? DIRIGIBLE,DIRIGIBLE-HANGAR /?CTR23
IN? DIRIGIBLE,SMALLER-HANGAR \?CCL24
?CTR23: LOC DIRIGIBLE
MOVE PRSO,STACK
JUMP ?CND22
?CCL24: EQUAL? PRSO,PERCH /?CCL28
CALL ULTIMATELY-IN?,PERCH,PRSO
ZERO? STACK /?CND27
?CCL28: SET 'REMOVED-PERCH-LOC,GROUND
?CND27: REMOVE PRSO
?CND22: PRINTI "You fling"
ICALL1 TPRINT-PRSO
PRINTR " out of the gondola."
.FUNCT GONDOLA-CONTROLS-F
EQUAL? PRSA,V?EXAMINE \FALSE
PRINT GONDOLA-CONTROLS-DESC
CRLF
RTRUE
.FUNCT GONDOLA-BUTTON-F
EQUAL? PRSA,V?PUSH \FALSE
ZERO? TIME-STOPPED \?CTR5
FSET? OUTER-GATE,OPENBIT /?CTR5
GRTR? DIRIGIBLE-COUNTER,0 /?CTR5
EQUAL? PRSO,LEFT-GONDOLA-BUTTON \?PRD11
IN? DIRIGIBLE,DIRIGIBLE-HANGAR /?CTR5
?PRD11: EQUAL? PRSO,RIGHT-GONDOLA-BUTTON \?CCL6
IN? DIRIGIBLE,SMALLER-HANGAR \?CCL6
?CTR5: PRINT NOTHING-HAPPENS
RTRUE
?CCL6: ICALL QUEUE,I-DIRIGIBLE,-1
SET 'DIRIGIBLE-COUNTER,1
ZERO? BORDER-ON /?CND16
GETB 0,30
EQUAL? STACK,DEC-20 /?CND16
ICALL1 CLEAR-BORDER
ICALL2 INIT-STATUS-LINE,TRUE-VALUE
?CND16: PRINTI "The dirigible rises out of the hangar and sails "
IN? DIRIGIBLE,DIRIGIBLE-HANGAR \?CCL22
SET 'DESTINATION,SMALLER-HANGAR
PRINTI "ea"
JUMP ?CND20
?CCL22: SET 'DESTINATION,DIRIGIBLE-HANGAR
PRINTI "we"
?CND20: PUTP GONDOLA,P?REGION,STR?939
GETP GONDOLA,P?MAP-LOC
PUT STACK,0,FALSE-VALUE
FSET DIRIGIBLE,NDESCBIT
MOVE DIRIGIBLE,GONDOLA
PRINTR "stward."
.FUNCT GONDOLA-EXIT-F,RARG
GRTR? DIRIGIBLE-COUNTER,0 \?CCL3
ZERO? RARG \FALSE
CALL2 JIGS-UP,STR?940
RSTACK
?CCL3: LOC DIRIGIBLE
RSTACK
.FUNCT I-DIRIGIBLE,TBL
EQUAL? HERE,GONDOLA \?CND1
ICALL1 RETURN-FROM-MAP
PRINTI " "
?CND1: EQUAL? DIRIGIBLE-COUNTER,5 \?CCL5
GETP GONDOLA,P?MAP-LOC >TBL
EQUAL? DESTINATION,SMALLER-HANGAR \?CCL8
PUT TBL,0,FENSHIRE-MAP-NUM
PUT TBL,1,GONDOLA-AT-FENSHIRE-LOC
PUT TBL,2,MAP-GEN-X-2
PUTP GONDOLA,P?REGION,STR?249
JUMP ?CND6
?CCL8: PUT TBL,0,MAIN-MAP-NUM
PUT TBL,1,GONDOLA-AT-FLATHEADIA-LOC
PUT TBL,2,MAP-GEN-X-1
PUTP GONDOLA,P?REGION,STR?250
?CND6: MOVE DIRIGIBLE,DESTINATION
FCLEAR DIRIGIBLE,NDESCBIT
ICALL2 DEQUEUE,I-DIRIGIBLE
SET 'DIRIGIBLE-COUNTER,0
ZERO? BORDER-ON /?CND9
EQUAL? HERE,GONDOLA \?CND9
GETB 0,30
EQUAL? STACK,DEC-20 /?CND9
ICALL1 CLEAR-BORDER
SET 'CURRENT-BORDER,CASTLE-BORDER
SCREEN S-FULL
ICALL2 INIT-STATUS-LINE,TRUE-VALUE
SCREEN S-TEXT
?CND9: EQUAL? HERE,GONDOLA \?CCL16
PRINTR "The dirigible descends into a hangar and comes to a stop."
?CCL16: EQUAL? HERE,DESTINATION \FALSE
ICALL1 RETURN-FROM-MAP
PRINTR " A dirigible descends into the hangar."
?CCL5: EQUAL? HERE,GONDOLA /?CCL20
INC 'DIRIGIBLE-COUNTER
RFALSE
?CCL20: ICALL1 RETURN-FROM-MAP
PRINTI "The dirigible continues to glide along. "
EQUAL? DESTINATION,DIRIGIBLE-HANGAR \?CCL23
SUB 4,DIRIGIBLE-COUNTER
GET DIRIGIBLE-TRIP-DESCS,STACK
PRINT STACK
JUMP ?CND21
?CCL23: SUB DIRIGIBLE-COUNTER,1
GET DIRIGIBLE-TRIP-DESCS,STACK
PRINT STACK
?CND21: INC 'DIRIGIBLE-COUNTER
CRLF
RTRUE
.FUNCT SMALLER-HANGAR-F,RARG
EQUAL? RARG,M-ENTER \FALSE
FSET? SMALLER-HANGAR,TOUCHBIT /FALSE
CALL QUEUE,I-FOX,-1
RSTACK
.FUNCT DESERTED-CASTLE-F,RARG
EQUAL? RARG,M-ENTER \FALSE
FSET? DESERTED-CASTLE,TOUCHBIT /FALSE
CALL QUEUE,I-ROOSTER,-1
RSTACK
.FUNCT RUINED-HALL-F,RARG
EQUAL? RARG,M-LOOK \?CCL3
PRINTI "The entrance hall of the summer castle retains but a shadow of its former elegance; the ceiling has partially collapsed, and myriad weeds grow amongst the debris that covers the floor. A fireplace is choked with the rubble of its collapsed chimney. Above the fireplace is a faded fresco, and next to that, a tiny vase is mounted on the wall. Arched openings lead "
ZERO? ARCHWAY-OPEN /?CND4
PRINTI "north, "
?CND4: PRINTI "south and west. "
ZERO? ARCHWAY-OPEN \?CND6
PRINTI "The archway to the north"
IN? HEXAGONAL-BLOCK,LOCAL-GLOBALS /?CCL10
SET 'ARCHWAY-OPEN,TRUE-VALUE
PRINTI ", which had earlier crumbled, seems restored to its former condition: decayed but passable! "
JUMP ?CND6
?CCL10: PRINTI " has crumbled to rubble. "
?CND6: ZERO? SECRET-ROOM-REVEALED /?CND11
PRINTI "In addition, a dusty passage leads east. "
?CND11: PRINTI "A stairway once led upwards, but there's little left of it."
RTRUE
?CCL3: EQUAL? RARG,M-END \FALSE
ZERO? ARCHWAY-OPEN \FALSE
IN? HEXAGONAL-BLOCK,LOCAL-GLOBALS /FALSE
SET 'ARCHWAY-OPEN,TRUE-VALUE
RETURN ARCHWAY-OPEN
.FUNCT FIREPLACE-F
EQUAL? PRSA,V?ENTER \?CCL3
CALL2 DO-FIRST,STR?949
RSTACK
?CCL3: EQUAL? PRSA,V?CLEAN \?CCL5
PRINTR "Not a chance (unless you're actually a team of thirty people, in disguise)."
?CCL5: EQUAL? PRSA,V?LOOK-INSIDE \FALSE
PRINTR "Rubble. Lots of rubble."
.FUNCT FRESCO-F
EQUAL? PRSA,V?EXAMINE \FALSE
PRINTR "The fresco depicts the death of Duncanthrax. His spirit is ascending to heaven on a tremendous ladder, surrounded by a host of angels."
.FUNCT VASE-F
EQUAL? PRSA,V?OPEN,V?CLOSE \?CCL3
PRINT HUH
RTRUE
?CCL3: EQUAL? PRSA,V?TAKE \?CCL5
EQUAL? PRSO,VASE \?CCL5
PRINTR "The vase is affixed to the wall."
?CCL5: EQUAL? PRSA,V?PUT \FALSE
EQUAL? PRSO,FLOWER \FALSE
ZERO? SECRET-ROOM-REVEALED \FALSE
SET 'SECRET-ROOM-REVEALED,TRUE-VALUE
SET 'COMPASS-CHANGED,TRUE-VALUE
MOVE FLOWER,VASE
PRINTI "The flower seems to grow fuller, its colors richer. You hear a noise, and turn to see a passageway opening to the east!"
CRLF
CALL2 INC-SCORE,16
RSTACK
.SEGMENT "0"
.FUNCT LADDER-F,VARG
ZERO? VARG \FALSE
EQUAL? PRSA,V?EXAMINE,V?CLOSE,V?OPEN \?CCL5
PRINTR "The stepladder seems to be stuck in the open position."
?CCL5: EQUAL? PRSA,V?PUT-UNDER \?CCL7
EQUAL? PRSO,MEGABOZ-TRAP-DOOR \?CCL7
PRINTR "The ladder is now standing beneath the trap door."
?CCL7: EQUAL? PRSA,V?CLIMB-ON,V?CLIMB,V?STAND-ON \FALSE
ICALL PERFORM,V?ENTER,LADDER
RTRUE
.ENDSEG
.SEGMENT "FENSHIRE"
.FUNCT MARSH-F,RARG
EQUAL? RARG,M-LOOK \?CCL3
PRINTI "The swamps of Fenshire have encroached on this once-beautiful garden. The garden wall is now just a pile of mossy stones, and the garden terraces are ankle-deep with squishy mud. A c"
ZERO? ARCHWAY-OPEN /?CCL6
PRINTI "rumbling archway leads"
JUMP ?CND4
?CCL6: PRINTI "ollapsed archway blocks the exit to the"
?CND4: PRINTI " south. To the north"
ZERO? STEPPING-STONES-VISIBLE /?CCL9
PRINTI ", stepping stones lead across a field of quicksand."
RTRUE
?CCL9: PRINTI " is a wide expanse of fetid quicksand."
RTRUE
?CCL3: EQUAL? RARG,M-END \FALSE
IN? JESTER,HERE \?CCL14
CALL2 VISIBLE?,ROOSTER
ZERO? STACK /?CCL14
FSET? ROOSTER,ANIMATEDBIT \?CCL14
CALL2 VISIBLE?,FOX
ZERO? STACK /?CCL14
FSET? FOX,ANIMATEDBIT \?CCL14
CALL2 VISIBLE?,WORM
ZERO? STACK /?CCL14
FSET? WORM,ANIMATEDBIT \?CCL14
MOVE JESTER,NICE-LUNCH-SPOT
MOVE COOKPOT,NICE-LUNCH-SPOT
MOVE COOKFIRE,NICE-LUNCH-SPOT
SET 'ARCHWAY-OPEN,FALSE-VALUE
SET 'STEPPING-STONES-VISIBLE,TRUE-VALUE
SET 'COMPASS-CHANGED,TRUE-VALUE
FSET RUINED-HALL,REDESCBIT
ICALL1 RETURN-FROM-MAP
PRINTR " The jester looks delighted. ""Sacre bleu! At last! All zee ingredients for Borphbelly Stew! But zee ambience here eesn't quite right."" He picks up his cookpot AND his cookfire, and dashes across the quicksand to the north, using a series of stepping stones which you'd swear weren't there a minute ago. This flurry of activity seems to have been too much for the archway behind you; it crumbles into a pile of rubble, blocking the exit to the south.
The jester, out of sight amongst the reeds to the north, shouts, ""Yoo hoo! I've found a lovely spot for lunch! Bring over zee ingredients!"""
?CCL14: IN? JESTER,HERE /FALSE
IN? HEXAGONAL-BLOCK,LOCAL-GLOBALS \FALSE
ZERO? ARCHWAY-OPEN /FALSE
ICALL2 DEQUEUE,I-JESTER
ICALL2 THIS-IS-IT,JESTER
MOVE JESTER,HERE
MOVE COOKPOT,HERE
MOVE COOKFIRE,HERE
PRINTI " A string of eloquent cursing in a foreign tongue assaults you, and you spy the jester "
PRINT COOK-DESC
PRINTR " He is stirring a cookpot which sits upon a roaring cookfire. ""Impossible!"" he shrieks, switching to a more familiar language. ""Eet is impossible to cook a Borphbelly Stew weethout zee proper ingredients! Impossible, impossible, impossible!"""
.FUNCT STEPPING-STONES-F,RARG
ZERO? STEPPING-STONES-VISIBLE \?CCL3
ZERO? RARG \FALSE
PRINTI "You'd be sucked into the quicksand!"
CRLF
RFALSE
?CCL3: CALL2 CCOUNT,PROTAGONIST
GRTR? STACK,1 \?CCL7
ZERO? RARG \FALSE
PRINTI "It's difficult to balance on the stepping stones with all you're carrying. You try, but after almost falling into the quicksand, you give up."
CRLF
RFALSE
?CCL7: EQUAL? HERE,MARSH \?CCL11
RETURN NICE-LUNCH-SPOT
?CCL11: RETURN MARSH
.FUNCT NICE-LUNCH-SPOT-F,RARG
EQUAL? RARG,M-END \FALSE
CALL2 VISIBLE?,ROOSTER
ZERO? STACK /FALSE
FSET? ROOSTER,ANIMATEDBIT \FALSE
CALL2 VISIBLE?,FOX
ZERO? STACK /FALSE
FSET? FOX,ANIMATEDBIT \FALSE
CALL2 VISIBLE?,WORM
ZERO? STACK /FALSE
FSET? WORM,ANIMATEDBIT \FALSE
MOVE HEXAGONAL-BLOCK,SMALLER-HANGAR
FSET SMALLER-HANGAR,REDESCBIT
FSET RUINED-HALL,REDESCBIT
REMOVE WORM
REMOVE FOX
REMOVE ROOSTER
REMOVE COOKPOT
REMOVE COOKFIRE
ICALL2 DEQUEUE,I-FOX
ICALL2 DEQUEUE,I-ROOSTER
ICALL1 RETURN-FROM-MAP
PRINTI " The jester says, ""Excellent! Zee ingredients for Borphbelly Stew and a "
ICALL2 DPRINT,HERE
PRINTI " to enjoy eet!"" He tosses the animals into the cookpot, and begins dishing out two generous portions of stew. Before you can eat it, a tremendous weariness comes over you. The last thing you hear is the jester saying, ""Waiter? Check, please!""
You awake from a deep sleep and struggle to your feet. As your head clears you realize that you're not where you were when you fell asleep"
PRINT ELLIPSIS
ICALL2 GOTO,SMALLER-HANGAR
CALL2 INC-SCORE,9
RSTACK
.SEGMENT "0"
.FUNCT HEXAGONAL-BLOCK-F
EQUAL? PRSA,V?EXAMINE \FALSE
PRINTR "It's just a small rock which has been neatly carved into the shape of an elongated hexagon."
.ENDSEG
.SEGMENT "FENSHIRE"
.FUNCT HOTHOUSE-F,RARG
EQUAL? RARG,M-ENTER \FALSE
FSET? FAN,TRYTAKEBIT \FALSE
CALL QUEUE,I-SN,1
RSTACK
.FUNCT I-SN,?TMP3,?TMP2,?TMP1
EQUAL? HERE,HOTHOUSE \FALSE
ZERO? ALLIGATOR /?CND1
ICALL QUEUE,I-SN,1
RFALSE
?CND1: ICALL1 RETURN-FROM-MAP
ICALL1 UPDATE-STATUS-LINE
PRINTI " The jester steps out from behind some tropical vines, fanning himself with a dainty paper fan. ""Hot enough for you? I know just the thing to take your mind off this heat! It's one of my favorite games, Snarfem.
""The rules: I'll produce four piles of pebbles. Each of us, starting with you, will remove as many pebbles as we feel like -- as long as they come from the same pile. You must take at least one pebble each turn. The player who takes the last pebble wins. It's that simple!"""
CRLF
CRLF
ICALL2 HIT-ANY-KEY,STR?955
ICALL SPLIT-BY-PICTURE,SN-SPLIT,TRUE-VALUE
ICALL2 ADJUST-TEXT-WINDOW,SN-BOTTOM
?PRG5: RANDOM 9
PUT PILE-TABLE,1,STACK
?PRG7: RANDOM 9
PUT PILE-TABLE,2,STACK
GET PILE-TABLE,2 >?TMP1
GET PILE-TABLE,1
EQUAL? ?TMP1,STACK \?PRG14
GET PILE-TABLE,2
ADD STACK,1
PUT PILE-TABLE,2,STACK
GET PILE-TABLE,2
EQUAL? STACK,10 \?PRG7
PUT PILE-TABLE,2,1
JUMP ?PRG7
?PRG14: RANDOM 9
PUT PILE-TABLE,3,STACK
GET PILE-TABLE,3 >?TMP2
GET PILE-TABLE,2 >?TMP1
GET PILE-TABLE,1
EQUAL? ?TMP2,?TMP1,STACK \?PRG21
GET PILE-TABLE,3
ADD STACK,1
PUT PILE-TABLE,3,STACK
GET PILE-TABLE,3
EQUAL? STACK,10 \?PRG14
PUT PILE-TABLE,3,1
JUMP ?PRG14
?PRG21: RANDOM 9
PUT PILE-TABLE,4,STACK
GET PILE-TABLE,4 >?TMP3
GET PILE-TABLE,3 >?TMP2
GET PILE-TABLE,2 >?TMP1
GET PILE-TABLE,1
EQUAL? ?TMP3,?TMP2,?TMP1,STACK \?REP22
GET PILE-TABLE,4
ADD STACK,1
PUT PILE-TABLE,4,STACK
GET PILE-TABLE,4
EQUAL? STACK,10 \?PRG21
PUT PILE-TABLE,4,1
JUMP ?PRG21
?REP22: CALL2 SAFE-NUMBER?,PILE-TABLE
ZERO? STACK \?PRG5
ICALL1 SETUP-SN
CRLF
ICALL1 SNARFEM
ICALL2 INIT-SL-WITH-SPLIT,TEXT-WINDOW-PIC-LOC
FSET? FAN,TRYTAKEBIT \?CCL32
PRINTI "The jester claps you on the back and says, ""He who wins and runs away, returns to let you win another day!"""
CALL1 J-EXITS
RSTACK
?CCL32: MOVE FAN,HERE
ICALL1 REMOVE-J
PRINTI """You're undoubtedly not a flash in the pan; you've turned me into your biggest fan!"" The jester is suddenly wearing a cap and sweater bearing your initials, and waving a pennant with your name on it. Still chanting a cheer, he vanishes, and you notice a delicate paper fan lying at your feet."
CRLF
CALL2 INC-SCORE,12
RSTACK
.FUNCT SETUP-SN
SCREEN S-FULL
DISPLAY SN-BORDER,1,1
SCREEN S-WINDOW
PICSET SN-PICSET-TBL
ICALL2 DRAW-PILE,1
ICALL2 DRAW-PILE,2
ICALL2 DRAW-PILE,3
ICALL2 DRAW-PILE,4
CALL1 DRAW-FLOWERS
RSTACK
.FUNCT DRAW-SN-BOXES,PILE,X,Y,SPACE,CNT,TBL
SET 'CNT,1
SCREEN S-WINDOW
ICALL2 PICINF-PLUS-ONE,BOX-1-LOC
GET PICINF-TBL,0 >Y
GET PICINF-TBL,1 >X
PICINF SN-BOX-SPACE,PICINF-TBL /?BOGUS1
?BOGUS1: GET PICINF-TBL,1 >SPACE
?PRG2: ZERO? PILE \?CCL6
GRTR? CNT,4 \?CCL9
SET 'TBL,DIM-BOX-TBL
JUMP ?CND4
?CCL9: GET PILE-TABLE,CNT
ZERO? STACK \?CCL11
SET 'TBL,DIM-BOX-TBL
JUMP ?CND4
?CCL11: SET 'TBL,BOX-TBL
JUMP ?CND4
?CCL6: GET PILE-TABLE,PILE
GRTR? CNT,STACK \?CCL13
SET 'TBL,DIM-BOX-TBL
JUMP ?CND4
?CCL13: SET 'TBL,BOX-TBL
?CND4: GET TBL,CNT
DISPLAY STACK,Y,X
EQUAL? CNT,9 /?REP3
ADD X,SPACE >X
INC 'CNT
JUMP ?PRG2
?REP3: SCREEN S-TEXT
RTRUE
.FUNCT DRAW-PILE,PILE,NUM,PIC,?TMP1
SCREEN S-WINDOW
GET PILE-TABLE,PILE >NUM
EQUAL? PILE,1 \?CCL3
PUSH PILE-1-PIC-LOC
JUMP ?CND1
?CCL3: EQUAL? PILE,2 \?CCL5
PUSH PILE-2-PIC-LOC
JUMP ?CND1
?CCL5: EQUAL? PILE,3 \?CCL7
PUSH PILE-3-PIC-LOC
JUMP ?CND1
?CCL7: PUSH PILE-4-PIC-LOC
?CND1: ICALL2 PICINF-PLUS-ONE,STACK
ZERO? NUM \?CCL10
SET 'PIC,PILE-OF-0
JUMP ?CND8
?CCL10: EQUAL? NUM,1 \?CCL12
SET 'PIC,PILE-OF-1
JUMP ?CND8
?CCL12: EQUAL? NUM,2 \?CCL14
SET 'PIC,PILE-OF-2
JUMP ?CND8
?CCL14: EQUAL? NUM,3 \?CCL16
SET 'PIC,PILE-OF-3
JUMP ?CND8
?CCL16: EQUAL? NUM,4 \?CCL18
SET 'PIC,PILE-OF-4
JUMP ?CND8
?CCL18: EQUAL? NUM,5 \?CCL20
SET 'PIC,PILE-OF-5
JUMP ?CND8
?CCL20: EQUAL? NUM,6 \?CCL22
SET 'PIC,PILE-OF-6
JUMP ?CND8
?CCL22: EQUAL? NUM,7 \?CCL24
SET 'PIC,PILE-OF-7
JUMP ?CND8
?CCL24: EQUAL? NUM,8 \?CCL26
SET 'PIC,PILE-OF-8
JUMP ?CND8
?CCL26: SET 'PIC,PILE-OF-9
?CND8: GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
DISPLAY PIC,?TMP1,STACK
SCREEN S-TEXT
RTRUE
.FUNCT DRAW-FLOWERS,PILE,NUM,LEFT,RIGHT,?TMP1,?TMP2,?TMP3,?TMP4
SET 'PILE,1
SET 'NUM,1
CALL2 SAFE-NUMBER?,PILE-TABLE
ZERO? STACK /?PRG4
SET 'LEFT,L-FLOWERS-0
SET 'RIGHT,R-FLOWERS-0
JUMP ?CND1
?PRG4: ADD TEMP-TABLE,2
COPYT PILE-TABLE+2,STACK,8
GET PILE-TABLE,PILE
ZERO? STACK \?CCL8
INC 'PILE
JUMP ?PRG4
?CCL8: GET PILE-TABLE,1 >?TMP4
GET PILE-TABLE,2
ADD ?TMP4,STACK >?TMP3
GET PILE-TABLE,3
ADD ?TMP3,STACK >?TMP2
GET PILE-TABLE,4
ADD ?TMP2,STACK >?TMP1
GET PILE-TABLE,PILE
EQUAL? ?TMP1,STACK \?CCL10
GET PILE-TABLE,PILE >NUM
?REP5: EQUAL? PILE,1 \?CCL18
SET 'LEFT,L-FLOWERS-1
JUMP ?CND16
?CCL10: GET TEMP-TABLE,PILE
SUB STACK,NUM
PUT TEMP-TABLE,PILE,STACK
CALL2 SAFE-NUMBER?,TEMP-TABLE
ZERO? STACK \?REP5
GET PILE-TABLE,PILE
SUB STACK,NUM
ZERO? STACK \?CCL15
SET 'NUM,1
INC 'PILE
JUMP ?PRG4
?CCL15: INC 'NUM
JUMP ?PRG4
?CCL18: EQUAL? PILE,2 \?CCL20
SET 'LEFT,L-FLOWERS-2
JUMP ?CND16
?CCL20: EQUAL? PILE,3 \?CCL22
SET 'LEFT,L-FLOWERS-3
JUMP ?CND16
?CCL22: EQUAL? PILE,4 /?CCL24
SET 'LEFT,0
JUMP ?CND16
?CCL24: SET 'LEFT,L-FLOWERS-4
?CND16: EQUAL? NUM,1 \?CCL27
SET 'RIGHT,R-FLOWERS-1
JUMP ?CND1
?CCL27: EQUAL? NUM,2 \?CCL29
SET 'RIGHT,R-FLOWERS-2
JUMP ?CND1
?CCL29: EQUAL? NUM,3 \?CCL31
SET 'RIGHT,R-FLOWERS-3
JUMP ?CND1
?CCL31: EQUAL? NUM,4 \?CCL33
SET 'RIGHT,R-FLOWERS-4
JUMP ?CND1
?CCL33: EQUAL? NUM,5 \?CCL35
SET 'RIGHT,R-FLOWERS-5
JUMP ?CND1
?CCL35: EQUAL? NUM,6 \?CCL37
SET 'RIGHT,R-FLOWERS-6
JUMP ?CND1
?CCL37: EQUAL? NUM,7 \?CCL39
SET 'RIGHT,R-FLOWERS-7
JUMP ?CND1
?CCL39: EQUAL? NUM,8 \?CCL41
SET 'RIGHT,R-FLOWERS-8
JUMP ?CND1
?CCL41: EQUAL? NUM,9 /?CCL43
SET 'RIGHT,0
JUMP ?CND1
?CCL43: SET 'RIGHT,R-FLOWERS-9
?CND1: SCREEN S-WINDOW
ICALL2 PICINF-PLUS-ONE,L-FLOWERS-PIC-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
DISPLAY LEFT,?TMP1,STACK
ICALL2 PICINF-PLUS-ONE,R-FLOWERS-PIC-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
DISPLAY RIGHT,?TMP1,STACK
SCREEN S-TEXT
RTRUE
.FUNCT SNARFEM,X,NUM,PILE,STOP-SN
?PRG1: ZERO? STOP-SN \TRUE
ZERO? PILE /?CCL7
CLEAR S-TEXT
ZERO? ACTIVE-MOUSE /?CND8
ICALL2 DRAW-SN-BOXES,PILE
?CND8: PRINTI "Type a number "
ZERO? ACTIVE-MOUSE /?CND10
PRINTI "(or click on one of the numbered boxes with your mouse) "
?CND10: PRINTI "to indicate how many pebbles you want to remove from Pile #"
PRINTN PILE
PRINTC 46
?PRG12: INPUT 'X >X
ICALL1 MOUSE-INPUT?
EQUAL? X,CLICK1,CLICK2 \?CCL16
CALL2 SN-CLICK,TRUE-VALUE >X
JUMP ?CND14
?CCL16: GRTR? X,144 \?CCL18
LESS? X,155 \?CCL18
SUB X,145 >X
JUMP ?CND14
?CCL18: SUB X,48 >X
?CND14: GRTR? X,9 /?CTR22
LESS? X,1 \?CCL23
?CTR22: CLEAR S-TEXT
PRINT TYPE-A-NUMBER
PRINTC 57
ZERO? ACTIVE-MOUSE /?CND26
PRINTI " (or click on one of the numbered boxes with your mouse)"
?CND26: PRINTC 46
JUMP ?PRG12
?CCL23: GRTR? X,NUM \?CCL29
CLEAR S-TEXT
PRINTI "There "
EQUAL? NUM,1 \?CCL32
PRINTI "is"
JUMP ?CND30
?CCL32: PRINTI "are"
?CND30: PRINTI " only "
PRINTN NUM
PRINTI " pebble"
EQUAL? NUM,1 /?CND33
PRINTC 115
?CND33: PRINTI " in Pile #"
PRINTN PILE
PRINTC 46
JUMP ?PRG12
?CCL29: CLEAR S-TEXT
PRINTI "You remove "
PRINTN X
PRINTI " pebble"
EQUAL? X,1 /?CND35
PRINTC 115
?CND35: PRINTI " from Pile #"
PRINTN PILE
PRINTC 46
ICALL COUNTDOWN-PILE,PILE,NUM,X
ICALL1 DRAW-FLOWERS
SET 'PILE,FALSE-VALUE
CALL1 END-SN?
ZERO? STACK /?CCL39
SET 'STOP-SN,TRUE-VALUE
FCLEAR FAN,TRYTAKEBIT
CRLF
CRLF
ICALL1 HIT-ANY-KEY
JUMP ?PRG1
?CCL39: CRLF
PRINTI " "
ICALL1 J-MOVE
CALL1 END-SN?
ZERO? STACK /?CCL42
SET 'STOP-SN,TRUE-VALUE
CRLF
CRLF
ICALL1 HIT-ANY-KEY
JUMP ?PRG1
?CCL42: CRLF
PRINTI " "
JUMP ?PRG1
?CCL7: ZERO? ACTIVE-MOUSE /?CND43
ICALL1 DRAW-SN-BOXES
?CND43: PRINTI "Type a number "
ZERO? ACTIVE-MOUSE /?CND45
PRINTI "(or click on one of the numbered boxes with your mouse) "
?CND45: PRINTI "to select the pile from which you'd like to remove a pebble or pebbles."
?PRG47: INPUT 'X >X
ICALL1 MOUSE-INPUT?
EQUAL? X,CLICK1,CLICK2 \?CCL51
CALL1 SN-CLICK >X
JUMP ?CND49
?CCL51: GRTR? X,144 \?CCL53
LESS? X,155 \?CCL53
SUB X,145 >X
JUMP ?CND49
?CCL53: SUB X,48 >X
?CND49: GRTR? X,4 /?CTR57
LESS? X,1 \?CCL58
?CTR57: CLEAR S-TEXT
PRINT TYPE-A-NUMBER
PRINTC 52
ZERO? ACTIVE-MOUSE /?CND61
PRINTI " (or click on one of the numbered boxes with your mouse)"
?CND61: PRINTC 46
JUMP ?PRG47
?CCL58: GET PILE-TABLE,X
ZERO? STACK \?CCL64
CLEAR S-TEXT
PRINTI "There are no longer any pebbles in Pile #"
PRINTN X
PRINTC 46
JUMP ?PRG47
?CCL64: SET 'PILE,X
GET PILE-TABLE,PILE >NUM
JUMP ?PRG1
.FUNCT SN-CLICK,ALREADY-PICKED-PILE,TL-X,TL-Y,BR-X,BR-Y,BOX-WIDTH,BOX-HEIGHT,CNT,HIT-SPOT
SET 'CNT,1
PICINF BOX-1,PICINF-TBL /?BOGUS1
?BOGUS1: GET PICINF-TBL,1 >BOX-WIDTH
GET PICINF-TBL,0 >BOX-HEIGHT
ICALL2 PICINF-PLUS-ONE,BOX-1-LOC
GET PICINF-TBL,1 >TL-X
GET PICINF-TBL,0 >TL-Y
ADD TL-Y,BOX-HEIGHT >BR-Y
PICINF SN-BOX-SPACE,PICINF-TBL /?PRG3
?PRG3: ADD TL-X,BOX-WIDTH >BR-X
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CCL7
SET 'HIT-SPOT,TRUE-VALUE
?REP4: ZERO? HIT-SPOT /?CCL12
RETURN CNT
?CCL7: EQUAL? CNT,9 /?REP4
INC 'CNT
GET PICINF-TBL,1
ADD TL-X,STACK >TL-X
JUMP ?PRG3
?CCL12: ZERO? ALREADY-PICKED-PILE \FALSE
ICALL2 PICINF-PLUS-ONE,PILE-OF-1
GET PICINF-TBL,1 >BOX-WIDTH
GET PICINF-TBL,0 >BOX-HEIGHT
ICALL2 PICINF-PLUS-ONE,PILE-1-PIC-LOC
GET PICINF-TBL,1 >TL-X
GET PICINF-TBL,0 >TL-Y
ADD TL-X,BOX-WIDTH >BR-X
ADD TL-Y,BOX-HEIGHT >BR-Y
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND14
SET 'CNT,1
SET 'HIT-SPOT,TRUE-VALUE
?CND14: ZERO? HIT-SPOT \?CND16
ICALL2 PICINF-PLUS-ONE,PILE-2-PIC-LOC
GET PICINF-TBL,1 >TL-X
GET PICINF-TBL,0 >TL-Y
ADD TL-X,BOX-WIDTH >BR-X
ADD TL-Y,BOX-HEIGHT >BR-Y
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND16
SET 'CNT,2
SET 'HIT-SPOT,TRUE-VALUE
?CND16: ZERO? HIT-SPOT \?CND20
ICALL2 PICINF-PLUS-ONE,PILE-3-PIC-LOC
GET PICINF-TBL,1 >TL-X
GET PICINF-TBL,0 >TL-Y
ADD TL-X,BOX-WIDTH >BR-X
ADD TL-Y,BOX-HEIGHT >BR-Y
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND20
SET 'CNT,3
SET 'HIT-SPOT,TRUE-VALUE
?CND20: ZERO? HIT-SPOT \?CND24
ICALL2 PICINF-PLUS-ONE,PILE-4-PIC-LOC
GET PICINF-TBL,1 >TL-X
GET PICINF-TBL,0 >TL-Y
ADD TL-X,BOX-WIDTH >BR-X
ADD TL-Y,BOX-HEIGHT >BR-Y
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND24
SET 'CNT,4
SET 'HIT-SPOT,TRUE-VALUE
?CND24: ZERO? HIT-SPOT /FALSE
RETURN CNT
.FUNCT COUNTDOWN-PILE,PILE,NUM,X
?PRG1: GET PILE-TABLE,PILE
SUB STACK,1
PUT PILE-TABLE,PILE,STACK
ICALL2 DRAW-PILE,PILE
DEC 'X
ZERO? X \?PRG1
RTRUE
.FUNCT SAFE-NUMBER?,TBL,X,?TMP1,?TMP2,?TMP3
GET TBL,1
GET BINARY-TABLE,STACK >?TMP3
GET TBL,2
GET BINARY-TABLE,STACK
ADD ?TMP3,STACK >?TMP2
GET TBL,3
GET BINARY-TABLE,STACK
ADD ?TMP2,STACK >?TMP1
GET TBL,4
GET BINARY-TABLE,STACK
ADD ?TMP1,STACK >X
MOD X,2
ZERO? STACK \FALSE
DIV X,10
MOD STACK,2
ZERO? STACK \FALSE
DIV X,100
MOD STACK,2
ZERO? STACK \FALSE
DIV X,1000
MOD STACK,2
ZERO? STACK /TRUE
RFALSE
.FUNCT J-MOVE,PILE,NUM,?TMP1,?TMP2,?TMP3,?TMP4
SET 'PILE,1
SET 'NUM,1
PRINTI "The jester peruses the piles, considering his move."
CRLF
CRLF
ICALL1 HIT-ANY-KEY
CLEAR S-TEXT
CALL2 SAFE-NUMBER?,PILE-TABLE
ZERO? STACK /?PRG12
?PRG4: RANDOM 4 >PILE
GET PILE-TABLE,PILE
ZERO? STACK \?REP5
EQUAL? PILE,4 \?CCL11
SET 'PILE,0
JUMP ?PRG4
?CCL11: INC 'PILE
JUMP ?PRG4
?REP5: GET PILE-TABLE,PILE
RANDOM STACK >NUM
JUMP ?CND1
?PRG12: COPYT PILE-TABLE+2,TEMP-TABLE+2,8
GET PILE-TABLE,PILE
ZERO? STACK \?CCL16
INC 'PILE
JUMP ?PRG12
?CCL16: GET PILE-TABLE,1 >?TMP4
GET PILE-TABLE,2
ADD ?TMP4,STACK >?TMP3
GET PILE-TABLE,3
ADD ?TMP3,STACK >?TMP2
GET PILE-TABLE,4
ADD ?TMP2,STACK >?TMP1
GET PILE-TABLE,PILE
EQUAL? ?TMP1,STACK \?CCL18
GET PILE-TABLE,PILE >NUM
?CND1: PRINTI "The jester removes "
PRINTN NUM
PRINTI " pebble"
EQUAL? NUM,1 /?CND24
PRINTC 115
?CND24: PRINTI " from Pile #"
PRINTN PILE
PRINTC 46
GET PILE-TABLE,PILE
ICALL COUNTDOWN-PILE,PILE,STACK,NUM
CALL1 DRAW-FLOWERS
RSTACK
?CCL18: GET TEMP-TABLE,PILE
SUB STACK,NUM
PUT TEMP-TABLE,PILE,STACK
CALL2 SAFE-NUMBER?,TEMP-TABLE
ZERO? STACK \?CND1
GET PILE-TABLE,PILE
SUB STACK,NUM
ZERO? STACK \?CCL23
SET 'NUM,1
INC 'PILE
JUMP ?PRG12
?CCL23: INC 'NUM
JUMP ?PRG12
.FUNCT END-SN?
GET PILE-TABLE,1
ZERO? STACK \FALSE
GET PILE-TABLE,2
ZERO? STACK \FALSE
GET PILE-TABLE,3
ZERO? STACK \FALSE
GET PILE-TABLE,4
ZERO? STACK /TRUE
RFALSE
.FUNCT FAN-F
EQUAL? PRSA,V?POINT \FALSE
EQUAL? P-PRSA-WORD,W?WAVE \FALSE
PRINTR "You produce a light breeze."
.ENDSEG
.ENDI