zorkzero/highway.zap

1393 lines
35 KiB
Plaintext

.SEGMENT "FOOZLE"
.FUNCT CAVE-IN-F,RARG
EQUAL? RARG,M-END \FALSE
IN? PIT-BOMB,LOCAL-GLOBALS \FALSE
ZERO? LIT /FALSE
ICALL2 SETUP-ORPHAN,STR?44
IN? JESTER,HERE /FALSE
SUB MOVES,J-DISPOSED
GRTR? STACK,3 \FALSE
MOVE JESTER,HERE
ICALL2 THIS-IS-IT,JESTER
ICALL2 DEQUEUE,I-JESTER
ICALL1 RETURN-FROM-MAP
PRINTR " The jester is here. ""I'm glad you decided to drop in! As you see, the ceiling decided to drop in some time ago."" He sits cross-legged on a piece of rubble. ""Time for a guessing contest. If you can guess my middle name, I'll give you a prize for winning this game!"""
.SEGMENT "0"
.FUNCT PIT-BOMB-F
EQUAL? PRSA,V?EXAMINE \?CCL3
PRINTR "The grenade-sized bomb bears a large label."
?CCL3: EQUAL? PRSA,V?THROW \FALSE
REMOVE PIT-BOMB
SET 'PIT-BOMB-LOC,HERE
ZERO? LIT /?CCL8
PRINTI "The bomb silently explodes into a growing cloud of bottomless-pit-filling agents. "
JUMP ?CND6
?CCL8: PRINTI "You feel a brief puff of air from the direction in which you threw the bomb. "
?CND6: EQUAL? HERE,PITS \?CCL11
ZERO? LIT \?CCL14
CALL2 JIGS-UP,STR?623
RSTACK
?CCL14: FCLEAR LANTERN,TRYTAKEBIT
FSET PITS,REDESCBIT
SET 'COMPASS-CHANGED,TRUE-VALUE
PRINTI "As the pits fill in, from the bottom up, dark and sinister forms well up and lurk quickly into the shadows. Uncountable hordes of the creatures emerge, and your light glints momentarily off slavering fangs. Gurgling noises come from every dark corner as the last of the pits becomes filled in."
CRLF
ICALL2 INC-SCORE,12
CRLF
CALL1 V-LOOK
RSTACK
?CCL11: PRINTR "The agents, finding no bottomless pits here, disperse."
.ENDSEG
.SEGMENT "FOOZLE"
.FUNCT TOLL-PLAZA-F,RARG
EQUAL? RARG,M-LOOK \FALSE
PRINTI "You have reached one of numerous Great Underground Highway system tolls. "
FSET? TOLL-GATE,OPENBIT \?CCL6
PRINTI "The gate lies open to the south"
JUMP ?CND4
?CCL6: PRINTI "A closed toll gate spans the road"
?CND4: PRINTI ". The toll booth is unoccupied, but a sign next to the gate indicates an ""exact change"" option."
RTRUE
.FUNCT TOLL-BOOTH-F
EQUAL? PRSA,V?ENTER \?CCL3
PRINTR "An invisible force stops you."
?CCL3: EQUAL? PRSA,V?EXAMINE \FALSE
PRINTR "The booth is unmanned, but there is an ""exact change"" basket on the side of the booth."
.FUNCT TOLL-GATE-F
EQUAL? PRSA,V?OPEN \?PRD5
FSET? TOLL-GATE,OPENBIT \?CCL3
?PRD5: EQUAL? PRSA,V?CLOSE \FALSE
FSET? TOLL-GATE,OPENBIT \FALSE
?CCL3: PRINT WONT-BUDGE
RTRUE
.FUNCT BASKET-F
EQUAL? PRSA,V?CLOSE \?CCL3
PRINT HUH
RTRUE
?CCL3: EQUAL? PRSA,V?PUT \FALSE
EQUAL? PRSO,ZORKMID-COIN \FALSE
REMOVE ZORKMID-COIN
FSET TOLL-GATE,OPENBIT
PRINTI """Bink!"" The toll gate opens, and a poorly maintained sign lights up momentarily, saying ""T ANK Y U!"""
CRLF
CALL2 INC-SCORE,14
RSTACK
.FUNCT FISSURE-PS
EQUAL? PRSA,V?ENTER \?CCL3
CALL2 DO-WALK,P?DOWN
RSTACK
?CCL3: EQUAL? PRSA,V?CROSS \FALSE
CALL2 DO-WALK,P?SOUTH
RSTACK
.FUNCT FISSURE-CRACK-PS
EQUAL? PRSA,V?EXAMINE \?CCL3
PRINTR "You could probably squeeze into it."
?CCL3: EQUAL? PRSA,V?LOOK-INSIDE \?CCL5
CALL2 LIT?,TIGHT-SQUEEZE
ZERO? STACK /?CCL8
PRINT SOME-LIGHT
RTRUE
?CCL8: PRINT ONLY-BLACKNESS
RTRUE
?CCL5: EQUAL? PRSA,V?ENTER \FALSE
CALL2 DO-WALK,P?EAST
RSTACK
.FUNCT ICE-PS
PRINTR "[This is just one of those things that's there to enhance your mental imagery.]"
.SEGMENT "0"
.FUNCT ORB-F
EQUAL? PRSA,V?TAKE \?CCL3
FSET PRSO,TRYTAKEBIT
FCLEAR GLITTERY-ORB,NDESCBIT
FCLEAR FIERY-ORB,NDESCBIT
FCLEAR SMOKY-ORB,NDESCBIT
FCLEAR MILKY-ORB,TRYTAKEBIT
FCLEAR GLITTERY-ORB,TRYTAKEBIT
FCLEAR FIERY-ORB,TRYTAKEBIT
FCLEAR SMOKY-ORB,TRYTAKEBIT
FSET MILKY-ORB,TOUCHBIT
FSET GLITTERY-ORB,TOUCHBIT
FSET FIERY-ORB,TOUCHBIT
FSET SMOKY-ORB,TOUCHBIT
RFALSE
?CCL3: EQUAL? PRSA,V?EXAMINE \?CCL7
PRINTI "The orb is a sphere of lustrous crystal without imperfection."
ZERO? TIME-STOPPED \?CCL10
PRINTC 32
ICALL PERFORM,V?LOOK-INSIDE,PRSO
RTRUE
?CCL10: CRLF
RTRUE
?CCL7: EQUAL? PRSA,V?LOOK-INSIDE \?CCL12
ZERO? TIME-STOPPED /?CCL15
PRINTI "The sphere has"
JUMP ?CND13
?CCL15: PRINTI "Deep within the cool, smooth surface of the orb lies an ever-shifting dance of "
EQUAL? PRSO,GLITTERY-ORB \?CCL18
PRINTI "sparkling stars"
JUMP ?CND16
?CCL18: EQUAL? PRSO,FIERY-ORB \?CCL20
PRINTI "flickering flames"
JUMP ?CND16
?CCL20: EQUAL? PRSO,SMOKY-ORB \?CCL22
PRINTI "swirling smoke"
JUMP ?CND16
?CCL22: PRINTI "milky mists"
?CND16: PRINTI ", giving the sphere"
?CND13: PRINTI " a generally "
EQUAL? PRSO,GLITTERY-ORB \?CCL25
PRINTI "golden"
JUMP ?CND23
?CCL25: EQUAL? PRSO,FIERY-ORB \?CCL27
PRINTI "orange"
JUMP ?CND23
?CCL27: EQUAL? PRSO,SMOKY-ORB \?CCL29
PRINTI "gray"
JUMP ?CND23
?CCL29: PRINTI "white"
?CND23: PRINTR " complexion."
?CCL12: EQUAL? PRSA,V?MUNG \FALSE
EQUAL? PRSO,SMOKY-ORB,FIERY-ORB,MILKY-ORB /?CCL31
EQUAL? PRSO,GLITTERY-ORB \FALSE
?CCL31: REMOVE PRSO
PRINTI "You "
EQUAL? PRSO,MILKY-ORB \?CCL38
PRINTI "feel a puff of cool, caressing air"
JUMP ?CND36
?CCL38: EQUAL? PRSO,FIERY-ORB \?CCL40
PRINTI "feel a hot dry blast of air"
JUMP ?CND36
?CCL40: EQUAL? PRSO,SMOKY-ORB \?CCL42
PRINTI "smell a dry burnt odor"
JUMP ?CND36
?CCL42: PRINTI "see a burst of twinkling lights"
?CND36: PRINTR " as the orb is shattered to dust."
.ENDSEG
.SEGMENT "FOOZLE"
.FUNCT REST-STOP-PS
EQUAL? PRSA,V?ENTER,V?EXAMINE \?CCL3
PRINTR "The rest stop is all shuttered up."
?CCL3: EQUAL? PRSA,V?OPEN \?CCL5
PRINT CARPENTERS
RTRUE
?CCL5: EQUAL? PRSA,V?SEARCH \FALSE
PRINTR "You're outside it!"
.FUNCT SHUTTER-PS
EQUAL? PRSA,V?REMOVE,V?TAKE \?CCL3
PRINT CARPENTERS
RTRUE
?CCL3: EQUAL? PRSA,V?CLOSE \FALSE
PRINTR "They are!"
.FUNCT FISHING-VILLAGE-F,RARG
EQUAL? RARG,M-ENTER \FALSE
FSET? FISHING-VILLAGE,TOUCHBIT /?CND4
RANDOM 100 >INQ-NUMBER
RANDOM 3
ADD STACK,2 >NUMBER-ON-LINE
?CND4: CALL QUEUE,I-INQ,-1
RSTACK
.FUNCT I-INQ,NEW-PERSONS,DOABLE
EQUAL? HERE,INQUISITION,FISHING-VILLAGE /?CCL3
ICALL2 DEQUEUE,I-INQ
RFALSE
?CCL3: LESS? NUMBER-ON-LINE,3 /?CCL4
RANDOM 100
LESS? 75,STACK /?PRD7
EQUAL? NUMBER-ON-LINE,3 /?CCL4
?PRD7: RANDOM 100
LESS? 50,STACK /?PRD10
EQUAL? NUMBER-ON-LINE,4 /?CCL4
?PRD10: RANDOM 100
LESS? 25,STACK /?CND1
EQUAL? NUMBER-ON-LINE,5 \?CND1
?CCL4: RANDOM 100
LESS? 50,STACK /?CCL17
SET 'NEW-PERSONS,1
JUMP ?CND15
?CCL17: RANDOM 100
LESS? 80,STACK /?CCL19
SET 'NEW-PERSONS,2
JUMP ?CND15
?CCL19: SET 'NEW-PERSONS,3
?CND15: ADD NUMBER-ON-LINE,NEW-PERSONS >NUMBER-ON-LINE
?CND1: INC 'INQ-NUMBER
EQUAL? HERE,FISHING-VILLAGE \?CCL22
GRTR? NEW-PERSONS,0 \?CCL22
ICALL1 RETURN-FROM-MAP
PRINTI " A trollish guard drags "
EQUAL? NEW-PERSONS,1 \?CCL27
PRINTI "someone"
JUMP ?CND25
?CCL27: EQUAL? NEW-PERSONS,2 \?CCL29
PRINTI "two people"
JUMP ?CND25
?CCL29: PRINTI "three people"
?CND25: PRINTR ", kicking and screaming, into the stone building."
?CCL22: EQUAL? HERE,INQUISITION \?CND20
GRTR? NEW-PERSONS,0 \?CND20
ICALL1 RETURN-FROM-MAP
PRINTI " A trollish guard drags in "
EQUAL? NEW-PERSONS,1 \?CCL35
PRINTI "someone"
JUMP ?CND33
?CCL35: EQUAL? NEW-PERSONS,2 \?CCL37
PRINTI "two people"
JUMP ?CND33
?CCL37: PRINTI "three people"
?CND33: PRINTI ", who obediently take"
EQUAL? NEW-PERSONS,1 \?CCL40
PRINTI "s a number"
JUMP ?CND38
?CCL40: PRINTI " numbers"
?CND38: PRINTI " from the number dispenser."
CRLF
?CND20: EQUAL? HERE,INQUISITION \FALSE
ICALL1 RETURN-FROM-MAP
GRTR? NUMBER-TAKEN,0 \?CND44
GRTR? INQ-NUMBER,NUMBER-TAKEN \?CND44
ICALL2 JIGS-UP,STR?637
?CND44: PRINTI " The executioner calls out, ""Number "
PRINTN INQ-NUMBER
PRINTI "!"" and "
EQUAL? INQ-NUMBER,NUMBER-TAKEN \?CCL50
PRINTI "looks at you with an ugly grin"
JUMP ?CND48
?CCL50: RANDOM 100
LESS? 20,STACK /?CCL52
ZERO? J-INQ-SCENE \?CCL52
FSET? JESTER,TOUCHBIT \?CCL52
SET 'J-INQ-SCENE,TRUE-VALUE
PRINTI "you suddenly realize that the next person on line is the jester! He is acting like a first-class sinner: smoking and drinking, using foul language, with a curvaceous woman in each arm and a pocketful of gambling receipts. He strides forward and makes a particularly salacious request -- something involving Vaseline and barnyard animals. His request denied, he is led to the block, but just as the axe is swinging down, the jester turns into a wisp of smoke and vanishes! The executioner spits angrily"
JUMP ?CND48
?CCL52: DEC 'NUMBER-ON-LINE
PRINTI "a bedraggled man steps forward. ""Executioner, "
RANDOM 100
LESS? 50,STACK /?CCL58
SET 'DOABLE,TRUE-VALUE
CALL2 PICK-ONE,DOABLE-REQUESTS
PRINT STACK
JUMP ?CND56
?CCL58: CALL2 PICK-ONE,UNDOABLE-REQUESTS
PRINT STACK
?CND56: PRINTI ","" he croaks. The executioner says, """
ZERO? DOABLE /?CCL61
PRINTI "Done!"" and the man is led to the gallows and hung from the neck until dead"
JUMP ?CND48
?CCL61: PRINTI "Sorry, can't do that."" The man is placed on the block, and a moment later his head is rolling away"
?CND48: PRINT PERIOD-CR
RTRUE
.FUNCT INQUISITION-F,RARG,OWINNER,TAKER
EQUAL? RARG,M-LOOK \?CCL3
FSET? INQUISITION,TOUCHBIT /?CND4
PRINTI "Extremist religions spring up whenever an empire collapses. The Inquisitors believe the impending doom was caused by widespread sinning, but that the gods can be placated if every person in the kingdom is executed."
CRLF
PRINTI " "
?CND4: PRINTI "This is one of the Inquisitors' execution sites. A hooded executioner, dripping with sweat and blood, stands between a gallows and a block. "
PRINTN NUMBER-ON-LINE
PRINTI " people are queued up in front of the executioner. "
GRTR? NUMBER-TAKEN,0 \?CND6
PRINTI "You are "
SUB NUMBER-TAKEN,INQ-NUMBER
EQUAL? STACK,7 \?CCL10
PRINTI "seventh"
JUMP ?CND8
?CCL10: SUB NUMBER-TAKEN,INQ-NUMBER
EQUAL? STACK,6 \?CCL12
PRINTI "sixth"
JUMP ?CND8
?CCL12: SUB NUMBER-TAKEN,INQ-NUMBER
EQUAL? STACK,5 \?CCL14
PRINTI "fifth"
JUMP ?CND8
?CCL14: SUB NUMBER-TAKEN,INQ-NUMBER
EQUAL? STACK,4 \?CCL16
PRINTI "fourth"
JUMP ?CND8
?CCL16: SUB NUMBER-TAKEN,INQ-NUMBER
EQUAL? STACK,3 \?CCL18
PRINTI "third"
JUMP ?CND8
?CCL18: SUB NUMBER-TAKEN,INQ-NUMBER
EQUAL? STACK,2 \?CCL20
PRINTI "second"
JUMP ?CND8
?CCL20: PRINTI "first"
?CND8: PRINTI " on line. "
?CND6: PRINTI "Near the end of the line is a number dispenser. A large sign fills one wall. The only exit is south."
RTRUE
?CCL3: EQUAL? RARG,M-END \FALSE
ICALL1 RETURN-FROM-MAP
ZERO? INQ-SCORE \?CND23
PRINTI " The executioner spots you. ""Get that joker outta here!"" Guards fling you back onto the street."
CRLF
CRLF
ICALL2 GOTO,FISHING-VILLAGE
RTRUE
?CND23: SET 'OWINNER,WINNER
SET 'WINNER,EXECUTIONER
CALL2 VISIBLE?,PIGEON
ZERO? STACK /?CND25
PRINTI " One of the guards says, ""Sorry, you'll have to leave your pigeon outside."" He grabs it and "
CALL2 META-LOC,PERCH
EQUAL? STACK,HERE \?CCL29
PRINTI "tosses it outside"
CALL FIND-IN,FISHING-VILLAGE,WHITEBIT >TAKER
ZERO? TAKER \?CTR31
CALL FIND-IN,FISHING-VILLAGE,BLACKBIT >TAKER
ZERO? TAKER /?CCL32
?CTR31: MOVE PIGEON,TAKER
PRINTI ". A moment later,"
ICALL2 TPRINT,TAKER
PRINTI " materializes in the Inquisition building, holding the perch! The executioner bellows, ""Hey! We don't want any of your kind in here, buster!"" A guard gives"
ICALL2 TPRINT,TAKER
PRINTI " the boot."
CRLF
JUMP ?CND27
?CCL32: MOVE PIGEON,FISHING-VILLAGE
JUMP ?CND27
?CCL29: CALL2 META-LOC,PERCH
MOVE PIGEON,STACK
PRINTI "looks stunned as he recedes and vanishes, along with the pigeon"
?CND27: PRINT PERIOD-CR
?CND25: CALL2 VISIBLE?,CLOAK
ZERO? STACK /?CND35
CALL FIND-IN,FISHING-VILLAGE,WHITEBIT >TAKER
ZERO? TAKER \?CTR38
CALL FIND-IN,FISHING-VILLAGE,BLACKBIT >TAKER
ZERO? TAKER /?CCL39
?CTR38: MOVE CLOAK,TAKER
JUMP ?CND37
?CCL39: MOVE CLOAK,FISHING-VILLAGE
?CND37: PRINTI " A particularly surly-looking guard says, ""Check your cloak in our coat room, haw haw haw."" He grabs the cloak and kicks it through the door."
CRLF
?CND35: SET 'WINNER,OWINNER
LESS? NUMBER-TAKEN,-2 \?CCL44
CALL2 JIGS-UP,STR?645
RSTACK
?CCL44: LESS? NUMBER-TAKEN,1 \FALSE
ZERO? NUMBER-TAKEN /?CND47
PRINTI " A guard pokes you with his spear. ""Hey, take a number."""
CRLF
?CND47: DEC 'NUMBER-TAKEN
RETURN NUMBER-TAKEN
.SEGMENT "0"
.FUNCT TICKET-F
EQUAL? PRSA,V?TAKE \?CCL3
EQUAL? HERE,INQUISITION \?CCL3
GRTR? NUMBER-TAKEN,0 /?CCL8
ADD INQ-NUMBER,NUMBER-ON-LINE >NUMBER-TAKEN
FCLEAR TICKET,NDESCBIT
FCLEAR TICKET,TRYTAKEBIT
MOVE TICKET,PROTAGONIST
PRINTI "You get number "
PRINTN NUMBER-TAKEN
PRINT PERIOD-CR
RTRUE
?CCL8: CALL NOUN-USED?,TICKET,W?NUMBER
ZERO? STACK /FALSE
PRINTR "A guard lightly bludgeons your hand. ""One number per person!"""
?CCL3: EQUAL? PRSA,V?EXAMINE,V?READ \FALSE
FSET? TICKET,NDESCBIT \?CCL15
PRINTR "You haven't taken one yet!"
?CCL15: PRINTI "The ticket has a large number """
PRINTN NUMBER-TAKEN
PRINTR """ on it. In smaller type, it says, ""Frobozz Magic Inquisition Numbered Ticket Company."""
.FUNCT SQUID-REPELLENT-F
EQUAL? PRSA,V?SMELL,V?TASTE \FALSE
PRINTR "Not being a squid, you're not repelled."
.ENDSEG
.SEGMENT "FOOZLE"
.FUNCT EXECUTIONER-F,ARG
EQUAL? ARG,M-WINNER \FALSE
EQUAL? NUMBER-TAKEN,INQ-NUMBER \?CCL6
EQUAL? PRSA,V?BEHEAD \?PRD11
EQUAL? PRSO,ME /?CTR8
?PRD11: EQUAL? PRSA,V?CUT \?CCL9
EQUAL? PRSO,HEAD \?CCL9
CALL ADJ-USED?,HEAD,W?MY,W?MINE,FALSE-VALUE
ZERO? STACK /?CCL9
?CTR8: PRINTI "The executioner says, ""Hey, sure! Easy request! I can behead ya!"" Then a confused look creeps over his face. ""But if I behead ya, then I done granted yer last wish, and I gotta hang ya! But if I hang ya, I ain't granted yer wish, and I gotta behead ya! But..."" He trails off. ""Guards, throw this wise guy outta here!"" Guards surround you and escort you out."
CRLF
ICALL2 INC-SCORE,INQ-SCORE
SET 'INQ-SCORE,0
CRLF
CALL2 GOTO,FISHING-VILLAGE
RSTACK
?CCL9: CALL1 DOABLE-REQUEST
ZERO? STACK /?CCL18
CALL2 JIGS-UP,STR?649
RSTACK
?CCL18: CALL1 UNDOABLE-REQUEST
ZERO? STACK \?CTR19
RANDOM 100
LESS? 50,STACK /?CCL20
?CTR19: CALL2 JIGS-UP,STR?650
RSTACK
?CCL20: CALL2 JIGS-UP,STR?649
RSTACK
?CCL6: PRINTI """Shut up until your number is called!"""
CRLF
CALL1 STOP
RSTACK
.FUNCT DOABLE-REQUEST
EQUAL? PRSA,V?KILL,V?KICK,V?KISS /?PRD5
EQUAL? PRSA,V?HANG \?CCL3
?PRD5: EQUAL? PRSO,ME /TRUE
?CCL3: EQUAL? PRSA,V?SING \FALSE
EQUAL? PRSO,LULLABY /TRUE
RFALSE
.FUNCT UNDOABLE-REQUEST
EQUAL? PRSA,V?GIVE \?CCL3
EQUAL? PRSO,ME \?CCL3
EQUAL? PRSI,THOUSAND-ZORKMIDS,POSTER /TRUE
?CCL3: EQUAL? PRSA,V?UNTIE,V?SEND \?CCL8
EQUAL? PRSO,ME /TRUE
?CCL8: EQUAL? PRSA,V?POINT \?CCL12
EQUAL? PRSO,WAND \?CCL12
EQUAL? PRSI,ME /TRUE
?CCL12: EQUAL? PRSA,V?WEAR \?CCL17
EQUAL? PRSO,RING /TRUE
?CCL17: EQUAL? PRSA,V?CUT \?CCL21
EQUAL? PRSO,HEAD \?CCL21
CALL2 GET-OWNER,HEAD
EQUAL? STACK,EXECUTIONER /TRUE
?CCL21: EQUAL? PRSA,V?KILL \FALSE
EQUAL? PRSO,EXECUTIONER /TRUE
RFALSE
.FUNCT CASINO-F,RARG
EQUAL? RARG,M-END \FALSE
IN? BROOM,LOCAL-GLOBALS \FALSE
IN? JESTER,HERE /FALSE
MOVE JESTER,HERE
ICALL2 DEQUEUE,I-JESTER
ICALL2 THIS-IS-IT,JESTER
ICALL1 RETURN-FROM-MAP
PRINTI " You do a "
SUB MOVES,J-DISPOSED
LESS? STACK,4 \?CCL9
PRINTI "triple"
JUMP ?CND7
?CCL9: PRINTI "double"
?CND7: PRINTR " take as you notice the jester at the card table, grandly shuffling a thick deck. ""I don't wear any Gucci, I can't dance the hootchy-kootchy, I've never been good at the old smoochie-woochie, but I sure am a whiz at Double Fanucci! When I start to deal, the tension is real; if you can stand the heat, pull up a seat!"" He motions for you to sit down at the table."
.FUNCT DOUBLE-FANUCCI-F
EQUAL? PRSA,V?PLAY \FALSE
EQUAL? HERE,CASINO \?CCL6
IN? JESTER,HERE \?CCL6
IN? BROOM,LOCAL-GLOBALS \?CCL6
LOC PROTAGONIST
EQUAL? STACK,CARD-TABLE \?CCL12
ICALL1 F-START
RTRUE
?CCL12: ICALL PERFORM,V?ENTER,CARD-TABLE
RTRUE
?CCL6: PRINTR "You don't have a pack of Fanucci cards; besides, there's no solitaire version of Double Fanucci."
.FUNCT CARD-TABLE-F,VARG
EQUAL? VARG,M-ENTER \?CCL3
IN? BROOM,LOCAL-GLOBALS \?CCL3
CALL1 F-START
RSTACK
?CCL3: ZERO? VARG \FALSE
EQUAL? PRSA,V?EXAMINE \FALSE
PRINTI "It's a pretty plain and ordinary card table."
FIRST? CARD-TABLE \?CCL12
PRINTI " Sitting on the card table is"
ICALL1 D-NOTHING
RTRUE
?CCL12: CRLF
RTRUE
.FUNCT F-START,MARGIN
PRINTI " The jester begins dealing. ""We'll be playing according to Revised Miznian Rules, Seventh-Level Amendments, with these exceptions: no side-handling after an underfunded discard, two draws after a Skybreaker, and an extra muttonation if the conditions of Rule 17.4.1.B are met. Oh, also all the house rules adopted by the Fanucci Casino Rebuilding Act of 817."
CRLF
CRLF
ICALL2 HIT-ANY-KEY,STR?655
ICALL1 SETUP-CARDS
ICALL1 SETUP-FANUCCI
ICALL1 FANUCCI
SCREEN S-WINDOW
FONT 1
SCREEN S-TEXT
CRLF
CRLF
ICALL1 HIT-ANY-KEY
ICALL2 INIT-SL-WITH-SPLIT,TEXT-WINDOW-PIC-LOC
FSET? BROOM,TRYTAKEBIT \?CCL3
PUT DRAW-CARDS-TABLE,0,1
PUT DRAW-CARDS-TABLE,1,1
PUT DRAW-CARDS-TABLE,2,1
PUT DRAW-CARDS-TABLE,3,1
PUT DRAW-CARDS-TABLE,4,1
PRINTI """W"
GRTR? F-PLAYS,5 \?CCL6
PRINTI "he"
JUMP ?CND4
?CCL6: PRINTC 111
?CND4: PRINTI "w!"" says the jester. """
GRTR? F-PLAYS,5 \?CCL9
PRINTR "You really had me on the ropes at a few points there!"""
?CCL9: PRINTR "I wasn't expecting such an early resignation! I'm amazed by my own Fanucci prowess!"""
?CCL3: MOVE BROOM,CARD-TABLE
ICALL1 REMOVE-J
PRINTI """Great Zilbo's Ghost! Three undertrumps after a Trebled Fromp discard! That's indefensible!"" In the time-honored tradition of Double Fanucci matches, the jester leaps over the card table to congratulate you. ""You've swept me away! You've truly cleaned up today!"" He rifles through his wallet and removes a broom, which he lays on the card table. ""Here are your winnings!"" In a wink, the jester is gone."""
CRLF
CRLF
CALL2 INC-SCORE,18
RSTACK
.FUNCT SETUP-CARDS
ICALL SPLIT-BY-PICTURE,F-SPLIT,TRUE-VALUE
ICALL2 ADJUST-TEXT-WINDOW,F-BOTTOM
CLEAR S-FULL
ICALL2 PICK-RANK,0
RANDOM 15
PUT F-CARD-TABLE,1,STACK
ICALL2 PICK-RANK,2
RANDOM 15
PUT F-CARD-TABLE,3,STACK
ICALL2 PICK-RANK,4
RANDOM 15
PUT F-CARD-TABLE,5,STACK
ICALL2 PICK-RANK,6
RANDOM 15
PUT F-CARD-TABLE,7,STACK
ICALL2 PICK-RANK,8
RANDOM 15
PUT F-CARD-TABLE,9,STACK
SET 'J-SCORE,0
SET 'YOUR-SCORE,0
SET 'F-PLAYS,0
RETURN F-PLAYS
.FUNCT SETUP-FANUCCI,MARGIN,CARD-NUM-Y,DISCARD-X,CARD-NUM-1-X,CARD-SPACE,?TMP2,?TMP1
SCREEN S-FULL
DISPLAY F-BORDER,1,1
SCREEN S-WINDOW
PICSET F-PICSET-TBL
FONT 4
ICALL2 PICINF-PLUS-ONE,J-SCORE-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
CURSET ?TMP1,STACK
PRINTI "Jester's Score:"
ICALL2 PICINF-PLUS-ONE,YOUR-SCORE-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
CURSET ?TMP1,STACK
PRINTI "Your Score:"
ICALL2 PICINF-PLUS-ONE,F-DISCARD-LOC
GET PICINF-TBL,0 >CARD-NUM-Y
GET PICINF-TBL,1 >DISCARD-X
ICALL2 PICINF-PLUS-ONE,F-CARD-1-LOC
GET PICINF-TBL,1 >CARD-NUM-1-X
PICINF F-CARD-SPACE,PICINF-TBL /?BOGUS1
?BOGUS1: GET PICINF-TBL,1 >CARD-SPACE
ICALL1 UPDATE-SCORES
ICALL1 DRAW-CARDS
CURSET CARD-NUM-Y,DISCARD-X
PRINTI "DISCARD"
CURSET CARD-NUM-Y,CARD-NUM-1-X
PRINTC 49
ADD CARD-NUM-1-X,CARD-SPACE
CURSET CARD-NUM-Y,STACK
PRINTC 50
MUL CARD-SPACE,2
ADD CARD-NUM-1-X,STACK
CURSET CARD-NUM-Y,STACK
PRINTC 51
MUL CARD-SPACE,3
ADD CARD-NUM-1-X,STACK
CURSET CARD-NUM-Y,STACK
PRINTC 52
ICALL2 PICINF-PLUS-ONE,F-MENU-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1
CURSET ?TMP1,STACK
PRINTI " DRAW REVERSE COMBINE SINGLE-PLAY IONIZE"
GET PICINF-TBL,0
ADD STACK,FONT-Y >?TMP1
GET PICINF-TBL,1
CURSET ?TMP1,STACK
PRINTI " DISCARD TRUMP PASS DOUBLE-PLAY CHEAT"
GET PICINF-TBL,0 >?TMP2
MUL FONT-Y,2
ADD ?TMP2,STACK >?TMP1
GET PICINF-TBL,1
CURSET ?TMP1,STACK
PRINTI " DIVIDE UNDERTRUMP OVERPASS MUTTONATE RESIGN"
SCREEN S-TEXT
CURSET 1,1
RTRUE
.FUNCT DRAW-CARDS,X,CNT,?TMP1
?PRG1: GRTR? CNT,4 /?CCL5
GET F-PIC-LOCS,CNT >X
JUMP ?CND3
?CCL5: GET F-PIC-LOCS,4 >X
?CND3: ICALL2 PICINF-PLUS-ONE,X
GET PICINF-TBL,1 >X
EQUAL? CNT,5 /TRUE
GET DRAW-CARDS-TABLE,CNT
EQUAL? STACK,1 \?CND6
PUT DRAW-CARDS-TABLE,CNT,0
MUL CNT,2 >?TMP1
MUL CNT,2
ADD STACK,1
ICALL DRAW-CARD,X,?TMP1,STACK
?CND6: INC 'CNT
JUMP ?PRG1
.FUNCT PICK-RANK,NUM
RANDOM 100
LESS? PICTURE-CARD-PROB,STACK /?CCL3
RANDOM 9
ADD 11,STACK
JUMP ?CND1
?CCL3: RANDOM 11
?CND1: PUT F-CARD-TABLE,NUM,STACK
RTRUE
.FUNCT DISPLAY-OFFSET,PIC,Y,X,OFFPIC,?TMP1
PICINF OFFPIC,PICINF-TBL /?BOGUS1
?BOGUS1: GET PICINF-TBL,0
ADD STACK,Y >?TMP1
GET PICINF-TBL,1
ADD STACK,X
DISPLAY PIC,?TMP1,STACK
RTRUE
.FUNCT DRAW-CARD,X,RANK,SUIT,Y,PIC
GET F-CARD-TABLE,RANK >RANK
GET F-CARD-TABLE,SUIT >SUIT
GET PICINF-TBL,0 >Y
ZERO? RANK \?CCL3
DISPLAY F-CARD-BACK,Y,X
RTRUE
?CCL3: GRTR? RANK,11 \?CCL5
SUB RANK,12
GET F-FACE-CARD-PIC-TBL,STACK >PIC
DISPLAY PIC,Y,X
RTRUE
?CCL5: DISPLAY F-CARD,Y,X
GET RANK-PIC-TBL,RANK
ICALL DISPLAY-OFFSET,STACK,Y,X,F-RANK-PIC-LOC
GET RANK-REV-TBL,RANK
ICALL DISPLAY-OFFSET,STACK,Y,X,F-REV-RANK-PIC-LOC
GET SUIT-PIC-TBL,SUIT
ICALL DISPLAY-OFFSET,STACK,Y,X,F-SUIT-PIC-LOC
GET SUIT-REV-TBL,SUIT
CALL DISPLAY-OFFSET,STACK,Y,X,F-REV-SUIT-PIC-LOC
RSTACK
.FUNCT FANUCCI,X,Y,PTR
ICALL2 PICINF-PLUS-ONE,F-MENU-LOC
GET PICINF-TBL,1 >X
GET PICINF-TBL,0 >Y
SET 'PTR,0
ICALL BOLD-MOVE,X,Y,PTR
CLEAR S-TEXT
PRINTI "Use the arrow keys -- or the U, D, L and R keys -- to highlight a play, then hit the RETURN/ENTER key. Or, if you have a mouse, you can use that to select your play."
?PRG1: CALL PICK-PLAY,X,Y,PTR
ZERO? STACK \TRUE
SCREEN S-WINDOW
ICALL1 DRAW-CARDS
ICALL1 UPDATE-SCORES
SCREEN S-TEXT
EQUAL? F-WIN-COUNT,3 \?CCL7
ADD YOUR-SCORE,1000 >YOUR-SCORE
FCLEAR BROOM,TRYTAKEBIT
RTRUE
?CCL7: CALL1 SCORE-CHECK
ZERO? STACK \TRUE
ICALL1 J-PLAY
SCREEN S-WINDOW
ICALL1 DRAW-CARDS
INC 'F-PLAYS
ICALL1 UPDATE-SCORES
SCREEN S-TEXT
CALL1 SCORE-CHECK
ZERO? STACK /?PRG1
RTRUE
.FUNCT UPDATE-SCORES,?TMP2,?TMP1
ICALL2 PICINF-PLUS-ONE,J-SCORE-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1 >?TMP2
MUL FONT-X,16
ADD ?TMP2,STACK
CURSET ?TMP1,STACK
LESS? J-SCORE,10 \?CCL3
PRINTI " 00"
JUMP ?CND1
?CCL3: LESS? J-SCORE,100 \?CCL5
PRINTI " 0"
JUMP ?CND1
?CCL5: LESS? J-SCORE,1000 \?CND1
PRINTC 32
?CND1: PRINTN J-SCORE
ICALL2 PICINF-PLUS-ONE,YOUR-SCORE-LOC
GET PICINF-TBL,0 >?TMP1
GET PICINF-TBL,1 >?TMP2
MUL FONT-X,12
ADD ?TMP2,STACK
CURSET ?TMP1,STACK
LESS? YOUR-SCORE,10 \?CCL9
PRINTI " 00"
JUMP ?CND7
?CCL9: LESS? YOUR-SCORE,100 \?CCL11
PRINTI " 0"
JUMP ?CND7
?CCL11: LESS? YOUR-SCORE,1000 \?CND7
PRINTC 32
?CND7: PRINTN YOUR-SCORE
RTRUE
.FUNCT SCORE-CHECK
GRTR? J-SCORE,YOUR-SCORE \?CCL3
SUB J-SCORE,YOUR-SCORE
GRTR? STACK,1241 \FALSE
PRINTI """My"
JUMP ?CND1
?CCL3: SUB YOUR-SCORE,J-SCORE
GRTR? STACK,1241 \FALSE
PRINTI """Your"
?CND1: PRINTR " lead exceeds 1241 points,"" the jester explains, ""so by Rules Committee Amendment #493, the game is suspended and must be replayed in its entirety, except during a Frotz Moon or in a six-player game where at least three of the players are of Mithican ancestry.""
The jester sighs. ""It's always ironic to play for so long without reaching a decision. I'm sure that the great humorist, O'Flathead, would get a chuckle out of our predicament."""
.FUNCT J-PLAY,PLAY-NUM,RANK,SUIT,NUM
PRINTI "
Your opponent stares at his "
PRINTN J-CARDS
PRINTI " card"
EQUAL? J-CARDS,1 /?CND1
PRINTC 115
?CND1: PRINTI ", pondering his move. "
ICALL1 HIT-ANY-KEY
CLEAR S-TEXT
PRINTI "The jester "
LESS? J-CARDS,2 /?CTR4
EQUAL? J-CARDS,2 \?PRD8
RANDOM 100
LESS? 67,STACK \?CTR4
?PRD8: EQUAL? J-CARDS,2 \?CCL5
RANDOM 100
LESS? 33,STACK /?CCL5
?CTR4: INC 'J-CARDS
PRINTI "decides to draw. He seems "
RANDOM 100
LESS? 8,STACK /?CND13
PRINTI "extremely "
?CND13: RANDOM 100
LESS? 50,STACK /?CCL17
PRINTI "delighted"
JUMP ?CND15
?CCL17: PRINTI "dismayed"
?CND15: PRINTI " by his new card."
RTRUE
?CCL5: DEC 'J-CARDS
ADD J-DISCARD-FROMP-PROB,2 >J-DISCARD-FROMP-PROB
PRINTI "proceeds to "
RANDOM 100
LESS? J-DISCARD-FROMP-PROB,STACK /?CCL20
SET 'J-DISCARD-FROMP-PROB,0
SET 'PLAY-NUM,1
SET 'SUIT,FROMP-SUIT
SET 'RANK,TREBLED-RANK
JUMP ?CND18
?CCL20: RANDOM 12 >PLAY-NUM
RANDOM 15 >SUIT
RANDOM 100
LESS? PICTURE-CARD-PROB,STACK /?CCL23
RANDOM 9
ADD 11,STACK >RANK
JUMP ?CND18
?CCL23: RANDOM 11 >RANK
?CND18: PUT J-LAST-CARD,0,RANK
PUT J-LAST-CARD,1,SUIT
MUL PLAY-NUM,SUIT
MUL STACK,RANK
MOD STACK,17 >NUM
EQUAL? PLAY-NUM,1 \?CND24
PUT DRAW-CARDS-TABLE,0,1
PUT F-CARD-TABLE,0,RANK
PUT F-CARD-TABLE,1,SUIT
?CND24: GET F-PLAY-TABLE-LC,PLAY-NUM
PRINT STACK
PRINTC 32
GET F-RANK-TABLE,RANK
PRINT STACK
GRTR? RANK,11 /?CND26
PRINTC 32
GET F-SUIT-TABLE,SUIT
PRINT STACK
?CND26: PRINTI ". He "
GET J-PLAY-TABLE,NUM
PRINT STACK
PRINTC 32
GET J-PLAY-SCORES,NUM
CALL2 F-SCORE,STACK
RSTACK
.FUNCT PICK-PLAY,X,Y,PTR,KEY,TOP,LEFT,TL-X,TL-Y,BR-X,BR-Y,CNT-X,CNT-Y,NEW-PTR,MOUSE-MOVED?
ICALL2 PICINF-PLUS-ONE,F-MENU-LOC
GET PICINF-TBL,0 >TOP
GET PICINF-TBL,1 >LEFT
ICALL BOLD-MOVE,X,Y,PTR
?PRG1: ZERO? DEMO-VERSION? /?CCL5
CALL2 INPUT-DEMO,1 >KEY
JUMP ?CND3
?CCL5: INPUT 1 >KEY
?CND3: ICALL1 MOUSE-INPUT?
EQUAL? KEY,CLICK1,CLICK2 \?CCL8
SET 'MOUSE-MOVED?,FALSE-VALUE
SET 'CNT-X,0
SET 'CNT-Y,0
ICALL2 PICINF-PLUS-ONE,F-MENU-LOC
GET PICINF-TBL,1 >TL-X
?PRG9: GET PICINF-TBL,0 >TL-Y
MUL FONT-X,13
ADD STACK,TL-X >BR-X
?PRG11: ADD FONT-Y,TL-Y >BR-Y
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CCL15
SET 'MOUSE-MOVED?,TRUE-VALUE
ICALL UNBOLD-MOVE,X,Y,PTR
GET PICINF-TBL,0 >Y
GET PICINF-TBL,1 >X
MUL FONT-X,13
MUL CNT-X,STACK
ADD X,STACK >X
MUL CNT-Y,FONT-Y
ADD Y,STACK >Y
MUL CNT-X,3
ADD CNT-Y,STACK >NEW-PTR
EQUAL? PTR,NEW-PTR \?CND16
SET 'KEY,CLICK2
?CND16: SET 'PTR,NEW-PTR
ICALL BOLD-MOVE,X,Y,PTR
?REP12: ZERO? MOUSE-MOVED? \?REP10
EQUAL? CNT-X,4 /?REP10
SET 'CNT-Y,0
INC 'CNT-X
SET 'TL-X,BR-X
JUMP ?PRG9
?CCL15: EQUAL? CNT-Y,2 /?REP12
INC 'CNT-Y
SET 'TL-Y,BR-Y
JUMP ?PRG11
?REP10: ZERO? MOUSE-MOVED? \?CCL27
CLEAR S-TEXT
SOUND 1
PRINTI "Click on one of the items in the menu to highlight a play; double-click on it to select that play."
JUMP ?PRG1
?CCL27: EQUAL? KEY,CLICK2 \?PRG1
CALL2 PLAY-SELECTED,PTR
EQUAL? STACK,TRUE-VALUE /TRUE
ICALL UNBOLD-MOVE,X,Y,PTR
RFALSE
?CCL8: EQUAL? KEY,UP-ARROW /?CTR32
EQUAL? KEY,85,117 \?CCL33
?CTR32: EQUAL? Y,TOP \?CCL38
CLEAR S-TEXT
SOUND 1
PRINT ALREADY-AT
PRINTI "top row!"
JUMP ?PRG1
?CCL38: ICALL UNBOLD-MOVE,X,Y,PTR
SUB Y,FONT-Y >Y
DEC 'PTR
ICALL BOLD-MOVE,X,Y,PTR
JUMP ?PRG1
?CCL33: EQUAL? KEY,DOWN-ARROW /?CTR39
EQUAL? KEY,68,100 \?CCL40
?CTR39: MUL FONT-Y,2
ADD TOP,STACK
EQUAL? Y,STACK \?CCL45
CLEAR S-TEXT
SOUND 1
PRINT ALREADY-AT
PRINTI "bottom row!"
JUMP ?PRG1
?CCL45: ICALL UNBOLD-MOVE,X,Y,PTR
ADD Y,FONT-Y >Y
INC 'PTR
ICALL BOLD-MOVE,X,Y,PTR
JUMP ?PRG1
?CCL40: EQUAL? KEY,LEFT-ARROW /?CTR46
EQUAL? KEY,76,108 \?CCL47
?CTR46: EQUAL? X,LEFT \?CCL52
CLEAR S-TEXT
SOUND 1
PRINT ALREADY-AT
PRINTI "left-most column!"
JUMP ?PRG1
?CCL52: ICALL UNBOLD-MOVE,X,Y,PTR
MUL FONT-X,13
SUB X,STACK >X
SUB PTR,3 >PTR
ICALL BOLD-MOVE,X,Y,PTR
JUMP ?PRG1
?CCL47: EQUAL? KEY,RIGHT-ARROW /?CTR53
EQUAL? KEY,82,114 \?CCL54
?CTR53: MUL FONT-X,52
ADD LEFT,STACK
EQUAL? X,STACK \?CCL59
CLEAR S-TEXT
SOUND 1
PRINT ALREADY-AT
PRINTI "right-most column!"
JUMP ?PRG1
?CCL59: ICALL UNBOLD-MOVE,X,Y,PTR
MUL FONT-X,13
ADD X,STACK >X
ADD PTR,3 >PTR
ICALL BOLD-MOVE,X,Y,PTR
JUMP ?PRG1
?CCL54: EQUAL? KEY,10,13 \?CCL61
CALL2 PLAY-SELECTED,PTR
EQUAL? STACK,TRUE-VALUE /TRUE
ICALL UNBOLD-MOVE,X,Y,PTR
RFALSE
?CCL61: CLEAR S-TEXT
SOUND 1
PRINTI "Use the arrow keys to highlight a play, or hit RETURN/ENTER to select the currently highlighted play."
JUMP ?PRG1
.FUNCT UNBOLD-MOVE,X,Y,PTR
SCREEN S-WINDOW
SUB X,1
CURSET Y,STACK
PRINTC 32
GET F-PLAY-TABLE,PTR
PRINT STACK
SCREEN S-TEXT
RTRUE
.FUNCT BOLD-MOVE,X,Y,PTR
SCREEN S-WINDOW
SUB X,1
CURSET Y,STACK
HLIGHT H-BOLD
PRINTC 62
GET F-PLAY-TABLE,PTR
PRINT STACK
HLIGHT H-NORMAL
SCREEN S-TEXT
RTRUE
.FUNCT PLAY-SELECTED,PTR,CNT,X,NUM,?TMP1
EQUAL? PTR,14 /TRUE
EQUAL? PTR,13 \?CCL5
RANDOM 100
LESS? 50,STACK /?CCL8
ICALL2 CHEAT-RESULT,CHEAT-WINS
RFALSE
?CCL8: ICALL2 CHEAT-RESULT,CHEAT-LOSSES
RFALSE
?CCL5: ZERO? PTR \?CCL10
SET 'CNT,0
?PRG11: GET F-CARD-TABLE,CNT
ZERO? STACK \?CCL15
DIV CNT,2
PUT DRAW-CARDS-TABLE,STACK,1
ICALL2 PICK-RANK,CNT
ADD CNT,1 >?TMP1
RANDOM 15
PUT F-CARD-TABLE,?TMP1,STACK
CLEAR S-TEXT
PRINTI "You draw "
ICALL2 PRINT-CARD-NAME,CNT
PRINTC 46
RFALSE
?CCL15: EQUAL? CNT,8 \?CND13
CLEAR S-TEXT
PRINTI "The jester snickers. ""You've no empty slot; you forfeit your shot!"""
RFALSE
?CND13: ADD CNT,2 >CNT
JUMP ?PRG11
?CCL10: GET F-CARD-TABLE,2
ZERO? STACK \?CCL18
GET F-CARD-TABLE,4
ZERO? STACK \?CCL18
GET F-CARD-TABLE,6
ZERO? STACK \?CCL18
GET F-CARD-TABLE,8
ZERO? STACK \?CCL18
CLEAR S-TEXT
SOUND 1
PRINTI "You can't "
GET F-PLAY-TABLE-LC,PTR
PRINT STACK
PRINTI " just now; you have no drawn cards!"
RFALSE
?CCL18: CLEAR S-TEXT
PRINTI "Use your mouse or type the number of the card you'd like to "
GET F-PLAY-TABLE-LC,PTR
PRINT STACK
PRINTC 46
?PRG23: INPUT 1 >X
ICALL1 MOUSE-INPUT?
EQUAL? X,CLICK1,CLICK2 \?CND25
CALL1 F-MOUSE-CARD-PICK >X
?CND25: EQUAL? X,146,147,148 /?CCL28
EQUAL? X,149 \?CND27
?CCL28: SUB X,97 >X
?CND27: EQUAL? X,49 \?PRD35
GET F-CARD-TABLE,2
ZERO? STACK /?CTR32
?PRD35: EQUAL? X,50 \?PRD38
GET F-CARD-TABLE,4
ZERO? STACK /?CTR32
?PRD38: EQUAL? X,51 \?PRD41
GET F-CARD-TABLE,6
ZERO? STACK /?CTR32
?PRD41: EQUAL? X,52 \?CCL33
GET F-CARD-TABLE,8
ZERO? STACK \?CCL33
?CTR32: CLEAR S-TEXT
SOUND 1
PRINTI "You can't "
GET F-PLAY-TABLE-LC,PTR
PRINT STACK
PRINTI " that card; it hasn't been drawn yet!"
JUMP ?PRG23
?CCL33: EQUAL? X,49 \?CCL47
SET 'X,2
JUMP ?REP24
?CCL47: EQUAL? X,50 \?CCL49
SET 'X,4
JUMP ?REP24
?CCL49: EQUAL? X,51 \?CCL51
SET 'X,6
JUMP ?REP24
?CCL51: EQUAL? X,52 \?CCL53
SET 'X,8
?REP24: GET F-CARD-TABLE,X >?TMP1
ADD X,1
GET F-CARD-TABLE,STACK
MUL ?TMP1,STACK
MUL STACK,PTR
MOD STACK,37 >NUM
EQUAL? PTR,5 \?CCL56
GRTR? F-WIN-COUNT,0 \?CCL59
INC 'F-WIN-COUNT
EQUAL? F-WIN-COUNT,3 \?CND54
DIV X,2
PUT DRAW-CARDS-TABLE,STACK,1
PUT F-CARD-TABLE,X,0
ADD X,1
PUT F-CARD-TABLE,STACK,0
RFALSE
?CCL53: CLEAR S-TEXT
SOUND 1
PRINT TYPE-A-NUMBER
PRINTI "4."
JUMP ?PRG23
?CCL59: GET J-LAST-CARD,0
EQUAL? STACK,TREBLED-RANK \?CND54
GET J-LAST-CARD,1
EQUAL? STACK,FROMP-SUIT \?CND54
SET 'F-WIN-COUNT,1
JUMP ?CND54
?CCL56: SET 'F-WIN-COUNT,0
?CND54: GET F-SCORES,NUM
ZERO? STACK \?CCL67
SET 'F-WIN-COUNT,0
PRINTI " The jester is outraged! ""You can't "
GET F-PLAY-TABLE-LC,PTR
PRINT STACK
PRINTC 32
ICALL2 PRINT-CARD-NAME,X
RANDOM 100
LESS? 6,STACK /?CCL70
PRINTI " when "
ICALL2 PRINT-CARD-NAME,0
PRINTI " is showing on the Discard Pile!"
RFALSE
?CCL70: PRINTC 32
GET J-RESPONSES,NUM
PRINT STACK
RFALSE
?CCL67: CLEAR S-TEXT
PRINTI "You "
GET F-PLAY-TABLE-LC,PTR
PRINT STACK
PRINTC 32
ICALL2 PRINT-CARD-NAME,X
PRINTI ". The jester "
GET J-RESPONSES,NUM
PRINT STACK
PRINTC 32
GET F-SCORES,NUM
ICALL2 F-SCORE,STACK
EQUAL? PTR,1 \?CND71
PUT DRAW-CARDS-TABLE,0,1
GET F-CARD-TABLE,X
PUT F-CARD-TABLE,0,STACK
ADD X,1
GET F-CARD-TABLE,STACK
PUT F-CARD-TABLE,1,STACK
?CND71: DIV X,2
PUT DRAW-CARDS-TABLE,STACK,1
PUT F-CARD-TABLE,X,0
ADD X,1
PUT F-CARD-TABLE,STACK,0
RFALSE
.FUNCT F-MOUSE-CARD-PICK,TL-X,TL-Y,BR-X,BR-Y,CARD-WIDTH,CARD-HEIGHT
PICINF F-CARD,PICINF-TBL /?BOGUS1
?BOGUS1: GET PICINF-TBL,0 >CARD-HEIGHT
GET PICINF-TBL,1 >CARD-WIDTH
ICALL2 PICINF-PLUS-ONE,F-1-PIC-LOC
GET PICINF-TBL,0 >TL-Y
GET PICINF-TBL,1 >TL-X
ADD TL-Y,CARD-HEIGHT >BR-Y
ADD TL-X,CARD-WIDTH >BR-X
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND2
RETURN 49
?CND2: ICALL2 PICINF-PLUS-ONE,F-2-PIC-LOC
GET PICINF-TBL,0 >TL-Y
GET PICINF-TBL,1 >TL-X
ADD TL-Y,CARD-HEIGHT >BR-Y
ADD TL-X,CARD-WIDTH >BR-X
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND4
RETURN 50
?CND4: ICALL2 PICINF-PLUS-ONE,F-3-PIC-LOC
GET PICINF-TBL,0 >TL-Y
GET PICINF-TBL,1 >TL-X
ADD TL-Y,CARD-HEIGHT >BR-Y
ADD TL-X,CARD-WIDTH >BR-X
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND6
RETURN 51
?CND6: ICALL2 PICINF-PLUS-ONE,F-4-PIC-LOC
GET PICINF-TBL,0 >TL-Y
GET PICINF-TBL,1 >TL-X
ADD TL-Y,CARD-HEIGHT >BR-Y
ADD TL-X,CARD-WIDTH >BR-X
CALL WITHIN?,TL-X,TL-Y,BR-X,BR-Y
ZERO? STACK /?CND8
RETURN 52
?CND8: RETURN CLICK1
.FUNCT PRINT-CARD-NAME,CNT
GET F-CARD-TABLE,CNT
GET F-RANK-TABLE,STACK
PRINT STACK
GET F-CARD-TABLE,CNT
LESS? STACK,12 \FALSE
PRINTC 32
ADD CNT,1
GET F-CARD-TABLE,STACK
GET F-SUIT-TABLE,STACK
PRINT STACK
RTRUE
.FUNCT CHEAT-RESULT,TBL,CNT,X,PTS
GET TBL,0 >CNT
RANDOM CNT
MUL STACK,2
SUB STACK,1 >X
ADD X,1
GET TBL,STACK >PTS
CLEAR S-TEXT
GET TBL,X
PRINT STACK
PRINTC 32
CALL2 F-SCORE,PTS
RSTACK
.FUNCT F-SCORE,PTS,?TMP1
GRTR? PTS,0 \?CCL3
DIV YOUR-SCORE,10 >?TMP1
RANDOM 100
LESS? ?TMP1,STACK /?CCL6
GRTR? J-SCORE,PTS \?CCL6
SUB J-SCORE,PTS >J-SCORE
PRINTI "The jester loses"
JUMP ?CND1
?CCL6: ADD YOUR-SCORE,PTS >YOUR-SCORE
PRINTI "You gain"
JUMP ?CND1
?CCL3: MUL PTS,-1 >PTS
DIV J-SCORE,10 >?TMP1
RANDOM 100
LESS? ?TMP1,STACK /?CCL11
GRTR? YOUR-SCORE,PTS \?CCL11
SUB YOUR-SCORE,PTS >YOUR-SCORE
PRINTI "You lose"
JUMP ?CND1
?CCL11: ADD J-SCORE,PTS >J-SCORE
PRINTI "The jester gains"
?CND1: PRINTC 32
PRINTN PTS
PRINTI " points."
RTRUE
.FUNCT QUILBOZZA-BEACH-F,RARG
EQUAL? RARG,M-END \FALSE
RANDOM 100
LESS? 40,STACK /FALSE
EQUAL? CURRENT-SPLIT,MAP-TOP-LEFT-LOC /FALSE
PRINTR " A wave crashes against the beach."
.FUNCT ROOM-OF-THREE-DOORS-F,RARG
EQUAL? RARG,M-LOOK \?CCL3
PRINTI "Before you are three doors: left, center, and right. All three doors are closed, and have writing on them. In addition, a tunnel leads southwest."
RTRUE
?CCL3: EQUAL? RARG,M-END \?CCL5
ZERO? WRITING-CHANGED /?CCL5
SET 'WRITING-CHANGED,FALSE-VALUE
ICALL1 RETURN-FROM-MAP
PRINTR " The writing on the doors appears to have changed since the last time you were here."
?CCL5: EQUAL? RARG,M-ENTER \FALSE
FSET? ROOM-OF-THREE-DOORS,TOUCHBIT \?CND10
SET 'WRITING-CHANGED,TRUE-VALUE
?CND10: RANDOM 100
LESS? 33,STACK /?CCL14
SET 'VERITASSI-DOOR,LEFT-DOOR
RANDOM 100
LESS? 50,STACK /?CCL17
SET 'PREVARICON-DOOR,RIGHT-DOOR
SET 'WISHYFOO-DOOR,CENTER-DOOR
RETURN WISHYFOO-DOOR
?CCL17: SET 'PREVARICON-DOOR,CENTER-DOOR
SET 'WISHYFOO-DOOR,RIGHT-DOOR
RETURN WISHYFOO-DOOR
?CCL14: RANDOM 100
LESS? 50,STACK /?CCL19
SET 'VERITASSI-DOOR,RIGHT-DOOR
RANDOM 100
LESS? 50,STACK /?CCL22
SET 'PREVARICON-DOOR,LEFT-DOOR
SET 'WISHYFOO-DOOR,CENTER-DOOR
RETURN WISHYFOO-DOOR
?CCL22: SET 'PREVARICON-DOOR,CENTER-DOOR
SET 'WISHYFOO-DOOR,LEFT-DOOR
RETURN WISHYFOO-DOOR
?CCL19: SET 'VERITASSI-DOOR,CENTER-DOOR
RANDOM 100
LESS? 50,STACK /?CCL25
SET 'PREVARICON-DOOR,LEFT-DOOR
SET 'WISHYFOO-DOOR,RIGHT-DOOR
RETURN WISHYFOO-DOOR
?CCL25: SET 'PREVARICON-DOOR,RIGHT-DOOR
SET 'WISHYFOO-DOOR,LEFT-DOOR
RETURN WISHYFOO-DOOR
.FUNCT THREE-DOORS-F
EQUAL? PRSA,V?READ \?CCL3
PRINTI """Attention:
1. This door does not lead to Prevaricon territory.
2. The "
EQUAL? PRSO,VERITASSI-DOOR \?CCL6
ICALL2 DPRINT,PREVARICON-DOOR
PRINTI " does not lead to Wishyfoo"
JUMP ?CND4
?CCL6: EQUAL? PRSO,PREVARICON-DOOR \?CCL8
ICALL2 DPRINT,WISHYFOO-DOOR
PRINTI " does not lead to Wishyfoo"
JUMP ?CND4
?CCL8: ICALL2 DPRINT,VERITASSI-DOOR
PRINTI " does not lead to Veritassi"
?CND4: PRINTR " territory."""
?CCL3: EQUAL? PRSA,V?ENTER,V?OPEN \FALSE
PRINTI "As you open it, a strong draft sucks you through the doorway. You stumble down a steep incline"
PRINT ELLIPSIS
EQUAL? PRSO,WISHYFOO-DOOR \?CCL13
CALL2 GOTO,WISHYFOO-TERRITORY
RSTACK
?CCL13: HLIGHT H-BOLD
EQUAL? PRSO,VERITASSI-DOOR \?CCL16
PRINTI "Veritassi"
JUMP ?CND14
?CCL16: PRINTI "Prevaricon"
?CND14: PRINTI " Territory"
CRLF
HLIGHT H-NORMAL
CALL2 JIGS-UP,STR?785
RSTACK
.ENDSEG
.ENDI