_Title "One Key Creep Out for Halloween" 'B+ from Creep Out started 2021-08-18 Breakout with Spiders ' 2021-08-20A more sounds for breaking bricks font to replace text sub
' 2021-10-25 fix up Menu now that I know more about Fonts, one key = Spacebar
' Spacebar toggles menu choices and moving\stopping the paddle.
' ============================= Paddle Play with Spacebar Only! =================================
' Paddle on each Spacebar press: Moves Stops Reverses Stops Reverses Stops Reverses Stops...
' Hint: over shoot paddle placement so if too much you will start right up again going back!
' ================================================================================================
Const xmax
= 700 '<==== drawing area width Const ymax
= 560 '<==== drawing area height
'colors used
Const orange
= &HFFFF8400 Const yellow
= &HFFFFFF00 Const silver
= &HFFD0C6C6
' wall is 50 pixels X 14 columns wide = 700 make screen width
' wall is 20 pixels X 8 rows = 160 = 1/3 screen height = 480 + 20 paddle height
' under paddle track score and lifes on one line padded by blank lines 540 = 27
' so total height 480 to paddle 500 + 60 for 3 lines = 560 (text height 20)
Const br
= 10 ' ball radius Const bkw
= 50 ' brick width Const bkh
= 20 ' brick height
Const air_resistance
= .1
' Sound sources mainly Sound Bible picks from both johnno56 and myself here: https://soundbible.com
' from Cobalt's advanced version of my eRATication, rar here: https://www.qb64.org/forum/index.php?topic=370.msg2677#msg2677
' from Filleppes Cloned Shades here: https://www.qb64.org/forum/index.php?topic=1262.msg104706#msg104706
mush
= _SndOpen("mush.wav") ' brick 0 breaking johnno soundbiblealive
= _SndOpen("life.wav") ' brick 1 breaking Colbalt eRATicationlaser
= _SndOpen("laser.wav") ' brick 2 breaking mark soundbiblewhistle
= _SndOpen("whistle.ogg") ' brick 3 fellippe Clone-Shades mastercrunch
= _SndOpen("crunch.wav") ' ball over spider johnno soundbiblepop
= _SndOpen("pop.wav") ' bouce off wall or paddle mark soundbibleuh
= _SndOpen("playerdie.mp3") ' paddle miss Colbalt eRATicationgong
= _SndOpen("gong.wav") ' complete a screen mark soundbible'Print mush, alive, laser, whistle 'ok
'Print crunch, pop, uh, gong 'ok
'End
'_FullScreen
' OR >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> You can choose Full Screen or Centered on screen 700 x 560
f&
= _LoadFont("spiders.ttf", 64) ' License included in zip package
Dim Shared bx
, by
, dx
, dy
, px
, py
, pw
, plf
, prt
, pf
, score
, life
, hits
, obk
, rbk
, speedups
bx = 0 ' ball x position
by = 0 ' ball y position
dx = 0 ' ball horizontal change
dy = 0 ' ball vertical change
restart:
px = 350 ' paddle x, y
py = 450 ' fix paddle sticking at 480
pw = 70 ' paddle width, 100 wide to start half that at certain point
plf = 0 ' paddle left side
prt = 0 ' paddle right side
pf = 1 ' paddle fraction that gets changed according menu choice easy .75, hard .5
nS = 0 ' number of spinners
score = 0
life = 5 ' (or balls left) only 3 allowed according to wiki
hits = 0 ' bricks busted
obk = 0 ' first orange brick hits bool
rbk = 0 ' first red brick hit bool, when this happens paddle width is cut in half!
speedups = 0 ' count, bump up dy when hits = 4 and 8, then with first orange, then with first red
scrn = 0
Dim Shared wc
(13, 7), wp
(13, 7) 'brick wall colors, brick wall points according to color ' get 448 points clear 1 screen/wall, perfect game is clearing 2 screens/walls
'Menu
initwall
life = 0
drawtable
Line (.23 * xmax
, .14 * ymax
)-(.77 * xmax
, .81 * ymax
), &HFF0000FF, BF
Line (.24 * xmax
, .15 * ymax
)-(.76 * xmax
, .8 * ymax
), &HFF880000, BF
Line (.245 * xmax
, .16 * ymax
)-(.755 * xmax
, .79 * ymax
), &HFFFFFFFF, B
'While _MouseInput: Wend
'mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
drawSpinner xmax * .35, .2 * ymax + 75 + my * 70, .5, 0, &HFF006600
my = my + 1
life = 5: pf = .75
life = 3: pf = .5
drawtable
initball 'set dx, dy, bx, by ball position and change
updatescore
dMode = 1
drawtable
drawpaddle
drawball
handleSpinners
updatescore
scrn = 1
speedups = 0: obk = 0: rbk = 0: pw = 50
nS = 0
initwall
drawtable
initball
'Text 65, 170, 32, white, "Congratulations on a perfect score!!!"
_Limit 20 '< adjust as needed for speed of your system 'Text 260, 290, 48, white, "Game Over"
centerText 0, xmax, ymax / 2, "Game Over"
Case 0, 1: cr
= red: p
= 7 Case 2, 3: cr
= orange: p
= 5 Case 4, 5: cr
= green: p
= 3 Case 6, 7: cr
= yellow: p
= 1 wc(c, r) = cr: wp(c, r) = p
Sub initball
'set ball in play with location and dx, dy bx = 350
by = 280
dx = rand(1, 4)
If rand
(0, 1) Then dx
= -1 * dx
dy = (3 + speedups) * -1
px = bx
Sub drawtable
' in JB don't want to redraw this every loop 'underneath
Line (c
* bkw
+ i
, r
* bkh
+ bkh
+ i
)-(c
* bkw
+ bkw
+ i
, r
* bkh
+ bkh
+ i
) PSet (c
* bkw
+ i
, r
* bkh
+ bkh
+ i
) 'ink(white)
'sidewall
Line (c
* bkw
+ bkw
+ i
, r
* bkh
+ i
)-(c
* bkw
+ bkw
+ i
, r
* bkh
+ bkh
+ i
) Line (c
* bkw
, r
* bkh
)-(c
* bkw
+ bkw
, r
* bkh
+ bkh
), , BF
Line (c
* bkw
, r
* bkh
)-(c
* bkw
+ bkw
, r
* bkh
+ bkh
), , B
'Line (0, 300)-(xmax, 490), &HFF000019, BF ' mouse paddle limit
Sub drawpaddle
' update paddle to mouseY, paddle top and bottom are global
'While _MouseInput: Wend
'px = _MouseX 'update paddle location
'If _MouseY >= 300 And _MouseY < 480 Then py = _MouseY
py = 440
'If InKey$ = " " Then ' reverse every time you hit spacebar
' dMode = 1 - dMode
' _KeyClear
'End If
'If dMode Then px = px + 10 Else px = px - 10
'If px < -pw Then px = -pw
'If px > xmax + pw Then px = xmax + pw
' stop reverse stop reverse stop reverse
If InKey$ = " " Then ' reverse every time you hit spacebar 1 0 -1 0 1 0 -1... dMode = dMode + 1
If dMode
= 1 Then px
= px
- 10 If dMode
= 3 Then px
= px
+ 10 If px
> xmax
+ pw
Then px
= xmax
+ pw
- 1
plf = px - pw
prt = px + pw
Line (px
- pw
+ i
, py
+ 10 + i
)-(px
+ pw
+ i
, py
+ 10 + i
), _RGB32(120, 60, 60) 'PSet (c * bkw + i, r * bkh + bkh + i)
'ink(white)
Line (px
+ pw
+ i
, py
+ i
)-(px
+ pw
+ i
, py
+ 10 + i
), silver
Line (px
- pw
, py
)-(px
+ pw
, py
+ 10), &HFFAA5533, BF
'update
bx = bx + dx
by = by + dy
If by
+ br
> py
Then 'ball past paddle line by = py - br 'don't let ball go into paddle or goal
If bx
+ br
< plf
Or bx
- br
> prt
Then 'paddle miss life = life - 1
' if life = 0 then end game
updatescore
silverball bx, by
_Delay 2.5 'reflect on position of ball and loss of life CircleFill bx, by, br, black
initball 'get ball rolling again
Else 'paddle hit ' redo according to distance from paddle center dy = dy * -1
per = .5 * (px - bx) / pw
dx = dx - 6 * per
per = .5 * (bx - px) / pw
dx = dx + 6 * per
'Else dx remains same
'dx = dx + rand(-2, 2)
If by
- br
< 0 Then 'ball hits back border, reverse direction by = br: dy = dy * -1
If by
- br
< 160 Then 'in wall area, what row and column? starthits = hits
'maybe should check all 4 corners or smaller ball
row
= Int((by
- br
) / bkh
): col
= Int((bx
- br
) / bkw
) handleBall row, col
row
= Int((by
- br
) / bkh
): col
= Int((bx
+ br
) / bkw
) handleBall row, col
row
= Int((by
+ br
) / bkh
): col
= Int((bx
- br
) / bkw
) handleBall row, col
row
= Int((by
+ br
) / bkh
): col
= Int((bx
+ br
) / bkw
) handleBall row, col
If hits
<> starthits
Then: dy
= dy
* -1:
'reverse ball direction silverball bx, by
Sub handleBall
(row
, col
) If wp
(col
, row
) Then 'brick just hit, lot's to do before update ball hits = hits + 1
sp = rand(0, 3)
nS = nS + 1
newSpinner nS, col, row
speedups = speedups + 1
value = wp(col, row)
If value
= 5 Then 'first orange brick If obk
= 0 Then 'flag first orange speed increase obk = 1
speedups = speedups + 1
If value
= 7 Then 'flag first red, speed increase paddle decrease! ! ! ! rbk = 1
speedups = speedups + 1
pw = pf * pw
score = score + wp(col, row) 'update score with point value
wp(col, row) = 0 'no points here now
'black out box need this?
'Line (col * bkw, row * bkh)-(col * bkw + bkw, row * bkh + bkh), black, BF
centerText
0, xmax
/ 2, 532, "Lives" + Str$(life
) centerText xmax
/ 2, xmax
, 532, "Score" + Str$(score
)
cc = 255 - i * 20
CircleFill x
, y
, i
, _RGB32(cc
, cc
, cc
)
rand%
= Int(Rnd * (hi%
- lo%
+ 1)) + lo%
' CX = center x coordinate
' CY = center y coordinate
' R = radius
' C = fill color
RadiusError = -Radius
X = Radius
Y = 0
Line (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RadiusError = RadiusError + Y * 2 + 1
Line (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
Line (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
Line (CX
- X
, CY
- Y
)-(CX
+ X
, CY
- Y
), C
, BF
Line (CX
- X
, CY
+ Y
)-(CX
+ X
, CY
+ Y
), C
, BF
Sub newSpinner
(i
As Integer, col
, row
) 'set Spinners dimensions start angles, color? s(i).x = col * bkw + .5 * bkw
s(i).y = row * bkh + .5 * bkh
s
(i
).dx
= (s
(i
).sz
* Rnd * 6) * r
* 2 s
(i
).dy
= (s
(i
).sz
* Rnd * 6) * r
* 2
Dim x1
, x2
, x3
, x4
, y1
, y2
, y3
, y4
, r
, a
, a1
, a2
, lg
, d
, rd
switch = switch + 2
switch
= switch
Mod 16 + 1 r = 10 * scale
x1
= x
+ r
* Cos(heading
): y1
= y
+ r
* Sin(heading
) r = 2 * r 'lg lengths
a
= heading
+ .9 * lg
* _Pi(1 / 5) + (lg
= switch
) * _Pi(1 / 10) a
= heading
- .9 * (lg
- 4) * _Pi(1 / 5) - (lg
= switch
) * _Pi(1 / 10) x2
= x1
+ r
* Cos(a
): y2
= y1
+ r
* Sin(a
) drawLink x1
, y1
, 3 * scale
, x2
, y2
, 2 * scale
, _RGB32(cRed
+ 20, cGreen
+ 10, Blue
+ 5) x3
= x2
+ r
* 1.5 * Cos(a1
): y3
= y2
+ r
* 1.5 * Sin(a1
) drawLink x2
, y2
, 2 * scale
, x3
, y3
, scale
, _RGB32(cRed
+ 35, cGreen
+ 17, Blue
+ 8) a2
= a1
+ d
* _Pi(1 / 8) * rd
/ 8 x4
= x3
+ r
* 1.5 * Cos(a2
): y4
= y3
+ r
* 1.5 * Sin(a2
) drawLink x3
, y3
, scale
, x4
, y4
, scale
, _RGB32(cRed
+ 50, cGreen
+ 25, Blue
+ 12) r = r * .5
fcirc x1
, y1
, r
, _RGB32(cRed
- 20, cGreen
- 10, Blue
- 5) x2
= x1
+ (r
+ 1) * Cos(heading
- _Pi(1 / 12)): y2
= y1
+ (r
+ 1) * Sin(heading
- _Pi(1 / 12)) fcirc x2, y2, r * .2, &HFFFFAA00
x2
= x1
+ (r
+ 1) * Cos(heading
+ _Pi(1 / 12)): y2
= y1
+ (r
+ 1) * Sin(heading
+ _Pi(1 / 12)) fcirc x2, y2, r * .2, &HFFFFAA00
r = r * 2
x1
= x
+ r
* .9 * Cos(heading
+ _Pi): y1
= y
+ r
* .9 * Sin(heading
+ _Pi) TiltedEllipseFill
0, x1
, y1
, r
, .7 * r
, heading
+ _Pi, _RGB32(cRed
, cGreen
, Blue
)
Dim a
, a1
, a2
, x3
, x4
, x5
, x6
, y3
, y4
, y5
, y6
x3
= x1
+ r1
* Cos(a1
): y3
= y1
+ r1
* Sin(a1
) x4
= x1
+ r1
* Cos(a2
): y4
= y1
+ r1
* Sin(a2
) x5
= x2
+ r2
* Cos(a1
): y5
= y2
+ r2
* Sin(a1
) x6
= x2
+ r2
* Cos(a2
): y6
= y2
+ r2
* Sin(a2
) fquad x3, y3, x4, y4, x5, y5, x6, y6, c
fcirc x1, y1, r1, c
fcirc x2, y2, r2, c
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
ftri x1, y1, x2, y2, x4, y4, c
ftri x3, y3, x4, y4, x1, y1, c
Radius
= Abs(R
): RadiusError
= -Radius: X
= Radius: Y
= 0 Line (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RadiusError = RadiusError + Y * 2 + 1
Line (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
Line (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
Line (CX
- X
, CY
- Y
)-(CX
+ X
, CY
- Y
), C
, BF
Line (CX
- X
, CY
+ Y
)-(CX
+ X
, CY
+ Y
), C
, BF
prc
= _RGB32(255, 255, 255, 255) mx2 = max + max
_Source tef
'point wont read without this! Line (lasti
, lastj
)-(i
, j
), prc
lasti = i: lastj = j
x = 0
x = x + 1
xleft(y) = x
x = x + 1
x = x + 1
If x
= mx2
Then xright
(y
) = xleft
(y
) Else xright
(y
) = x
If xleft
(y
) <> mx2
Then Line (xleft
(y
) + x0
- max
, y
+ y0
- max
)-(xright
(y
) + x0
- max
, y
+ y0
- max
), c
, BF
If s
(i
).dead
< 10 * s
(i
).sz
Then explode s(i).x, s(i).y, 20 * s(i).sz, s(i).dead
s(i).dead = s(i).dead + 1
s(i).x = s(i).x + s(i).dx
If s
(i
).x
< 0 Or s
(i
).x
> xmax
Then s
(i
).dx
= -s
(i
).dx
s(i).y = s(i).y + s(i).dy
If s
(i
).y
< 0 Or s
(i
).y
> xmax
Then s
(i
).dy
= -s
(i
).dy
If Sqr((bx
- s
(i
).x
) ^ 2 + (by
- s
(i
).y
) ^ 2) < 1.5 * br
Then s(i).dead = 1
explode s(i).x, s(i).y, 20 * s(i).sz, s(i).dead
drawSpinner s
(i
).x
, s
(i
).y
, s
(i
).sz
, _Atan2(s
(i
).dy
, s
(i
).dx
), s
(i
).c
Sub explode
(x
, y
, r
, frm
) maxParticles = r * 40
NewDot i, x, y, r
rounds = r
dots(i).x = dots(i).x + dots(i).dx
dots(i).y = dots(i).y + dots(i).dy
dots(i).dx = dots(i).dx * air_resistance
dots(i).dy = air_resistance * dots(i).dy
fcirc dots(i).x, dots(i).y, dots(i).sz / 2, dots(i).c
NewDot (rounds + i), x, y, r
rounds = rounds + r
dots
(i
).x
= x
+ rd
* Cos(angle
) dots
(i
).y
= y
+ rd
* Sin(angle
) dots
(i
).sz
= Rnd * r
* .5 rd
= Rnd 'STxAxTIC recommended for rounder spreads dots
(i
).dx
= rd
* 7 * (7 - dots
(i
).sz
) * Cos(angle
) dots
(i
).dy
= rd
* 7 * (7 - dots
(i
).sz
) * Sin(angle
) dots
(i
).c
= _RGB32(140 + rd
* 80, 70 + rd
* 40, 0)
Sub centerText
(x1
, x2
, midy
, s$
) ' ' if you want to center fit a string between two goal posts x1, and x2
