Posted by: Pete - 04-26-2022, 02:15 AM - Forum: TheBOB
- No Replies
Mystify.bas by Bob Seguin Description: Screen saver.
Code: (Select All)
_TITLE "Mystify.bas by Bob Seguin"
_FULLSCREEN
TYPE MovingPolyType
x AS INTEGER
y AS INTEGER
IncX AS INTEGER
IncY AS INTEGER
END TYPE
TYPE HoldingPolysType
x AS INTEGER
y AS INTEGER
END TYPE
DIM Co(1 TO 8) AS MovingPolyType
DIM Slots(1 TO 11, 1 TO 8) AS HoldingPolysType
DEFINT A-Z
'Establish random starting coordinates and x/y increments for polygons
SCREEN 12
RANDOMIZE TIMER
FOR n = 1 TO 8
Co(n).x = INT(RND * 400) + 1
Co(n).y = INT(RND * 240) + 1
Rand = INT(RND * 2) + 1
SELECT CASE Rand
CASE 1
Co(n).IncX = -INT(RND * 12) + 1
CASE 2
Co(n).IncX = INT(RND * 12) + 1
END SELECT
Rand = INT(RND * 2) + 1
SELECT CASE Rand
CASE 1
Co(n).IncY = -INT(RND * 12) + 1
CASE 2
Co(n).IncY = INT(RND * 12) + 1
END SELECT
NEXT n
FOR Reps = 1 TO 8
Slots(1, Reps).x = Co(Reps).x + 119: Slots(1, Reps).y = Co(Reps).y + 119
NEXT Reps
OneSwitch = 1
ThreeSwitch = 1
One = 16
Three = 52
PALETTE 0, 655360
PALETTE 4, 63
GOSUB ColorSet
ON TIMER(1) GOSUB ColorSet
TIMER ON
DO
FOR n = 1 TO 8
GOSUB Direction
NEXT n
FOR Reps = 11 TO 2 STEP -1
FOR Pots = 1 TO 8
Slots(Reps, Pots).x = Slots(Reps - 1, Pots).x
Slots(Reps, Pots).y = Slots(Reps - 1, Pots).y
NEXT Pots
NEXT Reps
'For this small-area-of-activity version, new coordinates are assigned
'and set to occur center screen (+ 119).
FOR Pots = 1 TO 8
Slots(1, Pots).x = Co(Pots).x + 119
Slots(1, Pots).y = Co(Pots).y + 119
NEXT Pots
'Erase last polygon
LINE (Slots(11, 1).x, Slots(11, 1).y)-(Slots(11, 2).x, Slots(11, 2).y), 0
LINE (Slots(11, 2).x, Slots(11, 2).y)-(Slots(11, 3).x, Slots(11, 3).y), 0
LINE (Slots(11, 3).x, Slots(11, 3).y)-(Slots(11, 4).x, Slots(11, 4).y), 0
LINE (Slots(11, 4).x, Slots(11, 4).y)-(Slots(11, 1).x, Slots(11, 1).y), 0
LINE (Slots(11, 5).x, Slots(11, 5).y)-(Slots(11, 6).x, Slots(11, 6).y), 0
LINE (Slots(11, 6).x, Slots(11, 6).y)-(Slots(11, 7).x, Slots(11, 7).y), 0
LINE (Slots(11, 7).x, Slots(11, 7).y)-(Slots(11, 8).x, Slots(11, 8).y), 0
LINE (Slots(11, 8).x, Slots(11, 8).y)-(Slots(11, 5).x, Slots(11, 5).y), 0
'Draw new first polygons and redraw existing polygons so that all the
'erasures are overdrawn, all polygons take on the updated color, and
'the second-color polygons overdraw the first-color polygons.
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
FOR Reps = 1 TO 10
IF Slots(Reps, 1).x <> 0 THEN
LINE (Slots(Reps, 1).x, Slots(Reps, 1).y)-(Slots(Reps, 2).x, Slots(Reps, 2).y), 1
LINE (Slots(Reps, 2).x, Slots(Reps, 2).y)-(Slots(Reps, 3).x, Slots(Reps, 3).y), 1
LINE (Slots(Reps, 3).x, Slots(Reps, 3).y)-(Slots(Reps, 4).x, Slots(Reps, 4).y), 1
LINE (Slots(Reps, 4).x, Slots(Reps, 4).y)-(Slots(Reps, 1).x, Slots(Reps, 1).y), 1
END IF
NEXT Reps
FOR Reps = 1 TO 10
IF Slots(Reps, 1).x <> 0 THEN
LINE (Slots(Reps, 5).x, Slots(Reps, 5).y)-(Slots(Reps, 6).x, Slots(Reps, 6).y), 2
LINE (Slots(Reps, 6).x, Slots(Reps, 6).y)-(Slots(Reps, 7).x, Slots(Reps, 7).y), 2
LINE (Slots(Reps, 7).x, Slots(Reps, 7).y)-(Slots(Reps, 8).x, Slots(Reps, 8).y), 2
LINE (Slots(Reps, 8).x, Slots(Reps, 8).y)-(Slots(Reps, 5).x, Slots(Reps, 5).y), 2
END IF
NEXT Reps
LOOP UNTIL INKEY$ <> ""
TIMER OFF
CLS
SYSTEM
Direction:
SELECT CASE Co(n).x
CASE IS <= 0
Co(n).IncX = INT(RND * 12) + 1
CASE IS >= 399
Co(n).IncX = -INT(RND * 12) + 1
END SELECT
SELECT CASE Co(n).y
CASE IS <= 0
Co(n).IncY = INT(RND * 12) + 1
CASE IS >= 239
Co(n).IncY = -INT(RND * 12) + 1
END SELECT
Co(n).x = Co(n).x + Co(n).IncX
Co(n).y = Co(n).y + Co(n).IncY
RETURN
ColorSet:
SELECT CASE OneSwitch
CASE 1
One = One + 1
IF One = 63 THEN OneSwitch = 0
CASE 0
One = One - 1
IF One = 0 THEN OneSwitch = 1
END SELECT
SELECT CASE ThreeSwitch
CASE 1
Three = Three + 1
IF Three = 63 THEN ThreeSwitch = 0
CASE 0
Three = Three - 1
IF Three = 0 THEN ThreeSwitch = 1
END SELECT
PALETTE 1, 2490368 + ((63 - Three) * 256) + One
PALETTE 2, (Three * 65536) + ((63 - One) * 256) + 38
RETURN
Posted by: Pete - 04-26-2022, 02:03 AM - Forum: TheBOB
- No Replies
Paging.bas by Bob Seguin Description: A SCREEN 9 paging demo with a space ship flying through a meteor shower. The Surprise? See the second code example, Joker.bas, which uses this example, mixed with TheBOB's White Cake Recipe program.
Code: (Select All)
'******************************************************
'---------------- P A G I N G . B A S -----------------
'------------- SCREEN 9 PAGING EXAMPLE ----------------
'--------- Uses compressed DATA to draw Ship ----------
'******************************************************
_TITLE "Paging.bas Demo by Bob Seguin"
DEFINT A-Z
DIM ShipBOX(6000)
ShipDATA:
DATA 34,0,1,5,73,0,7,5,4,7,1,15,73,0,6,5,1,7,77,0,6,5,1,7,77,0,6,5,1,7
DATA 77,0,5,5,2,7,77,0,4,5,3,7,77,0,3,5,5,7,76,0,8,7,76,0,9,7,75,0,10,7
DATA 74,0,11,7,73,0,12,7,69,0,2,5,1,2,7,7,3,5,3,7,3,5,2,7,61,0,1,8,3,5
DATA 1,2,6,7,1,5,3,7,1,5,3,7,10,5,55,0,1,8,2,7,2,2,6,7,1,2,3,7,1,2
DATA 4,7,7,5,2,2,1,15,54,0,1,8,2,7,2,2,6,7,1,2,3,7,1,2,5,7,6,5,2,2
DATA 1,15,54,0,1,8,1,7,3,2,7,7,3,2,12,7,2,2,1,5,46,0,1,8,7,5,1,8,4,2
DATA 22,7,2,2,1,5,46,0,1,8,7,5,1,8,4,2,22,7,2,2,47,0,1,8,12,5,22,7,44,0
DATA 4,4,2,8,6,7,8,5,2,7,11,2,7,7,1,5,41,0,2,4,4,14,2,8,6,7,6,2,3,5
DATA 1,7,1,2,9,7,1,2,8,7,1,5,39,0,1,4,2,14,4,15,2,8,6,7,9,2,1,5,1,2
DATA 9,7,1,2,8,7,2,5,37,0,1,4,1,14,6,15,2,8,6,7,21,2,7,7,5,5,2,9,1,15
DATA 1,4,1,15,2,9,1,7,1,5,27,0,1,4,2,14,4,15,2,8,6,7,13,2,13,7,10,5,8,7
DATA 1,15,25,0,2,4,4,14,2,8,7,7,15,2,9,7,13,5,6,7,1,5,27,0,4,4,2,8,25,2
DATA 36,5,21,0,2,8,10,2,36,5,2,10,4,9,1,15,2,9,2,7,6,5,1,15,18,0,2,8,8,7
DATA 2,2,36,7,4,10,2,9,1,5,4,9,1,5,6,12,1,5,17,0,2,8,8,7,2,2,36,7,4,10
DATA 2,9,1,7,4,9,1,5,6,12,1,5,6,15,11,0,2,8,8,7,2,2,36,7,4,10,2,9,1,7
DATA 4,9,1,5,6,12,1,5,17,0,2,8,8,5,38,2,2,10,4,9,1,2,2,9,8,7,1,5,14,0
DATA 4,4,2,8,25,5,36,2,15,0,2,4,4,14,2,8,7,7,15,5,12,7,10,5,6,7,1,5,24,0
DATA 1,4,2,14,4,15,2,8,6,7,13,5,13,7,10,5,8,7,1,15,23,0,1,4,1,14,6,15,2,8
DATA 5,7,1,2,11,5,10,2,2,7,10,5,2,9,1,15,1,4,1,15,2,9,1,7,1,5,27,0,1,4
DATA 2,14,4,15,2,8,4,7,2,2,9,5,2,2,9,7,1,2,1,7,9,5,39,0,2,4,4,14,2,8
DATA 3,7,3,2,6,5,3,2,1,7,1,2,9,7,1,2,9,5,42,0,4,4,2,8,2,7,12,2,2,7
DATA 11,2,8,5,48,0,1,8,14,2,8,7,12,5,49,0,1,8,7,2,1,8,3,5,1,2,9,7,15,5
DATA 47,0,1,8,7,2,1,8,3,5,1,2,8,7,10,5,1,7,3,5,2,2,1,15,54,0,1,8,3,5
DATA 1,2,6,7,1,5,1,7,2,15,7,5,1,7,4,5,2,2,1,15,54,0,1,8,8,7,2,5,1,7
DATA 3,5,1,15,5,5,2,7,4,5,2,2,1,5,54,0,1,8,2,7,2,2,4,7,2,5,1,7,3,5
DATA 1,7,4,5,2,7,5,5,2,2,1,5,54,0,1,8,1,7,3,2,3,7,3,5,1,7,3,5,1,7
DATA 3,5,3,7,5,5,2,2,57,0,3,2,3,7,4,5,3,7,3,5,5,2,66,0,4,7,8,5,72,0
DATA 6,7,5,5,73,0,5,7,5,5,74,0,5,7,4,5,75,0,5,7,3,5,76,0,6,7,2,5,76,0
DATA 7,7,77,0,7,7,77,0,7,7,77,0,7,7,77,0,7,7,76,0,11,7,1,15,82,0,1,5,49,0
DATA 16,0,6,4,3,0,3,4,5,14,2,0,2,4,2,14,5,15,1,0,2,4,1,14,7,15,2,0,2,4
DATA 2,14,5,15,3,0,3,4,5,14,5,0,6,4,60,0,6,4,3,0,3,4,5,14,2,0,2,4,2,14
DATA 5,15,1,0,2,4,1,14,7,15,2,0,2,4,2,14,5,15,3,0,3,4,5,14,5,0,6,4,11,0
SCREEN 9
'Set all attributes to black to hide draw/GET process
FOR n = 1 TO 15
PALETTE n, 0
NEXT n
'Ships differ in that the ship 2 rocket blasts are slightly larger
'Draw and GET ship 1 and mask
x = 0: y = 0
MaxWIDTH = 83
MaxDEPTH = 60
GOSUB DrawSHIP
GET (0, 0)-(MaxWIDTH, MaxDEPTH), ShipBOX()
GOSUB Mask
GET (0, 0)-(MaxWIDTH, MaxDEPTH), ShipBOX(1500)
'Redraw ship, add different rocket blasts,GET ship/mask
RESTORE ShipDATA
LINE (0, 0)-(83, 60), 0, BF
x = 0: y = 0
GOSUB DrawSHIP
'Draw different rocket blasts
x = 0: y = 20
MaxWIDTH = 10
MaxDEPTH = 40
GOSUB DrawSHIP
GET (0, 0)-(83, 60), ShipBOX(3000)
GOSUB Mask
GET (0, 0)-(83, 60), ShipBOX(4500)
TYPE RockTYPE 'establish data TYPE for meteors
Mx AS INTEGER 'meteor x coordinate
My AS INTEGER 'meteor y coordinate
Mr AS INTEGER 'meteor radius (fixed)
Ms AS INTEGER 'meteor speed (fixed)
END TYPE
DIM Rocks(1 TO 100) AS RockTYPE 'holds the location, size
'and speed of 100 meteors
SELECT CASE n 'speed variations create perspective
CASE 1 TO 30: Rocks(n).Ms = 12 'background meteors
CASE 31 TO 65: Rocks(n).Ms = 18 'midground meteors
CASE 66 TO 100: Rocks(n).Ms = 24 'foreground meteors
END SELECT
NEXT n
Rocks(50).Mr = 10 'meteor 50 specially sized (large)
Rocks(100).Mr = 16 'meteor 100 specially sized (larger)
PALETTE
PALETTE 10, 0 'set palette values for attributes
PALETTE 12, 35 'which do not respond to OUT
'set palette values for attributes
'that respond to OUT
OUT &H3C8, 0
OUT &H3C9, 0
OUT &H3C9, 0 'background: midnight blue
OUT &H3C9, 12
OUT &H3C8, 1
OUT &H3C9, 16
OUT &H3C9, 8 'meteor: dark brown
OUT &H3C9, 2
OUT &H3C8, 2
OUT &H3C9, 32
OUT &H3C9, 32 'medium ship gray
OUT &H3C9, 32
OUT &H3C8, 3
OUT &H3C9, 22
OUT &H3C9, 12 'meteor highlight brown
OUT &H3C9, 5
OUT &H3C8, 4
OUT &H3C9, 63
OUT &H3C9, 0 'bright red
OUT &H3C9, 0
OUT &H3C8, 5
OUT &H3C9, 52
OUT &H3C9, 52 'ship light gray
OUT &H3C9, 52
'MAIN LOOP BEGINS -------------------------------
Count = 0
FOR x = 6 TO 546 STEP 2 'main loop wherein ship will
'travel 540 pixels in steps
'of two
b$ = INKEY$: IF b$ = CHR$(32) THEN b$ = CHR$(27)
CLS 'active screen cleared
OUT &H3C8, 0 'background color reestablished
OUT &H3C9, 0 'in case "space lightning" has
OUT &H3C9, 0 'flashed
OUT &H3C9, 12
'The following loop draws/updates x/y's of first 80 meteors
FOR n = 1 TO 80
GOSUB DrawMETEORS 'see DrawMETEORS subroutine
NEXT n
'Variable (Swerve) which causes ship to drift left and right
'is established and directional rockets are fired accordingly
SELECT CASE Switch 'both Swerve and Switch = 0 initially
CASE 0
Swerve = Swerve + 1
IF Swerve > 24 AND Swerve < 30 THEN 'directional rocket fired
LINE (x + 14, 171 + Swerve)-(x + 18, 173 + Swerve), 4, B
LINE (x + 10, 172 + Swerve)-(x + 18, 172 + Swerve), 14
LINE (x + 17, 172 + Swerve)-(x + 18, 172 + Swerve), 15
END IF
IF Swerve = 30 THEN Switch = 1 'pass to CASE 1
CASE 1
Swerve = Swerve - 1
IF Swerve > -30 AND Swerve < -26 THEN 'directional rocket fired
LINE (x + 14, 143 + Swerve)-(x + 18, 145 + Swerve), 4, B
LINE (x + 10, 144 + Swerve)-(x + 18, 144 + Swerve), 14
LINE (x + 17, 144 + Swerve)-(x + 18, 144 + Swerve), 15
END IF
IF Swerve = -30 THEN Switch = 0 'pass to CASE 0
END SELECT
'Ship masks/sprites PUT, variable "Count" toggling two sprites with
'differing degrees of rocket blast (to create sense of active rockets)
Count = Count + 1
IF Count MOD 2 THEN
PUT (x, 128 + Swerve), ShipBOX(1500), AND 'mask
PUT (x, 128 + Swerve), ShipBOX() 'sprite
ELSE
PUT (x, 128 + Swerve), ShipBOX(4500), AND 'mask
PUT (x, 128 + Swerve), ShipBOX(3000) 'sprite
END IF
'Second meteor-drawing loop draws last 20 meteors so that they *may*
'overdraw the ship (creating sense of its 'involvement' in meteor storm)
FOR n = 81 TO 100
GOSUB DrawMETEORS 'see DrawMETEORS subroutine
NEXT n
'PRINT section -------------------------------------
COLOR 8: LOCATE 24, 32: PRINT "Press SPACE to end...";
'Blurbs are printed (with gaps) based on the ship's x location
COLOR 13
SELECT CASE x
CASE IS < 150
LOCATE 21, 20: PRINT "The mission so far had been free of incident..."
CASE 161 TO 300
LOCATE 21, 20: PRINT "But on the seventeenth day, we encountered"
LOCATE 22, 20: PRINT "a meteor storm..."
CASE 311 TO 440
LOCATE 21, 20: PRINT "With every moment, we came closer to almost"
LOCATE 22, 20: PRINT "certain destruction..."
END SELECT
'-----------------------------------------------------
'Border line
LINE (0, 0)-(639, 349), 8, B
'"Space lightning" flash (1 chance in 25)
Flash = FIX(RND * 25)
IF Flash = 0 THEN
OUT &H3C8, 0
OUT &H3C9, 63 'set background (briefly) to bright red
OUT &H3C9, 0
OUT &H3C9, 0
END IF
REM IF INP(96) = 57 THEN EXIT FOR 'check for spacebar being pressed to exit
IF b$ = CHR$(27) THEN SYSTEM
'If the meteor's x coordinate has moved off-screen to the left, it is as-
'signed a new random y coordinate, then reset to the right of the screen
IF Rocks(n).Mx < 0 THEN
Rocks(n).My = FIX(RND * 350)
Rocks(n).Mx = 642
END IF
'Meteors are drawn with lighter highlight circle offset +1/-1 pixel
CIRCLE (Rocks(n).Mx, Rocks(n).My), Rocks(n).Mr, 1
PAINT STEP(0, 0), 1
CIRCLE (Rocks(n).Mx + 1, Rocks(n).My - 1), Rocks(n).Mr - 2, 3
PAINT STEP(0, 0), 3
'Establish new location for each meteor by subtracting their
'individual speed (Ms) from their current x coordinate (Mx) ...
Rocks(n).Mx = Rocks(n).Mx - Rocks(n).Ms
RETURN
DrawSHIP:
DO
READ Count, Colr
FOR Reps = 1 TO Count
PSET (x, y), Colr
x = x + 1
IF x > MaxWIDTH THEN
x = 0
y = y + 1
END IF
NEXT Reps
LOOP UNTIL y > MaxDEPTH
RETURN
Mask:
FOR xx = 0 TO 83
FOR yy = 0 TO 60
IF POINT(xx, yy) = 0 THEN PSET (xx, yy), 15 ELSE PSET (xx, yy), 0
NEXT yy
NEXT xx
RETURN
... And the surprise, Joker.bas
Description: Whenever we had a graphics emergency at The QBasic Forum, we always put up the Bat Signal ^^0^^ to call on TheBOB (aka The Batman) for help. One of Bob's creations, a recipe for White cake, and his Page Flipping Screen 9 demo were combined in the following code, but something went amiss that day in Gotham City...
Code: (Select All)
DEFINT A-Y
TYPE RockTYPE 'establish data TYPE for meteors
Mx AS INTEGER 'meteor x coordinate
My AS INTEGER 'meteor y coordinate
Mr AS INTEGER 'meteor radius (fixed)
Ms AS INTEGER 'meteor speed (fixed)
END TYPE
SCREEN 12, 0, 0, 0
_FULLSCREEN
FOR n = 1 TO 9
READ Attribute: OUT &H3C8, Attribute
FOR Reps = 1 TO 3
READ Intensity: OUT &H3C9, Intensity
NEXT Reps
NEXT n
PRINT
PRINT
COLOR 15
PRINT SPACE$(4); "W H I T E"; SPACE$(3); "C A K E"; SPACE$(3); "R E C I P E"
LINE (16, 60)-(620, 60), 9
LINE (16, 62)-(620, 62), 9
LINE (418, 60)-(542, 62), 0, BF
PRINT
PRINT
COLOR 12
PRINT SPACE$(4); "Heat oven to 350 degrees"
PRINT SPACE$(4); "Grease and flour 2 circular pans (8-9 inches)"
PRINT
COLOR 15
PRINT SPACE$(4); "CAKE:";
COLOR 11
PRINT SPACE$(9); "Flour: 2-1/4 cups"
PRINT SPACE$(18); "Sugar: 1-2/3 cups"
PRINT SPACE$(13); "Shortening: 2/3 cup"
PRINT SPACE$(19); "Milk: 1-1/4 cups"
PRINT SPACE$(10); "Baking powder: 3-1/2 tsps"
PRINT SPACE$(19); "Salt: 1 tsp"
PRINT SPACE$(16); "Vanilla: 1 tsp"
PRINT SPACE$(13); "Egg whites: 5 (reserve yolks for icing)"
PRINT
COLOR 12
PRINT SPACE$(4);
PRINT "Combine all ingredients except the egg whites in a bowl. Beat for 1/2"
PRINT SPACE$(4);
PRINT "minute at low speed, scraping bowl constantly, then 2 minutes at high"
PRINT SPACE$(4);
PRINT "speed, scraping bowl occasionally. Beat in egg whites, 2 minutes at"
PRINT SPACE$(4);
PRINT "high speed. Pour into pans. Bake until a toothpick inserted comes out"
PRINT SPACE$(4);
PRINT "clean or cake springs back when touched lightly (30 - 35 minutes)."
PRINT
COLOR 15
PRINT SPACE$(4); "ICING:";
COLOR 11
PRINT SPACE$(3); "Shortening: 2/3 cup"
PRINT SPACE$(17); "Butter: 2/3 cup"
PRINT SPACE$(14); "Egg yolks: 5"
PRINT SPACE$(16); "Vanilla: 1-1/2 tsps"
PRINT SPACE$(12); "Icing sugar: 3/4 cup or to taste"
CIRCLE (480, 86), 74, 1, , , .4
PAINT STEP(0, 0), 1
CIRCLE (480, 80), 72, 15, , , .4
PAINT STEP(0, 0), 15
CIRCLE (480, 79), 67, 9, , , .4
PAINT STEP(0, 0), 9
CIRCLE (480, 80), 72, 14, , , .4
CIRCLE (480, 78), 48, 15, , , .4
CIRCLE (480, 40), 60, 7, -4.5, -3.5, .4
PSET (423, 46), 7: DRAW "F2"
PAINT STEP(0, -10), 7
CIRCLE (480, 80), 60, 7, -4.5, -3.5, .4
PSET (423, 86), 7: DRAW "F2"
PAINT STEP(0, -10), 7
LINE (540, 40)-STEP(0, 40), 7
LINE (420, 40)-STEP(0, 40), 7
PAINT (430, 60), 7
PAINT (530, 60), 7
LINE (420, 40)-STEP(0, 40), 7
LINE STEP(4, -33)-STEP(0, 40), 7
LINE STEP(43, -24)-STEP(0, 40), 7
PAINT STEP(8, -18), 7
CIRCLE (480, 40), 60, 15, -4.5, -3.5, .4
LINE (540, 40)-STEP(0, 40), 15
LINE (420, 40)-STEP(0, 40), 15
LINE (420, 40)-STEP(0, 40), 15
LINE STEP(4, -33)-STEP(0, 40), 15
LINE STEP(43, -24)-STEP(0, 40), 15
PSET (430, 52), 4
DRAW "M+47,-7 M-9,+14 M-38,+6 U12 BR12 P4,4 BL13 D12 LU13Ld13"
PSET (427, 70), 4
DRAW "M+40,-7 D19 M-40,+7 U19 BF8 P4,4"
DIM Box(1000)
GET (427, 53)-(467, 78), Box()
PUT (427, 55), Box(), PSET
PSET (481, 40), 15
DRAW "M-13,+21"
PAINT (470, 30), 13, 15
FOR Reps = 1 TO 1200
X = FIX(RND * 60) + 420
y = FIX(RND * 54) + 40
IF POINT(X, y) = 4 THEN PSET (X, y), 15
NEXT Reps
PSET (427, 70), 2
DRAW "bM+40,-7 bD19 M-40,+7"
PSET (427, 70), 2
DRAW "bM+40,-7 bD20 M-30,+5"
CIRCLE (480, 80), 60, 2, 4.5, 6, .4
LINE (4, 4)-(635, 475), 9, B
FOR X = 524 TO 525
FOR y = 30 TO 100
IF POINT(X, y) = 7 THEN PSET (X, y), 13
NEXT y
NEXT X
FOR X = 528 TO 540
FOR y = 30 TO 100
IF POINT(X, y) = 7 THEN PSET (X, y), 13
NEXT y
NEXT X
CALL BSU
CALL SPACE
SYSTEM
PaletteDATA:
DATA 0,0,0,36,1,0,0,24,2,48,36,44,4,54,54,63,7,63,48,48,8
DATA 54,54,54,9,60,48,63,12,42,42,42,13,63,52,52,14,63,42,24
DO
b$ = INKEY$
_LIMIT 30
LOCATE 28, 62
PRINT "Press arrow up.";
LOCATE 28, 62
IF b$ = CHR$(0) + "H" THEN EXIT DO
_DELAY .45
PRINT " ";
IF b$ = CHR$(0) + "H" THEN EXIT DO
_DELAY .45
IF b$ = CHR$(27) THEN SYSTEM
LOOP UNTIL b$ = CHR$(0) + "H"
b$ = CHR$(13)
LOCATE 28, 60: PRINT " ";
FIREMISSILE:
FOR I = 1 TO 25
LOCATE 28 - I, 60: PRINT " ";
LOCATE CSRLIN - 1, 60: PRINT CHR$(24);
Z = TIMER
DO
LOOP UNTIL ABS(Z - TIMER) >= .02: 'DELAY LOOP
NEXT
FOR I = 1 TO 5
SOUND 2000, 2: SOUND 500, 2
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
OUT &H3C8, 12
IF I >= 3 THEN
IF I / 2 <> I \ 2 THEN OUT &H3C8, 33 ELSE OUT &H3C8, 0
ELSE
OUT &H3C8, 0
OUT &H3C9, 63 'set background (briefly) to bright red
OUT &H3C9, 0
OUT &H3C9, 0
END IF
NEXT I
Z = TIMER
DO
LOOP UNTIL ABS(Z - TIMER) >= 1.5: 'DELAY LOOP
END SUB
SUB SPACE
SCREEN 9
'Set all attributes to black to hide draw/GET process
FOR n = 1 TO 15
PALETTE n, 0
NEXT n
'Ships differ in that the ship 2 rocket blasts are slightly larger
'Draw and GET ship 1 and mask
X = 0: Y = 0
MaxWIDTH = 83
MaxDEPTH = 60
DIM Rocks(1 TO 100) AS RockTYPE 'holds the location, size
'and speed of 100 meteors
IF X < 326 THEN
FOR n = 1 TO 100 'loop to initialize meteor array
SELECT CASE n 'speed variations create perspective
CASE 1 TO 30: Rocks(n).Ms = 12 'background meteors
CASE 31 TO 65: Rocks(n).Ms = 18 'midground meteors
CASE 66 TO 100: Rocks(n).Ms = 24 'foreground meteors
END SELECT
NEXT n
Rocks(50).Mr = 10 'meteor 50 specially sized (large)
Rocks(100).Mr = 16 'meteor 100 specially sized (larger)
ELSE
Z = TIMER: DO: IF ABS(Z - TIMER) > .1 THEN EXIT DO
LOOP
END IF
PALETTE
PALETTE 10, 0 'set palette values for attributes
PALETTE 12, 35 'which do not respond to OUT
'set palette values for attributes
'that respond to OUT
OUT &H3C8, 0
OUT &H3C9, 0
OUT &H3C9, 0 'background: midnight blue
OUT &H3C9, 12
OUT &H3C8, 1
OUT &H3C9, 16
OUT &H3C9, 8 'meteor: dark brown
OUT &H3C9, 2
OUT &H3C8, 2
OUT &H3C9, 32
OUT &H3C9, 32 'medium ship gray
OUT &H3C9, 32
OUT &H3C8, 3
OUT &H3C9, 22
OUT &H3C9, 12 'meteor highlight brown
OUT &H3C9, 5
OUT &H3C8, 4
OUT &H3C9, 63
OUT &H3C9, 0 'bright red
OUT &H3C9, 0
OUT &H3C8, 5
OUT &H3C9, 52
OUT &H3C9, 52 'ship light gray
OUT &H3C9, 52
'MAIN LOOP BEGINS -------------------------------
Count = 0
FOR X = 6 TO 546 STEP 2 'main loop wherein ship will
_DELAY .115 ' Reading speed
'travel 540 pixels in steps
'of two
CLS 'active screen cleared
OUT &H3C8, 0 'background color reestablished
OUT &H3C9, 0 'in case "space lightning" has
OUT &H3C9, 0 'flashed
OUT &H3C9, 12
'The following loop draws/updates x/y's of first 80 meteors
IF X < 326 THEN
FOR n = 1 TO 80
GOSUB DrawMETEORS 'see DrawMETEORS subroutine
NEXT n
'Second meteor-drawing loop draws last 20 meteors so that they *may*
'overdraw the ship (creating sense of its 'involvement' in meteor storm)
FOR n = 81 TO 100
GOSUB DrawMETEORS 'see DrawMETEORS subroutine
NEXT n
ELSE
''Z = TIMER: DO: IF ABS(Z - TIMER) > .1 THEN EXIT DO
''LOOP
END IF
Z = TIMER: DO: IF ABS(Z - TIMER) > .05 THEN EXIT DO
LOOP
'PRINT section -------------------------------------
'Blurbs are printed (with gaps) based on the ship's x location
COLOR 13: A1 = 30
SELECT CASE X
CASE 10 + A1 TO 100 + A1
LOCATE 21, 19: PRINT "Kirk to Spock. What are those strange looking"
LOCATE 22, 31: PRINT "blobs on the screen?"
CASE 101 + A1 TO 170 + A1
LOCATE 21, 21: PRINT "Sensors indicate they are the remains of"
LOCATE 22, 23: PRINT "TheBob's White Cake Recipe, Captain."
CASE 171 + A1 TO 240 + A1
LOCATE 21, 15: PRINT "Kirk to Scottie. Beam those pieces of cake on board!"
CASE 241 + A1 TO 317 + A1
LOCATE 21, 19: PRINT "Aye Captain, I'll get right on it, as soon as"
LOCATE 22, 28: PRINT "I finish my Dunkin Donuts."
CASE 336 + A1 TO 435 + A1
LOCATE 21, 15: PRINT "Kirk to Sick Bay. Bones, MEDICAL EMERGENCY! Report to"
LOCATE 22, 13: PRINT "the Transporter Room and put TheBob's cake back together!"
CASE IS > 440 + A1
LOCATE 21, 19: PRINT "Dammit Jim. I'm a doctor, not Martha Stewart!"
END SELECT
'-----------------------------------------------------
'Border line
LINE (0, 0)-(639, 349), 8, B
'"Space lightning" flash (1 chance in 25)
'Flash = FIX(RND * 25)
IF X = 326 THEN
SOUND 1000, .5: SOUND 2000, .5: SOUND 3000, .5: SOUND 4000, .5: SOUND 5000, .5: SOUND 6000, .5
SOUND 6000, .5: SOUND 7000, .5: SOUND 8000, .5: SOUND 4000, .5: SOUND 9000, .5
OUT &H3C8, 0
OUT &H3C9, 63 'set background (briefly) to bright red
OUT &H3C9, 0
OUT &H3C9, 0
END IF
SCREEN 9, 0, 0, 0
LOCATE 21, 5: PRINT SPACE$(70);
LOCATE 22, 5: PRINT SPACE$(70);
_DELAY 1
LEVEL1 = 10
A1$ = " [Sometimes The Joker Wins!]"
REDIM BAT$(3)
BAT$(3) = "^^o^^"
BAT$(2) = "--o--"
BAT$(1) = "vvovv"
LOCATE LEVEL1, 2
_DELAY 1
FOR I = 1 TO 12
FOR J = 1 TO 3
IF I = 1 AND J = 1 THEN LOCATE , 3 ELSE PRINT " ";
PRINT BAT$(J);
LOCATE , POS(1) - 5
Z = TIMER
DO: IF ABS(Z - TIMER) > .1 THEN EXIT DO
LOOP
NEXT J
NEXT I
_DELAY 1
FOR I = 2 TO LEVEL1
IF I = LEVEL1 - 1 THEN SOUND 3000, .7: SOUND 358, 1.5: SOUND 5000, 1
IF I <> 2 THEN LOCATE I - 1, 27: PRINT SPACE$(28);
LOCATE I, 27: PRINT A1$;
Z = TIMER
DO: IF ABS(Z - TIMER) > .1 THEN EXIT DO
LOOP
NEXT
'If the meteor's x coordinate has moved off-screen to the left, it is as-
'signed a new random y coordinate, then reset to the right of the screen
IF Rocks(n).Mx < 0 THEN
Rocks(n).My = FIX(RND * 350)
Rocks(n).Mx = 642
END IF
'Meteors are drawn with lighter highlight circle offset +1/-1 pixel
CIRCLE (Rocks(n).Mx, Rocks(n).My), Rocks(n).Mr, 1
PAINT STEP(0, 0), 1
CIRCLE (Rocks(n).Mx + 1, Rocks(n).My - 1), Rocks(n).Mr - 2, 3
PAINT STEP(0, 0), 3
'Establish new location for each meteor by subtracting their
'individual speed (Ms) from their current x coordinate (Mx) ...
Rocks(n).Mx = Rocks(n).Mx - Rocks(n).Ms
RETURN
Mask:
FOR xx = 0 TO 83
FOR yy = 0 TO 60
IF POINT(xx, yy) = 0 THEN PSET (xx, yy), 15 ELSE PSET (xx, yy), 0
NEXT yy
NEXT xx
RETURN
Posted by: Pete - 04-26-2022, 01:10 AM - Forum: TheBOB
- No Replies
Pongg.bas by Bob Seguin Description: One player pong game. Use mouse to control paddle. Runs windowed or press Alt + Enter to run full screen.
Download: Download the zip file below. Unzip to either your QB64 folder, or for better organization, to a folder you create like "TheBOB-Pongg".
Install: Compile Pongg.bas with QB64 v1.3 or above, and make sure the compiler output is set to create the .exe file in the same folder. See the option in the QB64 IDE RUN menu and check the RUN option: "Output EXE to Source Folder".
SOLITAIRE CHESS v1.1. This is a QB64 clone of the popular one person logic puzzle that uses a small chess board (4x4) and chess pieces. The goal of solitaire chess is to capture all the chess pieces on the board and end up with only one chess piece. It's not as easy as it sounds - every move MUST capture a piece, and you must following chess rules when moving pieces. There are 10 levels to conquer.
To help explain how to play the puzzle, attached is a picture of the moves to solving the 1st level. That should get you started.
Note: This version is updated to display the same on every desktop regardless of the users screen resolution. The screen size is not hard-coded to a certain size.
Posted by: Pete - 04-26-2022, 12:42 AM - Forum: TheBOB
- No Replies
Rain.bas by Bob Seguin Description: Screen saver of a thunder storm taking place on an ocean pier.
Download: Download the zip file below. Unzip to either your QB64 folder, or for better organization, to a folder you create like "TheBOB-Rain".
Install: Compile Rain.bas with QB64 v1.3 or above, and make sure the compiler output is set to create the .exe file in the same folder. See the option in the QB64 IDE RUN menu and check the RUN option: "Output EXE to Source Folder".
Posted by: Pete - 04-26-2022, 12:24 AM - Forum: TheBOB
- No Replies
Rattler.bas by Bob Seguin
Code: (Select All)
'*****************************************************************************
'
'--------------------------- R A T T L E R . B A S ---------------------------
'
'---------------- Copyright (C) 2003 by Bob Seguin (Freeware) ----------------
'
'
'--------------------- RATTLER is a graphical version of ---------------------
'--------------------- the classic QBasic game, NIBBLES ----------------------
'
'*****************************************************************************
_TITLE "Rattler.bas by Bob Saguin"
DEFINT A-Z
DIM SHARED SnakePIT(1 TO 32, 1 TO 24)
DIM SHARED WipeBOX(29, 21)
CONST Left = 0
CONST Up = 125
CONST Right = 250
CONST Down = 375
CONST DL = 0
CONST DR = 125
CONST UR = 250
CONST UL = 375
CONST RD = 375
CONST LD = 250
CONST LU = 125
CONST RU = 0
TYPE DiamondBACK
Row AS INTEGER
Col AS INTEGER
BodyPART AS INTEGER
TURN AS INTEGER
WhichWAY AS INTEGER
RattleDIR AS INTEGER
END TYPE
DIM SHARED Rattler(72) AS DiamondBACK
TYPE ScoreTYPE
PlayerNAME AS STRING * 20
PlayDATE AS STRING * 10
PlayerSCORE AS LONG
END TYPE
DIM SHARED ScoreDATA(10) AS ScoreTYPE
DIM SHARED SnakeLENGTH
DIM SHARED SetSPEED
DIM SHARED Speed
DIM SHARED SpeedLEVEL
DIM SHARED Level
DIM SHARED Lives
DIM SHARED Score
DIM SHARED CrittersLEFT
OPEN "rattler.top" FOR APPEND AS #1
CLOSE #1
OPEN "rattler.top" FOR INPUT AS #1
DO WHILE NOT EOF(1)
INPUT #1, ScoreDATA(n).PlayerNAME
INPUT #1, ScoreDATA(n).PlayDATE
INPUT #1, ScoreDATA(n).PlayerSCORE
n = n + 1
LOOP
CLOSE #1
'Set all attributes to black (REM out to view the process)
FOR n = 1 TO 15
OUT &H3C8, n
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT n
OUT &H3C8, 9
OUT &H3C9, 52
OUT &H3C9, 42
OUT &H3C9, 32
LOCATE 12, 32: COLOR 9
PRINT "ONE MOMENT PLEASE..."
MaxWIDTH = 19
MaxDEPTH = 279
x = 0: y = 0
DO
READ Count, Colr
FOR Reps = 1 TO Count
PSET (x, y), Colr
x = x + 1
IF x > MaxWIDTH THEN
x = 0
y = y + 1
END IF
NEXT Reps
LOOP UNTIL y > MaxDEPTH
'Create directional sets
Index = 0
FOR y = 0 TO 260 STEP 20
GET (0, y)-(19, y + 19), SpriteBOX(Index)
GOSUB Poses
Index = Index + 500
NEXT y
CLS
PALETTE 9, 0
'Create stone block and erasing sprite(s)
LINE (0, 0)-(19, 19), 6, BF
FOR Reps = 1 TO 240
x = FIX(RND * 20) + 1
y = FIX(RND * 20) + 1
PSET (x, y), 7
PSET (x + 1, y + 1), 15
NEXT Reps
LINE (0, 0)-(19, 19), 6, B
LINE (1, 1)-(18, 18), 13, B
LINE (1, 1)-(1, 18), 15
LINE (1, 1)-(18, 1), 15
GET (0, 0)-(19, 19), SpriteBOX(Stone) 'stone tile
LINE (0, 0)-(19, 19), 8, BF
GET (0, 0)-(19, 19), SpriteBOX(Blank + Left) 'erasing tile
GET (0, 0)-(19, 19), SpriteBOX(Blank + Up) 'erasing tile
GET (0, 0)-(19, 19), SpriteBOX(Blank + Right) 'erasing tile
GET (0, 0)-(19, 19), SpriteBOX(Blank + Down) 'erasing tile
CLS
COLOR 9
LOCATE 9, 31
PRINT "RATTLER TOP-TEN LIST"
GET (240, 130)-(398, 140), TTBox()
LOCATE 9, 31
PRINT SPACE$(20)
'GET numbers
FOR n = 0 TO 9
LOCATE 10, 10
IF n = 0 THEN PRINT "O" ELSE PRINT LTRIM$(STR$(n))
FOR x = 72 TO 80
FOR y = 144 TO 160
IF POINT(x, y) = 0 THEN PSET (x, y), 15 ELSE PSET (x, y), 4
NEXT y
NEXT x
GET (72, 144)-(79, 156), NumBOX(NumDEX)
NumDEX = NumDEX + 40
NEXT n
LINE (72, 144)-(80, 160), 0, BF
RETURN
Poses:
'Draws/GETs the other 3 directional poses from each sprite
FOR i = Index TO Index + 250 STEP 125
PUT (100, 100), SpriteBOX(i), PSET
FOR Px = 100 TO 119
FOR Py = 100 TO 119
PSET (219 - Py, Px - 20), POINT(Px, Py)
NEXT Py
NEXT Px
GET (100, 80)-(119, 99), SpriteBOX(i + 125)
NEXT i
RETURN
SpriteVALUES:
DATA 47,8,2,12,2,0,16,8,3,5,1,12,1,13,1,12,1,13,1,12,8,8,1,0
DATA 1,12,1,15,1,8,1,15,3,5,1,14,3,1,1,14,1,13,5,8,2,5,1,12
DATA 1,5,4,12,3,3,1,5,1,12,1,3,1,12,1,14,1,13,2,8,1,3,14,5
DATA 1,3,1,5,1,1,1,13,1,3,1,5,1,12,1,5,1,12,1,5,1,12,1,5
DATA 1,12,1,5,1,12,3,5,1,12,1,5,1,12,2,3,1,1,22,5,1,12,1,5
DATA 1,12,1,3,1,12,1,3,1,12,1,3,1,12,1,3,1,12,1,15,1,12,1,3
DATA 1,12,1,3,1,12,1,3,2,5,1,12,1,5,1,12,1,3,1,12,1,3,1,12
DATA 1,3,1,12,1,3,1,12,1,15,1,12,1,3,1,12,1,3,1,12,1,3,17,5
DATA 1,3,2,5,1,3,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12,1,5
DATA 1,12,3,5,1,12,1,5,1,12,2,3,1,1,1,8,1,3,14,5,1,3,1,14
DATA 1,1,1,13,2,8,2,5,1,12,1,5,4,12,2,3,1,1,1,5,1,12,1,1
DATA 1,12,1,14,1,13,4,8,1,0,1,12,1,15,1,8,1,15,3,5,2,14,2,1
DATA 1,14,1,13,10,8,2,5,1,14,1,12,1,13,1,12,1,13,1,12,12,8,2,12
DATA 2,0,169,8,1,13,1,12,1,13,1,1,1,13,1,12,1,13,1,1,1,13,1,12
DATA 1,13,1,12,1,13,1,1,1,13,1,12,1,13,1,1,1,13,1,12,1,1,1,14
DATA 1,1,1,14,1,12,1,14,1,12,1,14,1,1,1,14,1,1,1,14,1,1,1,14
DATA 1,12,1,14,1,12,1,14,1,1,1,14,2,3,1,5,1,12,1,5,1,12,1,5
DATA 1,12,1,5,3,3,1,5,1,12,1,5,1,12,1,5,1,12,1,5,3,3,1,12
DATA 1,5,1,12,1,5,1,12,1,5,1,12,1,5,2,3,1,12,1,5,1,12,1,5
DATA 1,12,1,5,1,12,1,5,1,3,1,5,1,12,1,5,1,12,1,5,1,12,1,5
DATA 1,12,1,5,1,3,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12,1,5
DATA 2,3,1,5,1,12,1,5,1,12,1,5,1,12,1,5,3,3,1,5,1,12,1,5
DATA 1,12,1,5,1,12,1,5,1,3,1,1,1,14,1,1,1,14,1,12,1,14,1,12
DATA 1,14,1,1,1,14,1,1,1,14,1,1,1,14,1,12,1,14,1,12,1,14,1,1
DATA 1,14,1,13,1,12,1,13,1,1,1,13,1,12,1,13,1,1,1,13,1,12,1,13
DATA 1,12,1,13,1,1,1,13,1,12,1,13,1,1,1,13,1,12,220,8,1,12,1,13
DATA 1,12,1,13,1,12,1,13,1,12,1,13,1,12,1,13,1,12,1,13,1,12,1,13
DATA 1,12,1,13,1,12,1,13,1,12,1,13,1,14,1,12,1,14,1,1,1,14,1,12
DATA 1,14,1,1,1,14,1,12,1,14,1,12,1,14,1,1,1,14,1,12,1,14,1,1
DATA 1,14,2,12,1,14,1,3,1,14,1,12,1,14,1,12,1,14,1,3,1,14,1,12
DATA 1,14,1,3,1,14,1,12,1,14,1,12,1,14,1,3,1,14,1,5,1,3,1,5
DATA 1,12,1,5,1,12,1,5,1,12,1,5,1,3,1,5,1,3,1,5,1,12,1,5
DATA 1,12,1,5,1,12,1,5,1,3,1,15,1,5,1,12,1,5,1,12,1,5,1,12
DATA 1,5,1,12,1,5,1,15,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12
DATA 1,5,1,15,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,15
DATA 1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12,2,5,1,3,1,5,1,12
DATA 1,5,1,12,1,5,1,12,1,5,1,3,1,5,1,3,1,5,1,12,1,5,1,12
DATA 1,5,1,12,1,5,1,3,1,12,1,14,1,3,1,14,1,12,1,14,1,12,1,14
DATA 1,3,1,14,1,12,1,14,1,3,1,14,1,12,1,14,1,12,1,14,1,3,2,14
DATA 1,12,1,14,1,1,1,14,1,12,1,14,1,1,1,14,1,12,1,14,1,12,1,14
DATA 1,1,1,14,1,12,1,14,1,1,1,14,2,12,1,13,1,12,1,13,1,12,1,13
DATA 1,12,1,13,1,12,1,13,1,12,1,13,1,12,1,13,1,12,1,13,1,12,1,13
DATA 1,12,1,13,180,8,1,13,1,12,1,13,1,12,1,13,1,1,1,13,1,12,1,13
DATA 1,12,1,13,1,12,1,13,1,12,1,13,1,1,1,13,1,12,1,13,2,12,1,14
DATA 1,12,1,14,1,1,1,5,1,1,1,14,1,12,1,14,1,12,1,14,1,12,1,14
DATA 1,1,1,5,1,1,1,14,1,12,2,14,1,12,1,14,1,1,1,14,1,12,1,14
DATA 1,1,1,14,1,12,1,14,1,12,1,14,1,1,1,14,1,12,1,14,1,1,1,14
DATA 2,12,1,5,1,3,1,5,1,12,1,5,1,12,1,5,1,3,1,5,1,12,1,5
DATA 1,3,1,5,1,12,1,5,1,12,1,5,1,3,2,5,1,3,1,5,1,12,1,5
DATA 1,12,1,5,1,12,1,5,1,3,1,5,1,3,1,5,1,12,1,5,1,12,1,5
DATA 1,12,1,5,1,3,1,15,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12
DATA 1,5,1,15,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,15
DATA 1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,15,1,5,1,12
DATA 1,5,1,12,1,5,1,12,1,5,1,12,2,5,1,3,1,5,1,12,1,5,1,12
DATA 1,5,1,12,1,5,1,3,1,5,1,3,1,5,1,12,1,5,1,12,1,5,1,12
DATA 1,5,1,3,1,12,1,5,1,3,1,5,1,12,1,5,1,12,1,5,1,3,1,5
DATA 1,12,1,5,1,3,1,5,1,12,1,5,1,12,1,5,1,3,1,5,1,14,1,12
DATA 1,14,1,1,1,14,1,12,1,14,1,1,1,14,1,12,1,14,1,12,1,14,1,1
DATA 1,14,1,12,1,14,1,1,1,14,2,12,1,14,1,12,1,14,1,1,1,14,1,1
DATA 1,14,1,12,1,14,1,12,1,14,1,12,1,14,1,1,1,14,1,1,1,14,1,12
DATA 1,14,1,13,1,12,1,13,1,12,1,13,1,1,1,13,1,12,1,13,1,12,1,13
DATA 1,12,1,13,1,12,1,13,1,1,1,13,1,12,1,13,1,12,220,8,1,12,1,13
DATA 1,1,1,13,1,12,1,13,1,12,1,13,1,1,1,13,1,12,1,13,1,1,1,13
DATA 1,12,1,13,1,12,1,13,1,1,1,13,1,14,1,1,1,14,1,12,1,14,1,12
DATA 1,14,1,12,1,14,1,1,1,14,1,1,1,14,1,12,1,14,1,12,1,14,1,12
DATA 1,14,1,1,1,15,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12,1,5
DATA 1,15,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,15,1,5
DATA 1,12,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,15,1,5,1,12,1,5
DATA 1,12,1,5,1,12,1,5,1,12,1,5,1,14,1,1,1,14,1,12,1,14,1,12
DATA 1,14,1,12,1,14,1,3,1,14,1,3,1,14,1,12,1,14,1,12,1,14,1,12
DATA 1,14,1,1,1,12,1,13,1,1,1,13,1,12,1,13,1,12,1,13,1,1,1,13
DATA 1,12,1,13,1,1,1,13,1,12,1,13,1,12,1,13,1,1,1,13,300,8,1,12
DATA 1,13,1,12,1,13,1,3,1,13,1,3,1,13,1,3,1,13,1,12,1,13,1,12
DATA 1,13,1,3,1,13,1,3,1,13,1,3,1,13,1,5,1,12,1,5,1,12,1,5
DATA 1,3,1,5,1,12,2,3,1,5,1,12,1,5,1,12,1,5,1,3,1,5,1,12
DATA 2,3,1,5,1,12,1,5,1,12,1,5,1,3,1,5,1,12,2,3,1,5,1,12
DATA 1,5,1,12,1,5,1,3,1,5,1,12,2,3,1,12,1,13,1,12,1,13,1,3
DATA 1,13,1,3,1,13,1,3,1,13,1,12,1,13,1,12,1,13,1,3,1,13,1,3
DATA 1,13,1,3,1,13,286,8,2,13,1,8,2,13,1,8,2,13,1,8,2,13,8,8
DATA 1,5,2,1,1,14,2,1,1,14,2,1,1,14,2,1,1,14,1,13,1,8,1,13
DATA 1,3,1,13,1,3,1,13,1,1,2,3,1,14,2,3,1,14,2,3,1,14,2,3
DATA 1,14,1,3,1,13,1,3,1,5,1,12,5,3,1,5,2,3,1,5,2,3,1,5
DATA 2,3,1,5,3,3,1,5,1,12,5,3,1,5,2,3,1,5,2,3,1,5,2,3
DATA 1,5,2,3,1,13,1,3,1,13,1,3,1,13,1,1,2,3,1,14,2,3,1,14
DATA 2,3,1,14,2,3,1,14,1,3,1,13,5,8,1,5,2,1,1,12,2,1,1,12
DATA 2,1,1,12,2,1,1,14,1,13,7,8,2,13,1,8,2,13,1,8,2,13,1,8
DATA 2,13,129,8,1,12,1,5,1,3,2,5,1,3,1,5,1,12,12,8,1,13,1,1
DATA 1,5,2,12,1,5,1,1,1,13,12,8,1,12,1,5,1,12,2,5,1,12,1,5
DATA 1,12,12,8,1,13,1,12,1,5,2,12,1,5,1,12,1,13,12,8,1,12,1,5
DATA 1,12,2,5,1,12,1,5,1,12,11,8,1,13,1,5,1,3,1,5,2,12,1,5
DATA 1,1,1,13,6,8,1,13,1,12,1,13,1,12,1,13,1,1,1,5,1,15,1,12
DATA 2,5,1,3,1,5,1,12,6,8,1,1,1,5,1,1,1,5,1,12,1,5,1,12
DATA 1,5,1,15,1,5,1,3,1,5,1,1,1,13,6,8,2,3,1,5,1,12,1,5
DATA 1,12,1,5,1,12,1,5,1,3,2,5,1,13,7,8,1,12,1,15,1,12,1,5
DATA 1,12,1,5,1,12,1,5,1,12,2,5,1,1,1,12,7,8,1,5,1,15,1,12
DATA 1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,1,1,13,8,8,2,3,1,5
DATA 1,12,1,5,1,12,1,5,1,12,1,5,1,3,1,12,9,8,1,1,1,5,1,1
DATA 1,5,1,12,1,5,1,12,1,5,1,1,1,13,10,8,1,13,1,12,1,13,1,12
DATA 1,13,1,12,1,13,1,12,137,8,1,13,1,12,1,14,1,3,2,5,1,3,1,14
DATA 1,12,1,13,10,8,1,12,1,14,1,3,1,5,2,12,1,5,1,3,1,14,1,12
DATA 10,8,1,13,1,1,1,5,1,12,2,5,1,12,1,5,1,1,1,13,10,8,1,12
DATA 1,3,1,12,1,5,2,12,1,5,1,12,1,5,1,12,9,8,1,13,1,14,1,3
DATA 2,12,2,5,1,12,1,5,1,14,1,13,5,8,1,12,1,13,1,12,1,13,1,12
DATA 1,5,1,3,1,5,1,12,1,5,1,12,2,5,1,1,1,12,5,8,1,14,1,12
DATA 1,14,1,1,1,3,1,12,1,5,1,15,1,5,1,12,1,5,1,12,1,3,1,14
DATA 1,13,5,8,1,12,1,14,1,1,1,5,1,12,2,3,1,5,1,15,2,5,1,3
DATA 1,14,1,13,6,8,1,5,1,3,1,5,1,12,1,5,1,12,1,5,1,12,1,5
DATA 2,3,1,14,2,12,6,8,1,15,1,5,1,12,1,5,1,12,1,5,1,12,1,5
DATA 1,3,1,12,1,14,1,12,1,13,7,8,1,15,1,5,1,12,1,5,1,12,1,5
DATA 1,12,1,5,1,3,1,14,1,12,1,13,1,12,7,8,1,5,1,3,1,5,1,12
DATA 1,5,1,12,1,5,1,12,2,1,1,13,1,12,8,8,1,12,1,14,1,1,1,14
DATA 1,12,1,14,1,12,1,14,1,1,1,13,1,12,9,8,1,14,1,12,1,14,1,1
DATA 1,14,1,12,1,14,1,13,1,12,11,8,1,12,1,13,1,12,1,13,1,12,1,13
DATA 1,12,117,8,1,13,1,12,1,5,1,3,1,5,2,12,1,5,1,3,1,14,1,12
DATA 1,13,8,8,1,12,1,14,1,3,1,5,1,12,2,5,1,12,1,5,1,3,1,14
DATA 1,12,8,8,1,13,2,3,1,12,1,5,2,12,1,5,1,12,1,5,1,3,1,13
DATA 7,8,1,13,1,14,1,3,1,12,1,5,1,12,2,5,1,12,1,5,1,12,1,5
DATA 1,3,4,8,1,12,1,13,1,12,1,14,1,12,2,3,1,12,1,5,2,12,1,5
DATA 1,12,1,14,1,3,1,13,4,8,1,14,1,12,3,3,1,12,1,3,1,5,1,12
DATA 2,5,1,12,1,5,1,3,1,14,1,12,4,8,1,12,1,5,1,3,1,14,1,12
DATA 4,3,2,12,1,5,1,3,1,5,1,12,1,13,4,8,1,14,1,3,1,5,1,12
DATA 1,5,1,12,1,5,1,12,4,3,1,5,1,12,1,14,1,12,4,8,2,3,1,12
DATA 1,5,1,12,1,5,1,12,1,5,1,12,1,3,3,12,1,14,1,12,5,8,1,5
DATA 1,3,1,5,1,12,1,5,2,12,2,5,1,3,1,12,2,14,1,12,1,13,5,8
DATA 1,5,1,3,1,5,1,12,1,5,1,12,1,5,1,12,1,14,1,3,1,14,2,12
DATA 1,14,6,8,1,3,1,5,1,3,1,5,1,12,1,5,1,12,1,14,1,12,1,3
DATA 1,12,2,14,1,12,6,8,1,5,1,12,1,5,1,3,1,14,1,12,1,14,1,12
DATA 1,14,1,3,1,14,1,12,1,13,7,8,1,12,1,14,1,12,1,5,3,3,1,5
DATA 1,3,1,5,1,12,1,13,8,8,1,14,1,12,1,14,1,12,1,14,1,12,1,14
DATA 1,12,1,13,1,12,1,0,9,8,1,12,1,13,1,12,1,13,1,12,1,13,1,12
DATA 1,13,1,0,98,8,1,13,1,3,2,5,1,3,1,13,14,8,1,3,1,14,2,12
DATA 1,5,1,3,14,8,1,13,1,12,2,5,1,12,1,13,14,8,1,12,1,14,2,12
DATA 1,14,1,12,14,8,1,13,1,12,2,5,1,12,1,13,14,8,1,3,1,14,2,12
DATA 1,14,1,3,13,8,1,13,1,14,1,12,2,5,1,12,1,5,7,8,1,12,1,13
DATA 1,3,1,13,1,12,1,3,1,12,1,15,1,12,1,5,1,12,1,3,1,13,7,8
DATA 1,14,1,3,1,14,1,12,1,14,1,12,1,3,1,12,1,15,1,12,1,3,1,5
DATA 8,8,1,15,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12,1,5,1,12
DATA 1,13,8,8,1,15,1,5,1,12,1,5,1,12,1,5,1,12,1,3,1,12,1,14
DATA 1,13,9,8,1,14,1,3,1,14,1,12,1,14,1,12,1,14,1,12,1,13,1,3
DATA 10,8,1,12,1,13,1,3,1,13,1,12,1,3,1,12,1,13,160,8,1,1,2,3
DATA 1,1,16,8,1,1,2,3,1,1,16,8,1,13,2,12,1,13,16,8,1,3,2,5
DATA 1,3,16,8,1,13,2,3,1,13,16,8,1,3,2,5,1,3,15,8,1,13,1,5
DATA 1,15,1,12,1,13,14,8,1,13,1,5,1,12,2,5,1,0,8,8,1,12,1,13
DATA 1,12,1,13,1,3,1,13,3,3,2,12,9,8,1,3,1,12,1,3,1,12,1,3
DATA 1,15,1,5,1,12,2,3,1,0,9,8,1,5,1,12,1,5,1,12,1,5,1,15
DATA 1,5,1,12,1,3,11,8,1,12,1,13,1,12,1,13,1,3,1,13,1,3,1,0
DATA 257,8,2,6,3,8,2,6,1,7,7,8,1,13,1,8,1,13,1,8,3,6,1,7
DATA 3,8,2,7,1,13,7,8,1,6,2,8,2,6,2,7,1,8,1,0,3,6,1,7
DATA 8,8,2,7,1,15,2,7,1,8,1,0,5,6,1,7,6,8,2,7,1,8,1,15
DATA 2,6,1,7,7,6,1,7,4,8,1,6,4,7,2,6,1,7,7,6,1,7,2,6
DATA 2,8,1,6,4,7,2,6,1,7,7,6,1,7,1,6,1,8,1,6,2,8,2,7
DATA 1,8,1,15,2,6,1,7,7,6,1,7,3,8,1,6,2,8,2,7,1,15,2,7
DATA 1,8,1,0,5,6,1,7,4,8,1,6,1,8,1,6,2,8,2,6,2,7,1,8
DATA 1,0,3,6,1,7,4,8,1,6,1,8,1,13,1,8,1,13,1,8,3,6,1,7
DATA 3,8,2,7,1,13,3,8,1,13,7,8,2,6,3,8,2,6,1,7,5,8,1,13
DATA 138,8,1,10,8,8,1,10,7,8,1,2,1,8,1,10,8,8,1,10,2,2,5,8
DATA 2,11,1,2,1,8,1,2,10,8,1,2,2,8,1,10,2,2,1,8,1,2,9,8
DATA 1,10,1,2,1,8,1,2,1,8,4,2,10,8,1,10,1,15,2,2,1,11,2,2
DATA 2,11,2,2,8,8,1,10,1,8,1,15,1,2,2,11,2,2,2,11,3,2,6,8
DATA 1,10,6,2,1,11,3,2,1,11,2,2,6,8,1,10,6,2,1,11,3,2,1,11
DATA 2,2,7,8,1,10,1,8,1,15,1,2,2,11,2,2,2,11,3,2,8,8,1,10
DATA 1,15,2,2,1,11,2,2,2,11,2,2,10,8,1,10,1,2,1,8,1,2,1,8
DATA 4,2,14,8,1,2,2,8,1,10,2,2,1,8,1,2,9,8,1,10,2,2,5,8,2
DATA 11,1,2,1,8,1,2,8,8,1,10,7,8,1,2,1,8,1,10,20,8,1,10,42,8
PaletteVALUES:
DATA 18,18,18,50,44,36,0,42,0,56,50,42
DATA 63,0,0,51,43,30,48,48,52,42,42,42
DATA 0,14,0,54,24,63,21,63,21,0,30,0
DATA 34,22,21,32,32,32,45,37,24,63,63,63
SUB DrawSCREEN
FOR Col = 1 TO 32
PutSPRITE Col, 1, Stone
PutSPRITE Col, 24, Stone
NEXT Col
FOR Row = 1 TO 24
PutSPRITE 1, Row, Stone
PutSPRITE 32, Row, Stone
NEXT Row
COLOR 4
LOCATE 3, 5: PRINT "LIVES:"
LOCATE 3, 34: PRINT "R A T T L E R"
LOCATE 3, 65: PRINT "SCORE:"
FOR x = 254 TO 376
FOR y = 32 TO 45
PSET (x + 4, y - 30), 15
NEXT y
NEXT x
FOR x = 254 TO 376
FOR y = 32 TO 45
IF POINT(x, y) = 4 THEN
PSET (x + 6, y - 29), 0
PSET (x + 5, y - 30), 5
END IF
PSET (x, y), 0
NEXT y
NEXT x
LINE (258, 1)-(378, 1), 0
LINE (258, 1)-(258, 15), 0
FOR x = 26 TO 99
FOR y = 32 TO 45
PSET (x + 4, y - 30), 15
NEXT y
NEXT x
FOR x = 26 TO 99
FOR y = 32 TO 45
IF POINT(x, y) = 4 THEN PSET (x + 6, y - 30), 0
PSET (x, y), 0
NEXT y
NEXT x
LINE (28, 1)-(103, 1), 0
LINE (28, 1)-(28, 15), 0
FOR x = 504 TO 607
FOR y = 32 TO 45
IF POINT(x, y) = 4 THEN
PSET (x + 4, y - 30), 0
ELSE
PSET (x + 4, y - 30), 15
END IF
PSET (x, y), 0
NEXT y
NEXT x
LINE (508, 1)-(611, 1), 0
LINE (508, 1)-(508, 15), 0
LOCATE 28, 5: PRINT "LEVEL:"
FOR x = 28 TO 98
FOR y = 432 TO 445
IF POINT(x, y) = 4 THEN
PSET (x, y + 32), 0
ELSE
PSET (x, y + 32), 15
END IF
PSET (x, y), 0
NEXT y
NEXT x
LINE (28, 463)-(98, 463), 0
LINE (28, 463)-(28, 476), 0
LOCATE 28, 70: PRINT "SPEED:"
FOR x = 548 TO 612
FOR y = 432 TO 445
IF POINT(x, y) = 4 THEN
PSET (x, y + 32), 0
ELSE
PSET (x, y + 32), 15
END IF
PSET (x, y), 0
NEXT y
NEXT x
LINE (548, 463)-(612, 463), 0
LINE (548, 463)-(548, 476), 0
LINE (267, 463)-(371, 476), 15, BF
LINE (267, 463)-(371, 463), 0
LINE (267, 463)-(267, 476), 0
LINE (20, 20)-(619, 459), 8, BF
END SUB
FUNCTION EndGAME
IF Lives = 0 THEN
RemainingLIVES& = 1
ELSE
RemainingLIVES& = Lives
END IF
FinalSCORE& = Score * RemainingLIVES& * 10&
GET (166, 152)-(472, 327), BigBOX()
LINE (166, 152)-(472, 327), 0, BF
LINE (168, 154)-(470, 325), 8, B
LINE (170, 156)-(468, 323), 7, B
LINE (172, 158)-(466, 321), 6, B
IF FinalSCORE& > ScoreDATA(9).PlayerSCORE THEN
COLOR 4
LOCATE 12, 31
PRINT "- G A M E O V E R -"
COLOR 3
IF Lives = 0 THEN
LOCATE 13, 30
PRINT "(Sorry, no more lives)"
ELSE
LOCATE 13, 33
PRINT "Congratulations!"
END IF
Hundred$ = LTRIM$(STR$(FinalSCORE& MOD 1000))
IF FinalSCORE& >= 1000 THEN
IF VAL(Hundred$) = 0 THEN Hundred$ = "000"
IF VAL(Hundred$) < 100 THEN Hundred$ = "0" + Hundred$
Thousand$ = LTRIM$(STR$(FinalSCORE& \ 1000))
FinalSCORE$ = Thousand$ + "," + Hundred$
ELSE
FinalSCORE$ = Hundred$
END IF
COLOR 6: LOCATE 15, 28: PRINT "Your final score is ";
COLOR 15: PRINT FinalSCORE$
COLOR 9
LOCATE 16, 26: PRINT "Enter your name to record score"
LOCATE 17, 26: PRINT "(Just press ENTER to decline):"
COLOR 15
LOCATE 19, 26: INPUT ; Name$
IF LEN(Name$) THEN
ScoreDATA(10).PlayerNAME = LEFT$(Name$, 20)
ScoreDATA(10).PlayDATE = DATE$
ScoreDATA(10).PlayerSCORE = FinalSCORE&
FOR a = 0 TO 10
FOR B = a TO 10
IF ScoreDATA(B).PlayerSCORE > ScoreDATA(a).PlayerSCORE THEN
SWAP ScoreDATA(B), ScoreDATA(a)
END IF
NEXT B
NEXT a
TopTEN
OPEN "rattler.top" FOR OUTPUT AS #1
FOR Reps = 0 TO 9
WRITE #1, ScoreDATA(Reps).PlayerNAME
WRITE #1, ScoreDATA(Reps).PlayDATE
WRITE #1, ScoreDATA(Reps).PlayerSCORE
NEXT Reps
CLOSE #1
END IF
END IF
LINE (176, 160)-(462, 317), 0, BF
COLOR 4: LOCATE 14, 31: PRINT "- G A M E O V E R -"
COLOR 9
LOCATE 16, 26: PRINT "Start new game......"
LOCATE 17, 26: PRINT "QUIT................"
COLOR 6
LOCATE 16, 47: PRINT "Press [1]"
LOCATE 17, 47: PRINT "Press [2]"
DO
_LIMIT 30
k$ = INKEY$
LOOP UNTIL k$ = "1" OR k$ = "2" OR k$ = CHR$(27)
IF k$ = "1" THEN EndGAME = 1: EXIT FUNCTION
PALETTE: COLOR 7: CLS
SYSTEM
FOR n = 1 TO SnakeLENGTH
StartCOL = StartCOL - 1
Rattler(n).Col = StartCOL
Rattler(n).Row = 22
Rattler(n).TURN = 0
Rattler(n).WhichWAY = Right
SELECT CASE n
CASE 1: Rattler(n).BodyPART = Head
CASE 2: Rattler(n).BodyPART = Neck
CASE 3: Rattler(n).BodyPART = Shoulders
CASE 4: Rattler(n).BodyPART = Body
CASE 5: Rattler(n).BodyPART = Body
CASE 6: Rattler(n).BodyPART = Shoulders
CASE 7: Rattler(n).BodyPART = Neck
CASE 8: Rattler(n).BodyPART = Tail
CASE 9: Rattler(n).BodyPART = TailEND
CASE 10: Rattler(n).BodyPART = Rattle
CASE 11: Rattler(n).BodyPART = Blank
END SELECT
NEXT n
FOR n = 1 TO SnakeLENGTH
RCol = Rattler(n).Col
RRow = Rattler(n).Row
RIndex = Rattler(n).BodyPART + Rattler(n).TURN + Rattler(n).WhichWAY
PutSPRITE RCol, RRow, RIndex
NEXT n
SnakePIT(Rattler(SnakeLENGTH).Col, Rattler(SnakeLENGTH).Row) = 0
FOR Col = 1 TO 32
SnakePIT(Col, 1) = -1
SnakePIT(Col, 24) = -1
NEXT Col
FOR Row = 2 TO 23
SnakePIT(1, Row) = -1
SnakePIT(32, Row) = -1
NEXT Row
LINE (271, 466)-(368, 474), 15, BF
FOR x = 271 TO 361 STEP 10
Count = Count + 1
IF Count MOD 2 THEN Colr = 11 ELSE Colr = 7
LINE (x, 466)-(x + 7, 474), Colr, BF
NEXT x
END SUB
SUB Instructions
GET (100, 100)-(539, 379), BigBOX()
LINE (100, 100)-(539, 379), 0, BF
LINE (106, 106)-(533, 373), 13, B
LINE (108, 108)-(531, 371), 7, B
LINE (110, 110)-(529, 369), 6, B
COLOR 9: LOCATE 10, 27: PRINT "- I N S T R U C T I O N S -"
COLOR 6
LOCATE 12, 18: PRINT "RATTLER is a variation on the classic Microsoft"
LOCATE 13, 18: PRINT "QBasic game NIBBLES."
COLOR 15
LOCATE 12, 18: PRINT "RATTLER": LOCATE 13, 30: PRINT "NIBBLES"
COLOR 6
LOCATE 15, 18: PRINT "Steer the Diamondback Rattler using the Arrow"
LOCATE 16, 18: PRINT "keys, eating mice and frogs and scoring points"
COLOR 15: LOCATE 15, 58: PRINT "Arrow": COLOR 6
LOCATE 17, 18: PRINT "for each kill. These wary creatures cannot be"
LOCATE 18, 18: PRINT "caught from the front or sides, however. They"
LOCATE 19, 18: PRINT "must be snuck up on from behind, otherwise"
LOCATE 20, 18: PRINT "they will simply jump to a new location."
COLOR 13: LOCATE 22, 28: PRINT "PRESS ANY KEY TO CONTINUE..."
a$ = INPUT$(1)
LINE (120, 160)-(519, 332), 0, BF
COLOR 6
LOCATE 12, 18: PRINT "With each creature eaten, the rattler grows"
LOCATE 13, 18: PRINT "in length, making steering much more difficult"
LOCATE 14, 18: PRINT "and increasing the chance of self-collision."
LOCATE 16, 18: PRINT "There are ten levels, each one more hazardous"
LOCATE 17, 18: PRINT "than the last. If the snake hits a stone wall"
LOCATE 18, 18: PRINT "or bumps into himself, he dies. He has a total"
LOCATE 19, 18: PRINT "of five lives. Once they are used up, the game"
LOCATE 20, 18: PRINT "is over."
COLOR 15
LOCATE 16, 28: PRINT "ten": LOCATE 19, 21: PRINT "five"
a$ = INPUT$(1)
LINE (120, 160)-(519, 332), 0, BF
COLOR 6
LOCATE 12, 18: PRINT "Often, a mouse or frog will have its back to"
LOCATE 13, 18: PRINT "a wall, making it impossible to kill. In those"
LOCATE 14, 18: PRINT "situations, you must attack from the front or"
LOCATE 15, 18: PRINT "sides, forcing it to move to a location where"
LOCATE 16, 18: PRINT "its back is exposed."
LOCATE 18, 18: PRINT "There are five speeds to choose from. It may"
LOCATE 19, 18: PRINT "be wise to choose a slower speed for the high-"
LOCATE 20, 18: PRINT "er levels. The default speed is 3."
COLOR 15: LOCATE 18, 28: PRINT "five": LOCATE 20, 50: PRINT "3"
a$ = INPUT$(1)
LINE (120, 160)-(519, 332), 0, BF
COLOR 9
LOCATE 12, 18: PRINT "SCORING:"
COLOR 6
LOCATE 12, 18: PRINT "SCORING: Each kill scores 10 points multiplied"
LOCATE 13, 18: PRINT "by the level of difficulty and the speed. For"
LOCATE 14, 18: PRINT "example, at level 5, speed 3, a kill is worth"
LOCATE 15, 18: PRINT "150 points; level 10, speed 2: 200 points."
LOCATE 17, 18: PRINT "If you manage to complete all 10 levels, your"
LOCATE 18, 18: PRINT "final score is then multiplied by the number"
LOCATE 19, 18: PRINT "of remaining lives. In other words, the score"
LOCATE 20, 18: PRINT "accurately reflects your level of achievement."
COLOR 15
LOCATE 12, 18: PRINT "SCORING"
LOCATE 12, 44: PRINT "10": LOCATE 14, 36: PRINT "5"
LOCATE 14, 45: PRINT "3": LOCATE 15, 18: PRINT "150"
LOCATE 15, 36: PRINT "10": LOCATE 15, 46: PRINT "2"
LOCATE 15, 49: PRINT "200"
a$ = INPUT$(1)
LINE (120, 160)-(519, 368), 0, BF
COLOR 6
LOCATE 12, 18: PRINT "Indicators of remaining lives and the current"
LOCATE 13, 18: PRINT "score are located at the top of the screen on"
COLOR 15: LOCATE 12, 42: PRINT "lives"
LOCATE 13, 18: PRINT "score": COLOR 6
LOCATE 14, 18: PRINT "the extreme left and right, respectively."
LOCATE 16, 18: PRINT "The current level of play can be found on the"
LOCATE 17, 18: PRINT "bottom-left of the screen. Bottom-center you"
LOCATE 18, 18: PRINT "will find a graph indicating the number of"
LOCATE 19, 18: PRINT "prey remaining on the current level. The cur-"
LOCATE 20, 18: PRINT "rent speed can be read bottom-right."
COLOR 15
LOCATE 16, 30: PRINT "level"
LOCATE 18, 51: PRINT "number of": LOCATE 19, 18: PRINT "prey"
LOCATE 20, 23: PRINT "speed"
COLOR 13: LOCATE 22, 25: PRINT "PRESS ANY KEY TO RETURN TO GAME..."
a$ = INPUT$(1)
PUT (100, 100), BigBOX(), PSET
END SUB
SUB Intro
PutSPRITE 7, 16, Rattle + Up
PutSPRITE 7, 15, TailEND + Up
PutSPRITE 7, 14, Tail + Up
PutSPRITE 7, 13, Neck + Up
PutSPRITE 7, 12, Shoulders + Up
PutSPRITE 7, 11, Body + Up
PutSPRITE 7, 10, Body + TURN + UR
PutSPRITE 8, 10, Body + Right
PutSPRITE 9, 10, Body + TURN + RD
PutSPRITE 9, 11, Body + TURN + DL
PutSPRITE 8, 11, Body + TURN + LD
PutSPRITE 8, 12, Body + TURN + DR
PutSPRITE 9, 12, Body + TURN + RD
PutSPRITE 9, 13, Body + Down
PutSPRITE 9, 14, Body + TURN + DR
PutSPRITE 10, 14, Body + TURN + RU
PutSPRITE 10, 13, Body + Up
PutSPRITE 10, 12, Body + Up
PutSPRITE 10, 11, Body + Up
PutSPRITE 10, 10, Body + TURN + UR
PutSPRITE 11, 10, Body + Right
PutSPRITE 12, 10, Body + TURN + RD
PutSPRITE 12, 11, Body + Down
PutSPRITE 12, 12, Body + Down
PutSPRITE 12, 13, Body + Down
PutSPRITE 12, 14, Body + TURN + DR
PutSPRITE 13, 14, Body + Right
PutSPRITE 11, 12, Body + Right
PutSPRITE 13, 10, Body + Right
PutSPRITE 14, 10, Body + Right
PutSPRITE 15, 10, Body + Right
PutSPRITE 16, 10, Body + Right
PutSPRITE 17, 10, Body + Right
PutSPRITE 14, 11, Body + Down
PutSPRITE 14, 12, Body + Down
PutSPRITE 14, 13, Body + Down
PutSPRITE 14, 14, Body + TURN + DR
PutSPRITE 15, 14, Body + Right
PutSPRITE 16, 11, Body + Down
PutSPRITE 16, 12, Body + Down
PutSPRITE 16, 13, Body + Down
PutSPRITE 16, 14, Body + TURN + DR
PutSPRITE 17, 14, Body + Right
PutSPRITE 18, 10, Body + Down
PutSPRITE 18, 11, Body + Down
PutSPRITE 18, 12, Body + Down
PutSPRITE 18, 13, Body + Down
PutSPRITE 18, 14, Body + TURN + DR
PutSPRITE 19, 14, Body + Right
PutSPRITE 20, 10, Body + TURN + UR
PutSPRITE 21, 12, Body + Right
PutSPRITE 21, 10, Body + Right
PutSPRITE 20, 11, Body + Down
PutSPRITE 20, 12, Body + Down
PutSPRITE 20, 13, Body + Down
PutSPRITE 20, 14, Body + TURN + DR
PutSPRITE 21, 14, Body + Right
PutSPRITE 22, 16, Rattle + Up
PutSPRITE 22, 15, TailEND + Up
PutSPRITE 22, 14, Tail + Up
PutSPRITE 22, 13, Neck + Up
PutSPRITE 22, 12, Shoulders + Up
PutSPRITE 22, 11, Body + Up
PutSPRITE 22, 10, Body + TURN + UR
PutSPRITE 23, 10, Body + Right
PutSPRITE 24, 10, Body + TURN + RD
PutSPRITE 24, 11, Body + TURN + DL
PutSPRITE 23, 11, Body + TURN + LD
PutSPRITE 23, 12, Body + TURN + DR
PutSPRITE 24, 12, Body + TURN + RD
PutSPRITE 24, 13, Body + Down
PutSPRITE 24, 14, Body + TURN + DR
PutSPRITE 25, 14, Body + Right
PutSPRITE 26, 14, Shoulders + TURN + RU
PutSPRITE 26, 13, Neck + Up
PutSPRITE 26, 12, Head + Up
COLOR 13
LOCATE 22, 20
PRINT "Copyright (C) 2003 by Bob Seguin (Freeware)"
FOR x = 152 TO 496
FOR y = 336 TO 352
IF POINT(x, y) = 0 THEN PSET (x, y), 8
NEXT y
NEXT x
LINE (80, 106)-(560, 386), 13, B
LINE (76, 102)-(564, 390), 7, B
SetPALETTE
PLAY "MFMST200L32O0AP16AP16AP16DP16AP16AP16AP16>C<P16A"
FOR Reps = 1 TO 18
GOSUB Rattle1
NEXT Reps
_DELAY 2
Wipe
EXIT SUB
'------------------------ SUBROUTINE SECTION BEGINS --------------------------
Rattle1:
IF Reps MOD 3 = 0 THEN
LINE (509, 215)-(510, 219), 4, B
LINE (508, 210)-(508, 214), 4
LINE (511, 210)-(511, 214), 4
END IF
Hula = Hula + 1
PLAY "MFT220L64O0C"
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
SELECT CASE Hula MOD 2
CASE 0
PUT (418, 300), SpriteBOX(Rattle + Up), PSET
CASE 1
PUT (422, 300), SpriteBOX(Rattle + Up), PSET
END SELECT
SOUND 30000, 1
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
PUT (420, 300), SpriteBOX(Rattle + Up), PSET
IF Reps MOD 3 = 0 THEN
LINE (508, 210)-(511, 219), 8, BF
END IF
RETURN
END SUB
SUB PauseMENU (Item)
DO
GET (166, 162)-(472, 317), BigBOX()
LINE (166, 162)-(472, 317), 0, BF
LINE (168, 164)-(470, 315), 8, B
LINE (170, 166)-(468, 313), 7, B
LINE (172, 168)-(466, 311), 6, B
SELECT CASE Item
CASE 1
COLOR 4: LOCATE 13, 34: PRINT "L E V E L -"; (STR$(Level))
COLOR 15: LOCATE 15, 30: PRINT "PRESS SPACE TO BEGIN..."
COLOR 9: LOCATE 16, 26: PRINT "Instructions:[I] SetSPEED:[S]"
LOCATE 17, 24: PRINT "EXIT:[Esc] TopTEN:[T] ReSTART:[R]"
COLOR 7: LOCATE 19, 25: PRINT "To pause during play press SPACE"
CASE 2
COLOR 4: LOCATE 14, 29: PRINT "- G A M E P A U S E D -"
COLOR 6: LOCATE 15, 29: PRINT "Press SPACE to continue..."
COLOR 9: LOCATE 17, 26: PRINT "Instructions:[I] SetSPEED:[S]"
LOCATE 18, 24: PRINT "EXIT:[Esc] TopTEN:[T] ReSTART:[R]"
END SELECT
REM DO: LOOP UNTIL INKEY$ = "" 'Clear INKEY$ buffer
_KEYCLEAR
DO
DO
_LIMIT 30
k$ = UCASE$(INKEY$)
LOOP WHILE k$ = ""
SELECT CASE k$
CASE "I": GOSUB CloseMENU: Instructions: EXIT DO
CASE "S": GOSUB CloseMENU: SpeedSET: EXIT DO
CASE "R": GOSUB CloseMENU: Item = -1: EXIT SUB
CASE "T": GOSUB CloseMENU: TopTEN: EXIT DO
CASE CHR$(27): SYSTEM
CASE " ": GOSUB CloseMENU: EXIT SUB
END SELECT
LOOP
LOOP
GOSUB CloseMENU
EXIT SUB
CloseMENU:
PUT (166, 162), BigBOX(), PSET
RETURN
END SUB
SUB PlayGAME
IF Level = 0 THEN InitGAME
InitLEVEL
SetSTONES Level
Speed = SetSPEED
GOSUB PutPREY
Col = 21: Row = 22
RowINC = 0: ColINC = 1
Direction = Right: OldDIRECTION = Right
Increase = 0: Item = 1
REM DO: LOOP UNTIL INKEY$ = "" 'Clear INKEY$ buffer
_KEYCLEAR
PauseMENU Item
IF Item = -1 THEN GOSUB ReSTART
FOR Reps = 1 TO 6
GOSUB Rattle2
NEXT Reps
DO
_LIMIT 30
k$ = INKEY$
SELECT CASE k$
CASE CHR$(0) + "H"
IF RowINC <> 1 THEN RowINC = -1: ColINC = 0: Direction = Up
CASE CHR$(0) + "P"
IF RowINC <> -1 THEN RowINC = 1: ColINC = 0: Direction = Down
CASE CHR$(0) + "K"
IF ColINC <> 1 THEN ColINC = -1: RowINC = 0: Direction = Left
CASE CHR$(0) + "M"
IF ColINC <> -1 THEN ColINC = 1: RowINC = 0: Direction = Right
CASE " "
Item = 2
PauseMENU Item
IF Item = -1 THEN GOSUB ReSTART:
END SELECT
Row = Row + RowINC
Col = Col + ColINC
'Lengthen snake if prey has been eaten
IF Increase THEN
SnakeLENGTH = SnakeLENGTH + 1
FOR n = SnakeLENGTH TO SnakeLENGTH - 7 STEP -1
Rattler(n).BodyPART = Rattler(n - 1).BodyPART
NEXT n
Increase = Increase - 1
'If snake length has been increased significantly, adjust speed
IF Increase = 0 THEN
SELECT CASE SnakeLENGTH
CASE 36 TO 46: Speed = SetSPEED - 1
CASE IS > 46: Speed = SetSPEED - 2
END SELECT
END IF
END IF
FOR n = SnakeLENGTH TO 2 STEP -1
SWAP Rattler(n).Row, Rattler(n - 1).Row
SWAP Rattler(n).Col, Rattler(n - 1).Col
SWAP Rattler(n).TURN, Rattler(n - 1).TURN
SWAP Rattler(n).WhichWAY, Rattler(n - 1).WhichWAY
SWAP Rattler(n).RattleDIR, Rattler(n - 1).RattleDIR
NEXT n
IF Direction <> OldDIRECTION THEN
Rattler(2).TURN = TURN
SELECT CASE OldDIRECTION
CASE Up
SELECT CASE Direction
CASE Left: Rattler(2).WhichWAY = UL
CASE Right: Rattler(2).WhichWAY = UR
END SELECT
Rattler(2).RattleDIR = Up
CASE Down
SELECT CASE Direction
CASE Left: Rattler(2).WhichWAY = DL
CASE Right: Rattler(2).WhichWAY = DR
END SELECT
Rattler(2).RattleDIR = Down
CASE Left
SELECT CASE Direction
CASE Up: Rattler(2).WhichWAY = LU
CASE Down: Rattler(2).WhichWAY = LD
END SELECT
Rattler(2).RattleDIR = Left
CASE Right
SELECT CASE Direction
CASE Up: Rattler(2).WhichWAY = RU
CASE Down: Rattler(2).WhichWAY = RD
END SELECT
Rattler(2).RattleDIR = Right
END SELECT
END IF
Rattler(1).Row = Row
Rattler(1).Col = Col
Rattler(1).TURN = 0
Rattler(1).WhichWAY = Direction
Rattler(SnakeLENGTH).TURN = 0
Rattler(SnakeLENGTH - 1).TURN = 0
IF Rattler(SnakeLENGTH - 2).TURN = 0 THEN
Rattler(SnakeLENGTH - 1).WhichWAY = Rattler(SnakeLENGTH - 2).WhichWAY
ELSE
Rattler(SnakeLENGTH - 1).WhichWAY = Rattler(SnakeLENGTH - 2).RattleDIR
END IF
OldDIRECTION = Direction
'TEST Map values
SELECT CASE SnakePIT(Col, Row)
CASE IS >= 1000
IF SnakePIT(Col, Row) MOD 1000 = Rattler(1).WhichWAY THEN
IF SnakePIT(Col, Row) \ 1000 = 1 THEN PLAY "MBMST220L64O0BP16BO1P64B"
IF SnakePIT(Col, Row) \ 1000 = 2 THEN PLAY "MBT160L32O6A-B-B"
SnakePIT(Col, Row) = 0
PreySCORE = PreySCORE + 1
Score = Score + (Level * SpeedLEVEL)
PrintNUMS 2, Score
Increase = Increase + 5
CrittersLEFT = CrittersLEFT - 1
PrintNUMS 4, CrittersLEFT
IF PreySCORE = 10 THEN
PutSPRITE Col, Row, Blank
Wipe
PreySCORE = 0
CrittersLEFT = 10
Level = Level + 1
IF Level = 11 THEN Choice = EndGAME
IF Choice THEN GOSUB ReSTART
PrintNUMS 3, Level
EXIT SUB
END IF
SetPREY = 1
ELSE
SetPREY = 2
END IF
CASE IS < 0
PLAY "MBMST100O0L32GFEDC"
Lives = Lives - 1
PrintNUMS 1, Lives
PreySCORE = 0
GET (188, 184)-(450, 295), BigBOX()
LINE (188, 184)-(450, 295), 0, BF
LINE (190, 186)-(448, 293), 8, B
LINE (192, 188)-(446, 291), 7, B
LINE (194, 190)-(444, 289), 6, B
LINE (196, 192)-(442, 287), 6, B
IF SnakePIT(Col, Row) = -1 THEN
COLOR 4: LOCATE 15, 35: PRINT "G L O R N K !"
COLOR 9: LOCATE 16, 35: PRINT "HIT THE WALL!"
ELSE
COLOR 4: LOCATE 15, 37: PRINT "O U C H !"
COLOR 9: LOCATE 16, 35: PRINT "BIT YOURSELF!"
END IF
StartTIME! = TIMER: DO: LOOP WHILE TIMER < StartTIME! + 1
PUT (188, 184), BigBOX(), PSET
IF Lives = 0 THEN Choice = EndGAME
IF Choice THEN GOSUB ReSTART
CrittersLEFT = 10
Wipe
EXIT SUB
END SELECT
WAIT &H3DA, 8
FOR n = SnakeLENGTH TO 1 STEP -1
RCol = Rattler(n).Col
RRow = Rattler(n).Row
RIndex = Rattler(n).BodyPART + Rattler(n).TURN + Rattler(n).WhichWAY
PutSPRITE RCol, RRow, RIndex
IF Rattler(n).BodyPART = Body THEN
FOR nn = n TO 1 STEP -1
IF Rattler(n).BodyPART = Shoulders THEN
n = nn
EXIT FOR
END IF
NEXT nn
END IF
NEXT n
IF SetPREY THEN
IF SetPREY = 2 THEN
IF WhichPREY = 1 THEN WhichPREY = 0 ELSE WhichPREY = 1
END IF
GOSUB PutPREY
SetPREY = 0
END IF
Rattle2:
IF Reps MOD 3 = 0 THEN
LINE (420, 429)-(425, 430), 4, B
LINE (426, 428)-(430, 428), 4
LINE (426, 431)-(430, 431), 4
END IF
Hula = Hula + 1
PLAY "MFT220L64O0C"
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
SELECT CASE Hula MOD 2
CASE 0: PUT (220, 418), SpriteBOX(Rattle + Right), PSET
CASE 1: PUT (220, 422), SpriteBOX(Rattle + Right), PSET
END SELECT
SOUND 30000, 1
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
PUT (220, 420), SpriteBOX(Rattle + Right), PSET
IF Reps MOD 3 = 0 THEN
LINE (420, 428)-(430, 431), 8, BF
END IF
IF Level = 8 THEN PutSPRITE 12, 21, Stone
RETURN
PutPREY:
DO
PreyCOL = INT(RND * 30) + 2
PreyROW = INT(RND * 22) + 2
LOOP WHILE SnakePIT(PreyCOL, PreyROW) <> 0
WhichDIR = INT(RND * 4)
SELECT CASE WhichDIR
CASE 0: Way = Left
CASE 1: Way = Up
CASE 2: Way = Right
CASE 3: Way = Down
END SELECT
IF WhichPREY = 1 THEN
PutSPRITE PreyCOL, PreyROW, Frog + Way
SnakePIT(PreyCOL, PreyROW) = 1000 + Way
WhichPREY = 0
ELSE
PutSPRITE PreyCOL, PreyROW, Mouse + Way
SnakePIT(PreyCOL, PreyROW) = 2000 + Way
WhichPREY = 1
END IF
RETURN
ReSTART:
PLAY "MBMST200L32O0AP16AP16AP16DP16AP16AP16AP16>C<P16A"
Level = 0
Item = 0
Choice = 0
Wipe
EXIT SUB
RETURN
END SUB
SUB PrintNUMS (Item, Value)
PrintSCORE& = Value * 10&
SELECT CASE Item
CASE 1 'Lives
Num$ = LTRIM$(STR$(Value))
PrintX = 89: PrintY = 2
CASE 2 'Score
SELECT CASE PrintSCORE&
CASE 0 TO 9: Num$ = "0000"
CASE 10 TO 99: Num$ = "000"
CASE 100 TO 999: Num$ = "00"
CASE 1000 TO 9999: Num$ = "0"
END SELECT
Num$ = Num$ + LTRIM$(STR$(PrintSCORE&))
PrintX = 568: PrintY = 2
CASE 3 'Level
Num$ = LTRIM$(STR$(Value))
PrintX = 82: PrintY = 464
LINE (PrintX, PrintY)-(PrintX + 15, PrintY + 10), 15, BF
CASE 4 'Remaining prey
x = Value * 10 + 271
LINE (x, 466)-(x + 8, 474), 15, BF
CASE 5 'Speed
Num$ = LTRIM$(STR$(Value))
PrintX = 602: PrintY = 464
END SELECT
FOR n = 1 TO LEN(Num$)
Char$ = MID$(Num$, n, 1)
NumDEX = (ASC(Char$) - 48) * 40
PUT (PrintX, PrintY), NumBOX(NumDEX), PSET
PrintX = PrintX + 8
NEXT n
SELECT CASE Index
CASE Stone: SnakePIT(Col, Row) = -1
CASE ELSE: SnakePIT(Col, Row) = -2
END SELECT
END SUB
SUB SetPALETTE
RESTORE PaletteVALUES
FOR Colr = 0 TO 15
OUT &H3C8, Colr
READ Red: OUT &H3C9, Red
READ Grn: OUT &H3C9, Grn
READ Blu: OUT &H3C9, Blu
NEXT Colr
END SUB
SUB SetSTONES (Level)
SELECT CASE Level
CASE 2
FOR Col = 10 TO 23
PutSPRITE Col, 12, Stone
PutSPRITE Col, 13, Stone
NEXT Col
CASE 3
Row1 = 8: Row2 = 17
FOR Col = 10 TO 23
PutSPRITE Col, Row1, Stone
PutSPRITE Col, Row2, Stone
NEXT Col
CASE 4
Col1 = 9: Col2 = 24
FOR Row = 7 TO 18
IF Row = 12 THEN Row = 14
PutSPRITE Col1, Row, Stone
PutSPRITE Col2, Row, Stone
NEXT Row
FOR Col = 10 TO 23
PutSPRITE Col, 7, Stone
PutSPRITE Col, 18, Stone
NEXT Col
CASE 5
Col1 = 9: Col2 = 24
FOR Row = 6 TO 19
PutSPRITE Col1, Row, Stone
PutSPRITE Col2, Row, Stone
NEXT Row
FOR Col = 10 TO 23
IF Col = 16 THEN Col = 18
PutSPRITE Col, 6, Stone
PutSPRITE Col, 19, Stone
NEXT Col
Row = 12
FOR Col = 2 TO 31
IF Col = 3 THEN Col = 5
IF Col = 9 THEN Col = 24
IF Col = 29 THEN Col = 31
PutSPRITE Col, Row, Stone
PutSPRITE Col, Row + 1, Stone
NEXT Col
CASE 6
Row1 = 5: Row2 = 20
FOR Col = 5 TO 28
PutSPRITE Col, Row1, Stone
PutSPRITE Col, Row2, Stone
NEXT Col
Row1 = 8: Row2 = 17
FOR Col = 8 TO 25
PutSPRITE Col, Row1, Stone
PutSPRITE Col, Row2, Stone
NEXT Col
FOR Row = 9 TO 16
IF Row = 12 THEN Row = 14
PutSPRITE 8, Row, Stone
PutSPRITE 25, Row, Stone
NEXT Row
Col1 = 5: Col2 = 28
FOR Row = 6 TO 19
IF Row = 12 THEN Row = 14
PutSPRITE Col1, Row, Stone
PutSPRITE Col2, Row, Stone
NEXT Row
FOR Col = 11 TO 22
PutSPRITE Col, 11, Stone
PutSPRITE Col, 14, Stone
NEXT Col
FOR Row = 2 TO 23 STEP 21
PutSPRITE 16, Row, Stone
PutSPRITE 17, Row, Stone
NEXT Row
FOR Col = 2 TO 31 STEP 29
PutSPRITE Col, 12, Stone
PutSPRITE Col, 13, Stone
NEXT Col
CASE 7
FOR Col = 14 TO 19
PutSPRITE Col, 5, Stone
NEXT Col
FOR Col = 12 TO 13
PutSPRITE Col, 6, Stone
PutSPRITE Col + 8, 6, Stone
NEXT Col
PutSPRITE 11, 7, Stone
PutSPRITE 10, 8, Stone
PutSPRITE 9, 9, Stone
PutSPRITE 22, 7, Stone
PutSPRITE 23, 8, Stone
PutSPRITE 24, 9, Stone
FOR Row = 10 TO 11
PutSPRITE 8, Row, Stone
PutSPRITE 25, Row, Stone
NEXT Row
FOR Col = 14 TO 19
PutSPRITE Col, 19, Stone
NEXT Col
FOR Col = 12 TO 13
PutSPRITE Col, 18, Stone
PutSPRITE Col + 8, 18, Stone
NEXT Col
PutSPRITE 11, 17, Stone
PutSPRITE 10, 16, Stone
PutSPRITE 9, 15, Stone
PutSPRITE 22, 17, Stone
PutSPRITE 23, 16, Stone
PutSPRITE 24, 15, Stone
FOR Row = 13 TO 14
PutSPRITE 8, Row, Stone
PutSPRITE 25, Row, Stone
NEXT Row
FOR Col = 4 TO 10
PutSPRITE Col, 4, Stone
PutSPRITE 33 - Col, 4, Stone
PutSPRITE Col, 20, Stone
PutSPRITE 33 - Col, 20, Stone
NEXT Col
FOR Row = 4 TO 11
PutSPRITE 4, Row, Stone
PutSPRITE 4, 24 - Row, Stone
PutSPRITE 29, Row, Stone
PutSPRITE 29, 24 - Row, Stone
NEXT Row
FOR Row = 7 TO 17
IF Row = 9 THEN Row = 16
PutSPRITE 9, Row, Stone
PutSPRITE 24, Row, Stone
NEXT Row
PutSPRITE 10, 7, Stone
PutSPRITE 10, 17, Stone
PutSPRITE 23, 7, Stone
PutSPRITE 23, 17, Stone
CASE 8
FOR Col = 5 TO 25 STEP 6
IF Col = 17 THEN Col = 18
FOR Row = 5 TO 21 STEP 4
PutSPRITE Col, Row, Stone
PutSPRITE Col + 1, Row, Stone
PutSPRITE Col + 3, Row, Stone
PutSPRITE Col + 4, Row, Stone
NEXT Row
NEXT Col
FOR Row = 5 TO 20
FOR Col = 5 TO 29 STEP 6
IF Col = 17 THEN Col = 22
PutSPRITE Col, Row, Stone
NEXT Col
NEXT Row
FOR Col = 2 TO 31
IF Col = 4 THEN Col = 30
PutSPRITE Col, 12, Stone
PutSPRITE Col, 13, Stone
NEXT Col
FOR Row = 2 TO 3
PutSPRITE 16, Row, Stone
PutSPRITE 17, Row, Stone
NEXT Row
CASE 9
FOR Col = 6 TO 24 STEP 8
FOR Row = 7 TO 16 STEP 9
PutSPRITE Col, Row, Stone
PutSPRITE Col + 1, Row - 1, Stone
PutSPRITE Col + 2, Row - 2, Stone
PutSPRITE Col + 3, Row - 2, Stone
PutSPRITE Col + 4, Row - 1, Stone
PutSPRITE Col + 5, Row, Stone
PutSPRITE Col, Row + 2, Stone
PutSPRITE Col + 1, Row + 3, Stone
PutSPRITE Col + 2, Row + 4, Stone
PutSPRITE Col + 3, Row + 4, Stone
PutSPRITE Col + 4, Row + 3, Stone
PutSPRITE Col + 5, Row + 2, Stone
NEXT Row
NEXT Col
FOR Col = 4 TO 31 STEP 8
FOR Row = 12 TO 13
PutSPRITE Col, Row, Stone
PutSPRITE Col + 1, Row, Stone
NEXT Row
NEXT Col
CASE 10
FOR Col = 7 TO 25 STEP 6
FOR Row = 7 TO 17 STEP 5
FOR Col2 = Col TO Col + 1
FOR Row2 = Row TO Row + 1
PutSPRITE Col2, Row2, Stone
NEXT Row2
NEXT Col2
PutSPRITE Col - 1, Row - 1, Stone
PutSPRITE Col - 1, Row + 2, Stone
PutSPRITE Col + 2, Row - 1, Stone
PutSPRITE Col + 2, Row + 2, Stone
NEXT Row
NEXT Col
FOR Col = 2 TO 30 STEP 28
FOR Row = 2 TO 22 STEP 20
PutSPRITE Col, Row, Stone
PutSPRITE Col + 1, Row, Stone
PutSPRITE Col, Row + 1, Stone
PutSPRITE Col + 1, Row + 1, Stone
NEXT Row
NEXT Col
PutSPRITE 4, 4, Stone
PutSPRITE 29, 4, Stone
PutSPRITE 4, 21, Stone
PutSPRITE 29, 21, Stone
FOR Col = 2 TO 31
IF Col = 5 THEN Col = 29
PutSPRITE Col, 11, Stone
PutSPRITE Col, 14, Stone
NEXT Col
END SELECT
END SUB
SUB SpeedSET
GET (166, 142)-(472, 337), BigBOX()
LINE (166, 142)-(472, 337), 0, BF
LINE (168, 144)-(470, 335), 8, B
LINE (170, 146)-(468, 333), 7, B
LINE (172, 148)-(466, 331), 6, B
COLOR 4
LOCATE 12, 31: PRINT "- S E T S P E E D -"
COLOR 9
LOCATE 13, 26: PRINT "The current speed setting is ";
PRINT LTRIM$(RTRIM$(STR$(SpeedLEVEL))); "."
COLOR 7
LOCATE 15, 28: PRINT "Slow............ Press [1]"
LOCATE 16, 28: PRINT "Moderate........ Press [2]"
LOCATE 17, 28: PRINT "Medium.......... Press [3]"
LOCATE 18, 28: PRINT "Quick........... Press [4]"
LOCATE 19, 28: PRINT "Fast............ Press [5]"
COLOR 6
LOCATE 15, 28: PRINT "Slow"
LOCATE 16, 28: PRINT "Moderate"
LOCATE 17, 28: PRINT "Medium"
LOCATE 18, 28: PRINT "Quick"
LOCATE 19, 28: PRINT "Fast"
COLOR 15
LOCATE 15, 52: PRINT "1"
LOCATE 16, 52: PRINT "2"
LOCATE 17, 52: PRINT "3"
LOCATE 18, 52: PRINT "4"
LOCATE 19, 52: PRINT "5"
DO
_LIMIT 30
n$ = INKEY$
LOOP WHILE n$ = ""
SELECT CASE n$
CASE "1": SpeedLEVEL = 1: SetSPEED = 25
CASE "2": SpeedLEVEL = 2: SetSPEED = 15
CASE "3": SpeedLEVEL = 3: SetSPEED = 8
CASE "4": SpeedLEVEL = 4: SetSPEED = 5
CASE "5": SpeedLEVEL = 5: SetSPEED = 2
END SELECT
PrintNUMS 5, SpeedLEVEL
Speed = SetSPEED
PUT (166, 142), BigBOX(), PSET
END SUB
SUB TopTEN
GET (84, 119)-(554, 359), BigBOX()
LINE (84, 119)-(554, 359), 0, BF
PUT (240, 137), TTBox(), PSET
COLOR 9
LOCATE 11, 15
PRINT "#"; SPACE$(2); "NAME"; SPACE$(21); "DATE"; SPACE$(10); "SCORE"
COLOR 7
LOCATE 22, 26
PRINT "PRESS ANY KEY TO RETURN TO GAME"
PrintROW = 12
FOR c = 0 TO 9
LOCATE PrintROW, 14
COLOR 9: PRINT USING "##"; c + 1
COLOR 3
IF ScoreDATA(c).PlayerSCORE > 0 THEN
LOCATE PrintROW, 18
PRINT ScoreDATA(c).PlayerNAME
LOCATE PrintROW, 40
PRINT ScoreDATA(c).PlayDATE
LOCATE PrintROW, 56
PRINT USING "###,###"; ScoreDATA(c).PlayerSCORE
END IF
PrintROW = PrintROW + 1
NEXT c
LINE (87, 121)-(551, 357), 13, B
LINE (89, 123)-(549, 355), 13, B
PSET (89, 123), 15
LINE (91, 125)-(547, 353), 13, B
PSET (91, 125), 15
LINE (100, 157)-(538, 334), 13, B
FOR LR = 174 TO 334 STEP 16
LINE (100, LR)-(538, LR), 13
NEXT LR
LINE (124, 158)-(124, 334), 13
LINE (300, 158)-(300, 334), 13
LINE (402, 158)-(402, 334), 13
a$ = INPUT$(1)
PUT (84, 119), BigBOX(), PSET
END SUB
SUB Wipe
FOR n = 1 TO 660
DO
x = INT(RND * 30)
y = INT(RND * 22)
xx = x + 1: yy = y + 1
LOOP UNTIL WipeBOX(x, y) = 0
LINE (xx * 20, yy * 20)-(xx * 20 + 19, yy * 20 + 19), 9, BF
LINE (xx * 20, yy * 20)-(xx * 20 + 19, yy * 20 + 19), 4, BF
LINE (xx * 20, yy * 20)-(xx * 20 + 19, yy * 20 + 19), 10, BF
LINE (xx * 20, yy * 20)-(xx * 20 + 19, yy * 20 + 19), 15, BF
LINE (xx * 20, yy * 20)-(xx * 20 + 19, yy * 20 + 19), 10, BF
LINE (xx * 20, yy * 20)-(xx * 20 + 19, yy * 20 + 19), 8, BF
WipeBOX(x, y) = 1
NEXT n
This is a modern-looking clock that builds up the circles as it goes for seconds, minutes, and hours. I used the 4th number in the RGB commands for CIRCLE to make them a bit translucent. You can see the picture below. Like most of my clocks I added Dav's chimes to it. The clock hands and chimes are in a separate SUB if anyone wants to use it for their own clock.
Code: (Select All)
'Circular Clock by SierraKen
'April 25, 2022
'Chimes code by Dav.
w = 180
Screen _NewImage(400, 400, 32)
Do
_Limit 20
t$ = Time$
hour$ = Left$(t$, 2)
minute$ = Mid$(t$, 4, 2)
second$ = Right$(t$, 2)
hour = Val(hour$)
minute = Val(minute$)
second = Val(second$)
If hour < 12 Then ampm$ = "am"
If hour > 11 Then ampm$ = "pm"
If hour > 12 Then hour = hour - 12
If hour = 0 Then hour = 12
If minute < 10 Then
zero = 1
Else
zero = 0
End If
If hour < 10 Then
zero2 = 1
Else
zero2 = 0
End If
If second < 10 Then
zero3 = 1
Else
zero3 = 0
End If
hr$ = Str$(hour)
mi$ = LTrim$(Str$(minute))
se$ = LTrim$(Str$(second))
If zero = 1 Then mi$ = "0" + LTrim$(mi$)
If zero2 = 1 Then hr$ = "0" + LTrim$(hr$)
If zero3 = 1 Then se$ = "0" + LTrim$(se$)
ti$ = hr$ + ":" + mi$ + ":" + se$ + " " + ampm$ + " Space Bar to hear hour."
_Title ti$
For back = 0 To 400 Step .1
cl = cl + .06
Line (0, back)-(400, back), _RGB32(0, 0, cl)
Next back
cl = 0
Circle (200, 200), w, _RGB32(255, 255, 255)
For s = .1 To (second * 3) Step .1
Circle (200, 200), s, _RGB32(127, 255, 127, 30)
Next s
For h = .1 To (hour * 15) Step .1
Circle (200, 200), h, _RGB32(255, 0, 0, 30)
Next h
For m = .1 To (minute * 3) Step .1
Circle (200, 200), m, _RGB32(0, 0, 255, 15)
Next m
clock song
For sz = .1 To 5 Step .1
Circle (200, 200), sz, _RGB32(0, 0, 0)
Next sz
_Display
Cls
Loop Until InKey$ = Chr$(27)
End
Sub clock (song)
_Limit 20
a$ = InKey$
If a$ = Chr$(27) Then End
If a$ = " " Then song = 1
hours = (Timer \ 3600)
minutes = Timer \ 60 - hours * 60
seconds = (Timer - hours * 3600 - minutes * 60)
hours = hours + (minutes / 60) 'Code added to make hour hand move between numbers.
ho$ = Left$(Time$, 2): hou = Val(ho$)
min$ = Mid$(Time$, 4, 2): minu = Val(min$)
seco$ = Right$(Time$, 2): secon = Val(seco$)
'Seconds
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 120) + 200
y = Int(Cos(s / 180 * 3.141592) * 120) + 200
For b = -5 To 5 Step .1
Line (200 + b, 200)-(x, y), _RGB32(127, 255, 127, 30)
Line (200, 200 + b)-(x, y), _RGB32(127, 255, 127, 30)
Next b
'Minutes
m = 180 - minutes * 6
xx = Int(Sin(m / 180 * 3.141592) * 120) + 200
yy = Int(Cos(m / 180 * 3.141592) * 120) + 200
For b = -5 To 5 Step .1
Line (200 + b, 200)-(xx, yy), _RGB32(0, 0, 255, 30)
Line (200, 200 + b)-(xx, yy), _RGB32(0, 0, 255, 30)
Next b
'Hours
h = 360 - hours * 30 + 180
xxx = Int(Sin(h / 180 * 3.141592) * 65) + 200
yyy = Int(Cos(h / 180 * 3.141592) * 65) + 200
For b = -5 To 5 Step .1
Line (200 + b, 200)-(xxx, yyy), _RGB32(255, 0, 0, 30)
Line (200, 200 + b)-(xxx, yyy), _RGB32(255, 0, 0, 30)
Next b
'Chimes
If (minu = 0 And secon = 0) Or song = 1 Then
song = 0
'Note frequencies thanks to Dav!
For notes = 1 To 20
If notes = 1 Then note = 311.13 'D#
If notes = 2 Then note = 246.94 'B
If notes = 3 Then note = 277.18 'C#
If notes = 4 Then note = 185.00 'F#
If notes = 5 Then note = 0
If notes = 6 Then note = 185.00 'F#
If notes = 7 Then note = 277.18 'C#
If notes = 8 Then note = 311.13 'D#
If notes = 9 Then note = 246.94 'B
If notes = 10 Then note = 0
If notes = 11 Then note = 311.13 'D#
If notes = 12 Then note = 277.18 'C3
If notes = 13 Then note = 246.94 'B
If notes = 14 Then note = 185.00 'F#
If notes = 15 Then note = 0
If notes = 16 Then note = 185.00 'F#
If notes = 17 Then note = 277.18 'C#
If notes = 18 Then note = 311.13 'D#
If notes = 19 Then note = 246.94 'B
If notes = 20 Then note = 0
Do
'queue some sound
Do While _SndRawLen < 0.5 'you may wish to adjust this
sample = Sin(ttt * note * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
_SndRaw sample
ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
Loop
'do other stuff, but it may interrupt sound
Loop While ttt < 1 'play for 1 second
Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop
ttt = 0
Next notes
hour2 = hou
If hour2 > 12 Then hour2 = hour2 - 12
If hour2 = 0 Then hour2 = 12
For chimes = 1 To hour2
ttt = 0
Do
'queue some sound
Do While _SndRawLen < 0.1 'you may wish to adjust this
sample = Sin(ttt * 240 * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
_SndRaw sample
ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
Loop
'do other stuff, but it may interrupt sound
Loop While ttt < 2 'play for 2 seconds
Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop
Next chimes
End If
two:
End Sub
Posted by: Pete - 04-25-2022, 11:51 PM - Forum: TheBOB
- No Replies
SCRAMBLE.BAS by Bob Seguin
Code: (Select All)
'--------------------------------------------
' S C R A M B L E . B A S
' based on a popular keychain puzzle
' Freeware 2001 by Bob Seguin
'--------------------------------------------
_TITLE "SCRAMBLE.BAS by Bob Seguin"
DEFINT A-Z
DIM SHARED TileBOX(1 TO 5000)
DIM SHARED Puzzle(1 TO 6, 1 TO 7)
DIM SHARED Numbers(1 TO 20)
DIM SHARED RowCOL(1 TO 4, 1 TO 5)
DIM SHARED Ticks, Elapsed$
DIM SHARED GameOVER, TimesUP, GameSTARTED, NewGAME
SCREEN 12
DrawSCREEN
GOSUB SetPALETTE
'Initialize game arrays
FOR n = 1 TO 20
Numbers(n) = n
NEXT n
FOR Row = 2 TO 6
FOR Col = 2 TO 5
SetNUM = SetNUM + 1
Puzzle(Col, Row) = SetNUM
NEXT Col
NEXT Row
RANDOMIZE TIMER
ON TIMER(1) GOSUB Clock
SetTILES 0
NewGAME = 1
'Game menu
DO
_LIMIT 30
MouseSTATUS LB, RB, MouseX, MouseY
k$ = UCASE$(INKEY$)
IF k$ = CHR$(27) THEN SYSTEM
IF k$ = "B" THEN '<--------"BOSS" key
FOR Colr = 0 TO 15
OUT &H3C8, Colr
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT Colr
DO
k$ = INKEY$
LOOP UNTIL k$ <> ""
IF k$ = CHR$(27) THEN SYSTEM
Colr = 0
GOSUB SetPALETTE
END IF
IF k$ = "P" THEN '<-------------Pause
StoppedTIME! = TIMER
a$ = INPUT$(1)
StartTIME! = TIMER - StoppedTIME! + StartTIME!
END IF
SELECT CASE MouseX
CASE 262 TO 381
IF Item THEN Menu 1
PlayGAME
CASE 545 TO 565
Menu 0
CASE ELSE
IF Item THEN Menu 1
END SELECT
IF GameOVER OR TimesUP THEN GOSUB CloseUP
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
ClearMOUSE
LOOP
SYSTEM
'------ SUBROUTINE SECTION ---------
CloseUP:
TIMER OFF
TIMERon = 0
IF TimesUP THEN
COLOR 13
LOCATE 20, 58: PRINT "Sorry, time's up!"
PLAY "MBMST200L16O6gec<gc<gec<gec<gec<gec"
LOCATE 18, 70: PRINT Elapsed$
ELSE
COLOR 10
LOCATE 20, 59: PRINT "Congratulations!"
PLAY "MBMST120O1L16ceg>ceg>ceg>L32cgcgcgcg"
LOCATE 18, 70: PRINT Elapsed$
END IF
OUT &H3C8, 2
OUT &H3C9, 58
OUT &H3C9, 58
OUT &H3C9, 58
OUT &H3C8, 4
OUT &H3C9, 63
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C8, 5
OUT &H3C9, 20
OUT &H3C9, 20
OUT &H3C9, 48
OUT &H3C8, 6
OUT &H3C9, 5
OUT &H3C9, 17
OUT &H3C9, 58
OUT &H3C8, 11
OUT &H3C9, 40
OUT &H3C9, 34
OUT &H3C9, 63
OUT &H3C8, 12
OUT &H3C9, 58
OUT &H3C9, 57
OUT &H3C9, 60
RETURN
Clock:
Ticks = Ticks + 1
IF Ticks > 599 THEN
TimesUP = 1
Ticks = 600
END IF
Minute$ = LTRIM$(STR$(Ticks \ 60 MOD 60))
IF VAL(Minute$) < 10 THEN Minute$ = "0" + Minute$
Second$ = LTRIM$(STR$(Ticks MOD 60))
IF VAL(Second$) < 10 THEN Second$ = "0" + Second$
Elapsed$ = Minute$ + ":" + Second$
COLOR 11: LOCATE 18, 70: PRINT Elapsed$
RETURN
SUB ClearMOUSE
SHARED LB, RB
WHILE LB OR RB
MouseSTATUS LB, RB, MouseX, MouseY
WEND
END SUB
SUB DrawSCREEN
x = 40: y = 100
COLOR 7
LOCATE 9, 12: PRINT "1 2 3 4"
LOCATE 11, 12: PRINT "5 6 7 8"
LOCATE 13, 12: PRINT "9 1O 11 12"
LOCATE 15, 11: PRINT "13 14 15 16"
LOCATE 17, 11: PRINT "17 18 19"
GET (86, 130)-(166, 187), TileBOX()
LINE (86, 130)-(166, 187), 0, BF
PUT (82, 130), TileBOX(), PSET
GET (86, 190)-(100, 210), TileBOX()
PUT (83, 190), TileBOX(), PSET
FOR x = 76 TO 148 STEP 24
FOR y = 120 TO 248 STEP 32
LINE (x, y)-(x + 24, y + 32), 8, B
NEXT y
NEXT x
LOCATE 20, 9: PRINT "The object of the"
LOCATE 21, 9: PRINT "game is to arrange"
LOCATE 22, 9: PRINT "the tiles as shown"
LOCATE 23, 9: PRINT "above."
LOCATE 25, 9: PRINT "Use the blank square to move"
LOCATE 26, 9: PRINT "tiles around. To move a tile to"
LOCATE 27, 9: PRINT "an adjacent blank, simply click it."
LOCATE 23, 58: PRINT "TIMER begins with";
LOCATE 24, 60: PRINT "the first click";
LOCATE 26, 58: PRINT "MAXIMUM GAME TIME";
LOCATE 27, 54: PRINT "ALLOWED IS 10 MINUTES";
DIM NumBOX(1 TO 1000)
LINE (0, 1)-(2, 18), 15, BF
GET (0, 1)-(2, 18), NumBOX()
LINE (0, 1)-(2, 18), 0, BF
FOR x = 3 TO 83 STEP 10
FOR y = 1 TO 16 STEP 7
LINE (x, y)-(x + 8, y + 3), 15, BF
LINE (x, 1)-(x + 2, 18), 15, BF
LINE (x + 6, 1)-(x + 8, 18), 15, BF
NEXT y
NEXT x
LINE (3, 5)-(5, 7), 0, BF
LINE (9, 12)-(11, 14), 0, BF
LINE (13, 5)-(15, 7), 0, BF
LINE (13, 12)-(15, 14), 0, BF
LINE (26, 1)-(28, 7), 0, BF
LINE (23, 12)-(28, 18), 0, BF
LINE (39, 5)-(41, 7), 0, BF
LINE (33, 12)-(35, 14), 0, BF
LINE (49, 5)-(51, 7), 0, BF
LINE (53, 5)-(58, 18), 0, BF
LINE (53, 8)-(61, 18), 0, BF
LINE (58, 8)-(60, 8), 15, BF
LINE (57, 9)-(59, 10), 15, BF
LINE (56, 11)-(58, 18), 15, BF
LINE (73, 12)-(75, 14), 0, BF
LINE (86, 6)-(88, 14), 0, BF
Index = 101
FOR x = 3 TO 83 STEP 10
GET (x, 1)-(x + 8, 18), NumBOX(Index)
Index = Index + 100
NEXT x
x = 0
LINE (0, 0)-(120, 20), 0, BF
'Draw and GET tiles
Index = 1
Index2 = 1
FOR Reps = 1 TO 20
LINE (20, 0)-(49, 29), 12, BF
LINE (20, 0)-(49, 29), 0, B
LINE (21, 1)-(48, 28), 15, B
LINE (48, 1)-(48, 28), 7
LINE (21, 28)-(48, 28), 7
PSET (20, 0), 1
PSET (49, 0), 1
PSET (20, 29), 1
PSET (49, 29), 1
IF Reps < 10 THEN
IF Index = 1 THEN
PUT (3, 0), NumBOX(Index)
ELSE
PUT (0, 0), NumBOX(Index)
END IF
ELSE
IF Reps = 11 THEN
PUT (3, 0), NumBOX()
PUT (10, 0), NumBOX()
ELSE
PUT (1, 0), NumBOX()
PUT (6, 0), NumBOX(Index)
END IF
END IF
Index = Index + 100
IF Index = 1001 THEN
Index = 1
Repeat = 1
END IF
PlusX = 30
IF Reps > 9 THEN PlusX = 27
IF Reps = 20 THEN PlusX = 28
FOR x = 0 TO 16
FOR y = 0 TO 18
IF y > 6 THEN Colr = 5 ELSE Colr = 1
IF POINT(x, y) <> 0 THEN PSET (x + PlusX, y + 6), Colr
NEXT y
NEXT x
LINE (0, 0)-(14, 20), 0, BF
IF Reps = 20 THEN LINE (20, 0)-(50, 30), 1, BF
GET (20, 0)-(49, 29), TileBOX(Index2)
Index2 = Index2 + 250
NEXT Reps
LINE (0, 0)-(50, 30), 0, BF
'Borders and Title
COLOR 7
LOCATE 1, 1
PRINT "SCRAMBLE"
FOR x = 0 TO 64
FOR y = 0 TO 16
IF y > 6 THEN Colr = 7 ELSE Colr = 2
IF POINT(x, y) <> 0 THEN
LINE (x * 2 + 258, y * 2 + 20)-(x * 2 + 259, y * 2 + 21), Colr, B
END IF
NEXT y
NEXT x
LOCATE 1, 1
PRINT SPACE$(8)
COLOR 8
LOCATE 4, 24
PRINT "Based on a popular keychain puzzle"
LINE (5, 5)-(634, 474), 8, B
LINE (10, 10)-(629, 469), 8, B
'Draw playing frame
LINE (253, 121)-(390, 289), 1, BF
LINE (256, 124)-(387, 285), 9, BF
LINE (256, 124)-(387, 285), 14, B
LINE (260, 128)-(383, 281), 6, BF
LINE (261, 129)-(382, 280), 1, BF
LINE (247, 115)-(396, 295), 13, B
LINE (242, 110)-(401, 300), 7, B
LINE (237, 105)-(406, 305), 8, B
COLOR 7
LOCATE 8, 60: PRINT "MENU"
LOCATE 18, 56: PRINT "ELAPSED TIME:"
COLOR 8
LOCATE 9, 60: PRINT "New Game"
LOCATE 10, 60: PRINT "EXIT"
LINE (545, 130)-(565, 139), 7, BF
LINE (545, 146)-(565, 155), 7, BF
LINE (465, 126)-(570, 160), 8, B
DEFINT A-Z
SUB Menu (OnOFF)
SHARED LB, RB, MouseX, MouseY
SHARED Item
IF OnOFF THEN
LOCATE 9, 60: PRINT "New Game"
LOCATE 10, 60: PRINT "EXIT"
LINE (545, 130)-(565, 139), 7, BF
LINE (545, 146)-(565, 155), 7, BF
Item = 0
EXIT SUB
END IF
SELECT CASE MouseY
CASE 129 TO 142
LINE (545, 146)-(565, 155), 7, BF
COLOR 8: LOCATE 10, 60: PRINT "EXIT"
IF Item <> 1 THEN
LINE (545, 130)-(565, 139), 15, BF
COLOR 7: LOCATE 9, 60: PRINT "New Game"
TIMER OFF
Ticks = 0: GameSTARTED = 0: GameOVER = 0: TimesUP = 0
Item = 1
END IF
IF LB THEN
PLAY "MBT120O6L64a"
LINE (545, 130)-(565, 139), 7, BF
COLOR 8: LOCATE 9, 60: PRINT "New Game"
SetTILES 1
NewGAME = 1
IF GameSTARTED THEN GameSTARTED = 0
Item = 0
END IF
CASE 143 TO 156
LINE (545, 130)-(565, 139), 7, BF
COLOR 8: LOCATE 9, 60: PRINT "New Game"
IF Item <> 2 THEN
LINE (545, 146)-(565, 155), 15, BF
COLOR 7: LOCATE 10, 60: PRINT "EXIT"
Item = 2
END IF
IF LB THEN
PLAY "MBT120O6L64a"
LINE (545, 146)-(565, 155), 7, BF
COLOR 8: LOCATE 10, 60: PRINT "EXIT"
SYSTEM
END IF
CASE ELSE
IF Item THEN
COLOR 8
LOCATE 9, 60: PRINT "New Game"
LOCATE 10, 60: PRINT "EXIT"
LINE (545, 130)-(565, 139), 7, BF
LINE (545, 146)-(565, 155), 7, BF
Item = 0
END IF
END SELECT
SUB PlayGAME
SHARED LB, RB, MouseX, MouseY, TIMERon
SELECT CASE MouseX
CASE 262 TO 291
SELECT CASE MouseY
CASE 130 TO 159
Col = 2: Row = 2
GOSUB MoveIT
CASE 160 TO 189
Col = 2: Row = 3
GOSUB MoveIT
CASE 190 TO 219
Col = 2: Row = 4
GOSUB MoveIT
CASE 220 TO 249
Col = 2: Row = 5
GOSUB MoveIT
CASE 250 TO 279
Col = 2: Row = 6
GOSUB MoveIT
END SELECT
CASE 292 TO 321
SELECT CASE MouseY
CASE 130 TO 159
Col = 3: Row = 2
GOSUB MoveIT
CASE 160 TO 189
Col = 3: Row = 3
GOSUB MoveIT
CASE 190 TO 219
Col = 3: Row = 4
GOSUB MoveIT
CASE 220 TO 249
Col = 3: Row = 5
GOSUB MoveIT
CASE 250 TO 279
Col = 3: Row = 6
GOSUB MoveIT
END SELECT
CASE 322 TO 351
SELECT CASE MouseY
CASE 130 TO 159
Col = 4: Row = 2
GOSUB MoveIT
CASE 160 TO 189
Col = 4: Row = 3
GOSUB MoveIT
CASE 190 TO 219
Col = 4: Row = 4
GOSUB MoveIT
CASE 220 TO 249
Col = 4: Row = 5
GOSUB MoveIT
CASE 250 TO 279
Col = 4: Row = 6
GOSUB MoveIT
END SELECT
CASE 352 TO 381
SELECT CASE MouseY
CASE 130 TO 159
Col = 5: Row = 2
GOSUB MoveIT
CASE 160 TO 189
Col = 5: Row = 3
GOSUB MoveIT
CASE 190 TO 219
Col = 5: Row = 4
GOSUB MoveIT
CASE 220 TO 249
Col = 5: Row = 5
GOSUB MoveIT
CASE 250 TO 279
Col = 5: Row = 6
GOSUB MoveIT
END SELECT
END SELECT
EXIT SUB
MoveIT:
IF LB THEN
IF GameSTARTED = 0 AND NewGAME THEN
GameSTARTED = 1
NewGAME = 0
TIMER ON
TIMERon = 1
END IF
IF Puzzle(Col, Row - 1) = 20 THEN
PUT (TileX, TileY), TileBOX(4751), PSET
PUT (TileX, TileY - 30), TileBOX((Puzzle(Col, Row) - 1) * 250 + 1), PSET
Puzzle(Col, Row - 1) = Puzzle(Col, Row)
Puzzle(Col, Row) = 20
SOUND 12000, 1
END IF
IF Puzzle(Col, Row + 1) = 20 THEN
PUT (TileX, TileY), TileBOX(4751), PSET
PUT (TileX, TileY + 30), TileBOX((Puzzle(Col, Row) - 1) * 250 + 1), PSET
Puzzle(Col, Row + 1) = Puzzle(Col, Row)
Puzzle(Col, Row) = 20
SOUND 12000, 1
END IF
IF Puzzle(Col - 1, Row) = 20 THEN
PUT (TileX, TileY), TileBOX(4751), PSET
PUT (TileX - 30, TileY), TileBOX((Puzzle(Col, Row) - 1) * 250 + 1), PSET
Puzzle(Col - 1, Row) = Puzzle(Col, Row)
Puzzle(Col, Row) = 20
SOUND 12000, 1
END IF
IF Puzzle(Col + 1, Row) = 20 THEN
PUT (TileX, TileY), TileBOX(4751), PSET
PUT (TileX + 30, TileY), TileBOX((Puzzle(Col, Row) - 1) * 250 + 1), PSET
Puzzle(Col + 1, Row) = Puzzle(Col, Row)
Puzzle(Col, Row) = 20
SOUND 12000, 1
END IF
TileNUM = 0
FOR CheckROW = 2 TO 6
FOR CheckCOL = 2 TO 5
TileNUM = TileNUM + 1
IF Puzzle(CheckCOL, CheckROW) <> TileNUM THEN RETURN
NEXT CheckCOL
NEXT CheckROW
GameOVER = 1
'Initialize tile checking array
FOR R = 1 TO 5
FOR C = 1 TO 4
RowCOL(C, R) = 1
NEXT C
NEXT R
DO
DO
Row = INT(RND * 5) + 1
Col = INT(RND * 4) + 1
LOOP WHILE RowCOL(Col, Row) = 0
RowCOL(Col, Row) = 0
PUT ((Col - 1) * 30 + 262, (Row - 1) * 30 + 130), TileBOX(4751), PSET
PLAY "MFT200L64O6B"
'Check for all tiles erased
FOR R = 1 TO 5
FOR C = 1 TO 4
IF RowCOL(C, R) = 0 THEN Count = Count + 1
NEXT C
NEXT R
IF Count = 20 THEN EXIT DO ELSE Count = 0
SOUND 24000, 1
LOOP
END IF
'Scramble tiles using physical model
'Test for blank square
FOR Col = 2 TO 5
FOR Row = 2 TO 6
IF Puzzle(Col, Row) = 20 THEN
BlankCOL = Col
BlankROW = Row
END IF
NEXT Row
NEXT Col
FOR Reps = 1 TO 1000
DO
IncCOL = 0: IncROW = 0
RandINC = INT(RND * 4) + 1
SELECT CASE RandINC
CASE 1: IncCOL = 1
CASE 2: IncCOL = -1
CASE 3: IncROW = 1
CASE 4: IncROW = -1
END SELECT
LOOP UNTIL Puzzle(BlankCOL + IncCOL, BlankROW + IncROW) <> 0
Row = 1: Col = 1
FOR y = 130 TO 250 STEP 30
Row = Row + 1
FOR x = 262 TO 352 STEP 30
Col = Col + 1
IF Puzzle(Col, Row) <> 20 THEN
PUT (x, y), TileBOX((Puzzle(Col, Row) - 1) * 250 + 1), PSET
Interval .05
SOUND 24000, 1
END IF
NEXT x
Col = 1
NEXT y
![[Image: Screenshot-633.png]](https://i.ibb.co/SQV5YrM/Screenshot-633.png)
![[Image: Screenshot-631.png]](https://i.ibb.co/tmfp2DM/Screenshot-631.png)
![[Image: Screenshot-630.png]](https://i.ibb.co/JHHyRRX/Screenshot-630.png)
![[Image: Screenshot-628.png]](https://i.ibb.co/ZBstRMq/Screenshot-628.png)
![[Image: Screenshot-626.png]](https://i.ibb.co/fF5gCPZ/Screenshot-626.png)
![[Image: Circular-Clock-by-Sierra-Ken.jpg]](https://i.ibb.co/gPQVP3X/Circular-Clock-by-Sierra-Ken.jpg)
![[Image: Screenshot-589.png]](https://i.ibb.co/DVcxr3Q/Screenshot-589.png)
