fenshire.zap

	.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