|
Post by bplus on Aug 18, 2021 17:59:47 GMT -5
_Title "Creep Out" 'B+ 2021-08-18 start Breakout with Spiders Randomize Timer
Const xmax = 700 '<==== drawing area width Const ymax = 560 '<==== drawing area height Const nSpinners = 112
Type SpinnerType x As Single y As Single dx As Single dy As Single sz As Single c As _Unsigned Long End Type
Dim Shared nS As Integer
Screen _NewImage(xmax, ymax, 32)
' Recommend: If you go FULLSCREEN then MOUSEHIDE _FullScreen _MouseHide ' You might want to keep mouse visible to see when it goes off screen in height
' 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
'colors used Const red = &HFFFF0000 Const orange = &HFFFF6400 Const green = &HFF008000 Const yellow = &HFFFFFF00 Const silver = &HFFD0C6C6 Const white = &HFFFFFFFF Const black = &HFF000000
Dim Shared bx, by, dx, dy, px, py, pw, plf, prt, 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 py = 480 pw = 50 ' paddle width, 100 wide to start half that at certain point plf = 0 ' paddle left side prt = 0 ' paddle right side nS = 0 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 ReDim Shared s(1 To nSpinners) As SpinnerType
initwall 'load arrays with data initball 'set dx, dy, bx, by ball position and change drawtable updatescore While life And _KeyDown(27) = 0 drawtable drawpaddle drawball handleSpinners updatescore If hits = 112 And scrn = 0 Then 'setup new _Delay 1 scrn = 1 speedups = 0: obk = 0: rbk = 0: pw = 50 nS = 0 ReDim s(1 To nSpinners) As SpinnerType initwall drawtable initball Else If hits = 224 Then Color white Text 65, 200, 32, white, "Congratulations on a perfect score!!!" _Delay 3 Exit While End If End If _Display _Limit 40 '< adjust as needed for speed of your system Wend If _KeyDown(27) Then System Color white Text 260, 290, 48, white, "Game Over" _Display Sleep 5 GoTo restart
Sub initwall Dim cr As _Unsigned Long For r = 0 To 7 Select Case r 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 End Select For c = 0 To 13 wc(c, r) = cr: wp(c, r) = p Next Next End Sub
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 End Sub
Sub drawtable ' in JB don't want to redraw this every loop Cls For r = 0 To 7 For c = 0 To 13 If wp(c, r) Then For i = 1 To 10 'underneath Color _RGB32(120, 60, 60) Line (c * bkw + i, r * bkh + bkh + i)-(c * bkw + bkw + i, r * bkh + bkh + i) Color silver 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) Next Color wc(c, r) Line (c * bkw, r * bkh)-(c * bkw + bkw, r * bkh + bkh), , BF Color white Line (c * bkw, r * bkh)-(c * bkw + bkw, r * bkh + bkh), , B End If Next Next End Sub
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 plf = px - pw prt = px + pw For i = 1 To 10 Color _RGB32(120, 60, 60) Line (px - pw + i, py + 10 + i)-(px + pw + i, py + 10 + i), _RGB32(120, 60, 60) Color silver 'PSet (c * bkw + i, r * bkh + bkh + i) 'ink(white) Line (px + pw + i, py + i)-(px + pw + i, py + 10 + i), silver Next Line (px - pw, py)-(px + pw, py + 10), &HFFAA5533, BF End Sub
Sub drawball 'erase last ball, blend into table color CircleFill bx, by, br, black
'update bx = bx + dx If bx < br Then dx = dx * -1: bx = br + 1 If bx > xmax - br Then dx = dx * -1: bx = xmax - br - 1
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 If bx < px Then per = .5 * (px - bx) / pw dx = dx - 6 * per ElseIf bx > px Then per = .5 * (bx - px) / pw dx = dx + 6 * per 'Else dx remains same End If 'dx = dx + rand(-2, 2) If dx > 7 Then: dx = 7: If dx < -7 Then dx = -7 End If Else If by - br < 0 Then 'ball hits back border, reverse direction by = br: dy = dy * -1 Else 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 End If End If End If silverball bx, by End Sub
Sub handleBall (row, col) If 0 <= row And row <= 7 And 0 <= col And col <= 13 Then If wp(col, row) Then 'brick just hit, lot's to do before update ball hits = hits + 1 nS = nS + 1 newSpinner nS, col, row If hits = 4 Or hits = 8 Or hits = 116 Or hits = 120 Then speedups = speedups + 1 If dy < 0 Then dy = dy - .25 Else dy = dy + .25 End If 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 dy < 0 Then: dy = dy - .25 Else dy = dy + .25 End If End If If value = 7 Then 'flag first red, speed increase paddle decrease! If rbk = 0 Then rbk = 1 speedups = speedups + 1 If dy < 0 Then dy = dy - .25 Else: dy = dy + .25 pw = .75 * pw End If End If score = score + wp(col, row) 'update score with point value wp(col, row) = 0 'no points here now 'black out box Line (col * bkw, row * bkh)-(col * bkw + bkw, row * bkh + bkh), black, BF End If End If End Sub
Sub updatescore Line (0, 500)-(xmax, ymax), black, BF dxs$ = Right$(" " + Str$(Int(dx)), 3) dys$ = Right$(" " + Str$(Int(dy)), 3) scores$ = Right$(" " + Str$(score), 3) ms$ = " Ball dx,dy:" + dxs$ + "," + dys$ + " Lifes:" + Str$(life) + " Score:" + scores$ Text 0, 520, 32, silver, Space$(60) Text 0, 520, 32, silver, ms$ End Sub
Sub silverball (x, y) For i = 10 To 1 Step -1 cc = 255 - i * 20 CircleFill x, y, i, _RGB32(cc, cc, cc) Next End Sub
Function rand% (lo%, hi%) rand% = Int(Rnd * (hi% - lo% + 1)) + lo% End Function
Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long) ' CX = center x coordinate ' CY = center y coordinate ' R = radius ' C = fill color Dim Radius As Integer, RadiusError As Integer Dim X As Integer, Y As Integer Radius = Abs(R) RadiusError = -Radius X = Radius Y = 0 If Radius = 0 Then PSet (CX, CY), C: Exit Sub Line (CX - X, CY)-(CX + X, CY), C, BF While X > Y RadiusError = RadiusError + Y * 2 + 1 If RadiusError >= 0 Then If X <> Y + 1 Then Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF End If X = X - 1 RadiusError = RadiusError - X * 2 End If 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 Wend End Sub
Sub Text (x, y, textHeight, K As _Unsigned Long, txt$) fg = _DefaultColor cur& = _Dest I& = _NewImage(8 * Len(txt$), 16, 32) _Dest I& Color K, _RGBA32(0, 0, 0, 0) _PrintString (0, 0), txt$ mult = textHeight / 16 xlen = Len(txt$) * 8 * mult _PutImage (x, y)-Step(xlen, textHeight), I&, cur& Color fg _FreeImage I& End Sub
Sub newSpinner (i As Integer, col, row) 'set Spinners dimensions start angles, color? Dim r s(i).x = col * bkw + .5 * bkw s(i).y = row * bkh + .5 * bkh s(i).sz = Rnd * .65 + .1 If Rnd < .5 Then r = -1 Else r = 1 s(i).dx = (s(i).sz * Rnd * 6) * r * 2 s(i).dy = (s(i).sz * Rnd * 6) * r * 2 r = Rnd * 255 s(i).c = _RGB32(r, Rnd * .5 * r, Rnd * .25 * r) End Sub
Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long) Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd Dim cRed, Blue, cGreen Static switch As Integer switch = switch + 2 switch = switch Mod 16 + 1 cRed = _Red32(c): cGreen = _Green32(c): Blue = _Blue32(c) r = 10 * scale x1 = x + r * Cos(heading): y1 = y + r * Sin(heading) r = 2 * r 'lg lengths For lg = 1 To 8 If lg < 5 Then a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10) Else a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10) End If 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) If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1 a1 = a + d * _Pi(1 / 12) 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) rd = Int(Rnd * 8) + 1 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) Next 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, &HFF000000 x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12)) fcirc x2, y2, r * .2, &HFF000000 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) End Sub
Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long) Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6 a = _Atan2(y2 - y1, x2 - x1) a1 = a + _Pi(1 / 2) a2 = a - _Pi(1 / 2) 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 End Sub
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4 Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long) ftri x1, y1, x2, y2, x4, y4, c ftri x3, y3, x4, y4, x1, y1, c End Sub
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long) Dim a& a& = _NewImage(1, 1, 32) _Dest a& PSet (0, 0), K _Dest 0 _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3) _FreeImage a& '<<< this is important! End Sub
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long) Dim Radius As Integer, RadiusError As Integer Dim X As Integer, Y As Integer Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0 If Radius = 0 Then PSet (CX, CY), C: Exit Sub Line (CX - X, CY)-(CX + X, CY), C, BF While X > Y RadiusError = RadiusError + Y * 2 + 1 If RadiusError >= 0 Then If X <> Y + 1 Then Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF End If X = X - 1 RadiusError = RadiusError - X * 2 End If 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 Wend End Sub
Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long) Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single Dim prc As _Unsigned Long, tef As Long prc = _RGB32(255, 255, 255, 255) If a > b Then max = a + 1 Else max = b + 1 mx2 = max + max tef = _NewImage(mx2, mx2) _Dest tef _Source tef 'point wont read without this! For k = 0 To 6.2832 + .05 Step .1 i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang) j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang) If k <> 0 Then Line (lasti, lastj)-(i, j), prc Else PSet (i, j), prc End If lasti = i: lastj = j Next Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer For y = 0 To mx2 x = 0 While Point(x, y) <> prc And x < mx2 x = x + 1 Wend xleft(y) = x While Point(x, y) = prc And x < mx2 x = x + 1 Wend While Point(x, y) <> prc And x < mx2 x = x + 1 Wend If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x Next _Dest destHandle& For y = 0 To mx2 If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF Next _FreeImage tef End Sub
Sub handleSpinners For i = 1 To nS 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 drawSpinner s(i).x, s(i).y, s(i).sz, _Atan2(s(i).dy, s(i).dx), s(i).c Next End Sub
EDIT: so 2nd screen works EDIT2: so perfect game congrats seen (just had one too!)
|
|
|
Post by bplus on Aug 18, 2021 18:04:31 GMT -5
Distraction?! What distraction?
|
|
johnno56
Junior Member
Logic is the beginning of wisdom.
Posts: 85
|
Post by johnno56 on Aug 18, 2021 18:42:12 GMT -5
Oh, now THAT is cool... Difficult to believe that the critters are drawn and not pre-loaded animated sprites. If distraction was your goal then mission accomplished... Very nicely done indeed. How difficult would it be to "squish" the critters with the ball? You know, splat add points, splat fades...
As far as conversions go for RC and SDL... May not be possible... Both do not have 'maptriangle' and probably be too difficult to emulate... But no big deal... QB64 will do just fine.
Had you considered any sound effects / music track? Too soon?
I threw together a simple menu for my game. Instructions; Play and Quit. Will you be adding something similar? Menu is helpful, but for breakout type games, no really needed... lol
Great job!
J
|
|
|
Post by bplus on Aug 18, 2021 19:08:03 GMT -5
Splats! oh I like... thanks johnno56. A couple more fixes in first post.
|
|
|
Post by bplus on Aug 18, 2021 21:26:45 GMT -5
Bloody _hell!!
_Title "Creep Out Splat" 'B+ 2021-08-18 start Breakout with Spiders Randomize Timer
Const xmax = 700 '<==== drawing area width Const ymax = 560 '<==== drawing area height Const nSpinners = 112 Const air_resistance = .1
Type Object x As Single y As Single dx As Single dy As Single sz As Single c As _Unsigned Long dead As Long End Type
Dim Shared nS As Integer Dim Shared dots(2000) As Object
Screen _NewImage(xmax, ymax, 32)
' Recommend: If you go FULLSCREEN then MOUSEHIDE _FullScreen _MouseHide ' You might want to keep mouse visible to see when it goes off screen in height
' 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
'colors used Const red = &HFFFF0000 Const orange = &HFFFF6400 Const green = &HFF008000 Const yellow = &HFFFFFF00 Const silver = &HFFD0C6C6 Const white = &HFFFFFFFF Const black = &HFF000000
Dim Shared bx, by, dx, dy, px, py, pw, plf, prt, 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 py = 480 pw = 50 ' paddle width, 100 wide to start half that at certain point plf = 0 ' paddle left side prt = 0 ' paddle right side nS = 0 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 ReDim Shared s(1 To nSpinners) As Object
initwall 'load arrays with data initball 'set dx, dy, bx, by ball position and change drawtable updatescore While life And _KeyDown(27) = 0 drawtable drawpaddle drawball handleSpinners updatescore If hits = 112 And scrn = 0 Then 'setup new _Delay 1 scrn = 1 speedups = 0: obk = 0: rbk = 0: pw = 50 nS = 0 ReDim s(1 To nSpinners) As Object initwall drawtable initball Else If hits = 224 Then Color white Text 65, 200, 32, white, "Congratulations on a perfect score!!!" _Delay 3 Exit While End If End If _Display _Limit 40 '< adjust as needed for speed of your system Wend If _KeyDown(27) Then System Color white Text 260, 290, 48, white, "Game Over" _Display Sleep 5 GoTo restart
Sub initwall Dim cr As _Unsigned Long For r = 0 To 7 Select Case r 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 End Select For c = 0 To 13 wc(c, r) = cr: wp(c, r) = p Next Next End Sub
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 End Sub
Sub drawtable ' in JB don't want to redraw this every loop Cls For r = 0 To 7 For c = 0 To 13 If wp(c, r) Then For i = 1 To 10 'underneath Color _RGB32(120, 60, 60) Line (c * bkw + i, r * bkh + bkh + i)-(c * bkw + bkw + i, r * bkh + bkh + i) Color silver 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) Next Color wc(c, r) Line (c * bkw, r * bkh)-(c * bkw + bkw, r * bkh + bkh), , BF Color white Line (c * bkw, r * bkh)-(c * bkw + bkw, r * bkh + bkh), , B End If Next Next End Sub
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 plf = px - pw prt = px + pw For i = 1 To 10 Color _RGB32(120, 60, 60) Line (px - pw + i, py + 10 + i)-(px + pw + i, py + 10 + i), _RGB32(120, 60, 60) Color silver 'PSet (c * bkw + i, r * bkh + bkh + i) 'ink(white) Line (px + pw + i, py + i)-(px + pw + i, py + 10 + i), silver Next Line (px - pw, py)-(px + pw, py + 10), &HFFAA5533, BF End Sub
Sub drawball 'erase last ball, blend into table color CircleFill bx, by, br, black
'update bx = bx + dx If bx < br Then dx = dx * -1: bx = br + 1 If bx > xmax - br Then dx = dx * -1: bx = xmax - br - 1
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 If bx < px Then per = .5 * (px - bx) / pw dx = dx - 6 * per ElseIf bx > px Then per = .5 * (bx - px) / pw dx = dx + 6 * per 'Else dx remains same End If 'dx = dx + rand(-2, 2) If dx > 7 Then: dx = 7: If dx < -7 Then dx = -7 End If Else If by - br < 0 Then 'ball hits back border, reverse direction by = br: dy = dy * -1 Else 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 End If End If End If silverball bx, by End Sub
Sub handleBall (row, col) If 0 <= row And row <= 7 And 0 <= col And col <= 13 Then If wp(col, row) Then 'brick just hit, lot's to do before update ball hits = hits + 1 nS = nS + 1 newSpinner nS, col, row If hits = 4 Or hits = 8 Or hits = 116 Or hits = 120 Then speedups = speedups + 1 If dy < 0 Then dy = dy - .25 Else dy = dy + .25 End If 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 dy < 0 Then: dy = dy - .25 Else dy = dy + .25 End If End If If value = 7 Then 'flag first red, speed increase paddle decrease! If rbk = 0 Then rbk = 1 speedups = speedups + 1 If dy < 0 Then dy = dy - .25 Else: dy = dy + .25 pw = .75 * pw End If End If score = score + wp(col, row) 'update score with point value wp(col, row) = 0 'no points here now 'black out box Line (col * bkw, row * bkh)-(col * bkw + bkw, row * bkh + bkh), black, BF End If End If End Sub
Sub updatescore Line (0, 500)-(xmax, ymax), black, BF dxs$ = Right$(" " + Str$(Int(dx)), 3) dys$ = Right$(" " + Str$(Int(dy)), 3) scores$ = Right$(" " + Str$(score), 3) ms$ = " Ball dx,dy:" + dxs$ + "," + dys$ + " Lifes:" + Str$(life) + " Score:" + scores$ Text 0, 520, 32, silver, Space$(60) Text 0, 520, 32, silver, ms$ End Sub
Sub silverball (x, y) For i = 10 To 1 Step -1 cc = 255 - i * 20 CircleFill x, y, i, _RGB32(cc, cc, cc) Next End Sub
Function rand% (lo%, hi%) rand% = Int(Rnd * (hi% - lo% + 1)) + lo% End Function
Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long) ' CX = center x coordinate ' CY = center y coordinate ' R = radius ' C = fill color Dim Radius As Integer, RadiusError As Integer Dim X As Integer, Y As Integer Radius = Abs(R) RadiusError = -Radius X = Radius Y = 0 If Radius = 0 Then PSet (CX, CY), C: Exit Sub Line (CX - X, CY)-(CX + X, CY), C, BF While X > Y RadiusError = RadiusError + Y * 2 + 1 If RadiusError >= 0 Then If X <> Y + 1 Then Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF End If X = X - 1 RadiusError = RadiusError - X * 2 End If 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 Wend End Sub
Sub Text (x, y, textHeight, K As _Unsigned Long, txt$) fg = _DefaultColor cur& = _Dest I& = _NewImage(8 * Len(txt$), 16, 32) _Dest I& Color K, _RGBA32(0, 0, 0, 0) _PrintString (0, 0), txt$ mult = textHeight / 16 xlen = Len(txt$) * 8 * mult _PutImage (x, y)-Step(xlen, textHeight), I&, cur& Color fg _FreeImage I& End Sub
Sub newSpinner (i As Integer, col, row) 'set Spinners dimensions start angles, color? Dim r s(i).x = col * bkw + .5 * bkw s(i).y = row * bkh + .5 * bkh s(i).sz = Rnd * .65 + .1 If Rnd < .5 Then r = -1 Else r = 1 s(i).dx = (s(i).sz * Rnd * 6) * r * 2 s(i).dy = (s(i).sz * Rnd * 6) * r * 2 r = Rnd * 255 s(i).c = _RGB32(r, Rnd * .5 * r, Rnd * .25 * r) End Sub
Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long) Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd Dim cRed, Blue, cGreen Static switch As Integer switch = switch + 2 switch = switch Mod 16 + 1 cRed = _Red32(c): cGreen = _Green32(c): Blue = _Blue32(c) r = 10 * scale x1 = x + r * Cos(heading): y1 = y + r * Sin(heading) r = 2 * r 'lg lengths For lg = 1 To 8 If lg < 5 Then a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10) Else a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10) End If 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) If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1 a1 = a + d * _Pi(1 / 12) 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) rd = Int(Rnd * 8) + 1 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) Next 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, &HFF000000 x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12)) fcirc x2, y2, r * .2, &HFF000000 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) End Sub
Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long) Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6 a = _Atan2(y2 - y1, x2 - x1) a1 = a + _Pi(1 / 2) a2 = a - _Pi(1 / 2) 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 End Sub
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4 Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long) ftri x1, y1, x2, y2, x4, y4, c ftri x3, y3, x4, y4, x1, y1, c End Sub
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long) Dim a& a& = _NewImage(1, 1, 32) _Dest a& PSet (0, 0), K _Dest 0 _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3) _FreeImage a& '<<< this is important! End Sub
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long) Dim Radius As Integer, RadiusError As Integer Dim X As Integer, Y As Integer Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0 If Radius = 0 Then PSet (CX, CY), C: Exit Sub Line (CX - X, CY)-(CX + X, CY), C, BF While X > Y RadiusError = RadiusError + Y * 2 + 1 If RadiusError >= 0 Then If X <> Y + 1 Then Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF End If X = X - 1 RadiusError = RadiusError - X * 2 End If 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 Wend End Sub
Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long) Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single Dim prc As _Unsigned Long, tef As Long prc = _RGB32(255, 255, 255, 255) If a > b Then max = a + 1 Else max = b + 1 mx2 = max + max tef = _NewImage(mx2, mx2) _Dest tef _Source tef 'point wont read without this! For k = 0 To 6.2832 + .05 Step .1 i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang) j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang) If k <> 0 Then Line (lasti, lastj)-(i, j), prc Else PSet (i, j), prc End If lasti = i: lastj = j Next Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer For y = 0 To mx2 x = 0 While Point(x, y) <> prc And x < mx2 x = x + 1 Wend xleft(y) = x While Point(x, y) = prc And x < mx2 x = x + 1 Wend While Point(x, y) <> prc And x < mx2 x = x + 1 Wend If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x Next _Dest destHandle& For y = 0 To mx2 If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF Next _FreeImage tef End Sub
Sub handleSpinners For i = 1 To nS If s(i).dead Then 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 End If Else 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 Else drawSpinner s(i).x, s(i).y, s(i).sz, _Atan2(s(i).dy, s(i).dx), s(i).c End If End If Next End Sub
Sub explode (x, y, r, frm) maxParticles = r * 40 For i = 1 To r NewDot i, x, y, r Next rounds = r For loopCount = 0 To frm If _KeyDown(27) Then End For i = 1 To rounds 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 Next If rounds < maxParticles Then For i = 1 To r NewDot (rounds + i), x, y, r Next rounds = rounds + r End If Next End Sub
Sub NewDot (i, x, y, r) angle = _Pi(2 * Rnd) rd = Rnd * 30 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) End Sub
|
|
johnno56
Junior Member
Logic is the beginning of wisdom.
Posts: 85
|
Post by johnno56 on Aug 19, 2021 0:03:47 GMT -5
Sooo cool.... I have to look for the right sound effects... Ball hitting brick; ball hitting sides; ball squishing bugs... This is going to be fun!
Yet another great job!
J
|
|
johnno56
Junior Member
Logic is the beginning of wisdom.
Posts: 85
|
Post by johnno56 on Aug 19, 2021 0:21:47 GMT -5
|
|
|
Post by bplus on Aug 19, 2021 7:10:42 GMT -5
Thanks johnno56, I'll get them worked in.
|
|
johnno56
Junior Member
Logic is the beginning of wisdom.
Posts: 85
|
Post by johnno56 on Aug 19, 2021 7:25:54 GMT -5
Word of warning... I have already tested the sounds... I personally think that 'blood' may be the one... but the volume needs reducing... but that was not the warning... I noticed that, when the ball hits the critter, the sound plays... and repeats very quickly while the ball remains in contact with the critter... It is really quick and may not be too much of an issue... but I did make the mistake of detecting it... lol
I was thinking of perhaps suggesting both sounds. 'blood' for the smaller critters and 'crush' just for the big ones... Just a thought...
J
|
|
|
Post by bplus on Aug 19, 2021 13:15:29 GMT -5
OK let's see if this forum can take the zip package? Nope! So here it is piece by piece: _Title "Creep Out wSound" 'B+ started 2021-08-18 Breakout with Spiders Randomize Timer
Const xmax = 700 '<==== drawing area width Const ymax = 560 '<==== drawing area height
'colors used Const red = &HFFFF0000 Const orange = &HFFFF6400 Const green = &HFF008000 Const yellow = &HFFFFFF00 Const silver = &HFFD0C6C6 Const white = &HFFFFFFFF Const black = &HFF000000
' 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 nSpinners = 112 Const air_resistance = .1
Type Object x As Single y As Single dx As Single dy As Single sz As Single c As _Unsigned Long dead As Long End Type
Dim Shared nS As Integer Dim Shared dots(2000) As Object
' 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 ' maybe one from Terry Ritchie's Game tutorial here: https://www.qb64sourcecode.com
Dim Shared As Long crunch, mush, pop, alive, uh, gong crunch = _SndOpen("crunch.wav") mush = _SndOpen("mush.wav") pop = _SndOpen("pop.wav") alive = _SndOpen("life.wav") uh = _SndOpen("playerdie.mp3") gong = _SndOpen("gong.wav") 'Print uh 'End Screen _NewImage(xmax, ymax, 32) _FullScreen _MouseHide
Dim Shared bx, by, dx, dy, px, py, pw, plf, prt, 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 = 480 pw = 50 ' paddle width, 100 wide to start half that at certain point plf = 0 ' paddle left side prt = 0 ' paddle right side 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 ReDim Shared s(1 To nSpinners) As Object
initwall 'load arrays with data initball 'set dx, dy, bx, by ball position and change drawtable updatescore While life And _KeyDown(27) = 0 drawtable drawpaddle drawball handleSpinners updatescore If hits = 112 And scrn = 0 Then 'setup new _SndPlay gong _Delay 1 scrn = 1 speedups = 0: obk = 0: rbk = 0: pw = 50 nS = 0 ReDim s(1 To nSpinners) As Object initwall drawtable initball Else If hits = 224 Then _SndPlay gong Color white Text 65, 200, 32, white, "Congratulations on a perfect score!!!" _Delay 3 Exit While End If End If _Display _Limit 40 '< adjust as needed for speed of your system Wend If _KeyDown(27) Then System Color white Text 260, 290, 48, white, "Game Over" _Display Sleep 5 GoTo restart
Sub initwall Dim cr As _Unsigned Long For r = 0 To 7 Select Case r 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 End Select For c = 0 To 13 wc(c, r) = cr: wp(c, r) = p Next Next End Sub
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 End Sub
Sub drawtable ' in JB don't want to redraw this every loop Cls For r = 0 To 7 For c = 0 To 13 If wp(c, r) Then For i = 1 To 10 'underneath Color _RGB32(120, 60, 60) Line (c * bkw + i, r * bkh + bkh + i)-(c * bkw + bkw + i, r * bkh + bkh + i) Color silver 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) Next Color wc(c, r) Line (c * bkw, r * bkh)-(c * bkw + bkw, r * bkh + bkh), , BF Color white Line (c * bkw, r * bkh)-(c * bkw + bkw, r * bkh + bkh), , B End If Next Next Line (0, 300)-(xmax, 480), &HFF000019, BF ' mouse paddle limit End Sub
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 plf = px - pw prt = px + pw For i = 1 To 10 Color _RGB32(120, 60, 60) Line (px - pw + i, py + 10 + i)-(px + pw + i, py + 10 + i), _RGB32(120, 60, 60) Color silver 'PSet (c * bkw + i, r * bkh + bkh + i) 'ink(white) Line (px + pw + i, py + i)-(px + pw + i, py + 10 + i), silver Next Line (px - pw, py)-(px + pw, py + 10), &HFFAA5533, BF End Sub
Sub drawball 'erase last ball, blend into table color CircleFill bx, by, br, black
'update bx = bx + dx If bx < br Then dx = dx * -1: bx = br + 1: _SndPlay pop If bx > xmax - br Then dx = dx * -1: bx = xmax - br - 1: _SndPlay pop
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 _SndPlay uh ' 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 _SndPlay pop dy = dy * -1 If bx < px Then per = .5 * (px - bx) / pw dx = dx - 6 * per ElseIf bx > px Then per = .5 * (bx - px) / pw dx = dx + 6 * per 'Else dx remains same End If 'dx = dx + rand(-2, 2) If dx > 7 Then: dx = 7: If dx < -7 Then dx = -7 End If Else If by - br < 0 Then 'ball hits back border, reverse direction _SndPlay pop by = br: dy = dy * -1 Else 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 End If End If End If silverball bx, by End Sub
Sub handleBall (row, col) If 0 <= row And row <= 7 And 0 <= col And col <= 13 Then If wp(col, row) Then 'brick just hit, lot's to do before update ball hits = hits + 1 _SndPlay mush
nS = nS + 1 newSpinner nS, col, row If hits = 4 Or hits = 8 Or hits = 116 Or hits = 120 Then speedups = speedups + 1 If dy < 0 Then dy = dy - .25 Else dy = dy + .25 End If 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 dy < 0 Then: dy = dy - .25 Else dy = dy + .25 End If End If If value = 7 Then 'flag first red, speed increase paddle decrease! If rbk = 0 Then rbk = 1 speedups = speedups + 1 If dy < 0 Then dy = dy - .25 Else: dy = dy + .25 pw = .75 * pw End If End If score = score + wp(col, row) 'update score with point value wp(col, row) = 0 'no points here now _SndPlay alive
'black out box need this? 'Line (col * bkw, row * bkh)-(col * bkw + bkw, row * bkh + bkh), black, BF End If End If End Sub
Sub updatescore Line (0, 500)-(xmax, ymax), black, BF dxs$ = Right$(" " + Str$(Int(dx)), 3) dys$ = Right$(" " + Str$(Int(dy)), 3) scores$ = Right$(" " + Str$(score), 3) ms$ = " Ball dx,dy:" + dxs$ + "," + dys$ + " Lifes:" + Str$(life) + " Score:" + scores$ Text 0, 520, 32, silver, Space$(60) Text 0, 520, 32, silver, ms$ End Sub
Sub silverball (x, y) For i = 10 To 1 Step -1 cc = 255 - i * 20 CircleFill x, y, i, _RGB32(cc, cc, cc) Next End Sub
Function rand% (lo%, hi%) rand% = Int(Rnd * (hi% - lo% + 1)) + lo% End Function
Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long) ' CX = center x coordinate ' CY = center y coordinate ' R = radius ' C = fill color Dim Radius As Integer, RadiusError As Integer Dim X As Integer, Y As Integer Radius = Abs(R) RadiusError = -Radius X = Radius Y = 0 If Radius = 0 Then PSet (CX, CY), C: Exit Sub Line (CX - X, CY)-(CX + X, CY), C, BF While X > Y RadiusError = RadiusError + Y * 2 + 1 If RadiusError >= 0 Then If X <> Y + 1 Then Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF End If X = X - 1 RadiusError = RadiusError - X * 2 End If 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 Wend End Sub
Sub Text (x, y, textHeight, K As _Unsigned Long, txt$) fg = _DefaultColor cur& = _Dest I& = _NewImage(8 * Len(txt$), 16, 32) _Dest I& Color K, _RGBA32(0, 0, 0, 0) _PrintString (0, 0), txt$ mult = textHeight / 16 xlen = Len(txt$) * 8 * mult _PutImage (x, y)-Step(xlen, textHeight), I&, cur& Color fg _FreeImage I& End Sub
Sub newSpinner (i As Integer, col, row) 'set Spinners dimensions start angles, color? Dim r s(i).x = col * bkw + .5 * bkw s(i).y = row * bkh + .5 * bkh s(i).sz = Rnd * .65 + .1 If Rnd < .5 Then r = -1 Else r = 1 s(i).dx = (s(i).sz * Rnd * 6) * r * 2 s(i).dy = (s(i).sz * Rnd * 6) * r * 2 r = Rnd * 255 s(i).c = _RGB32(r, Rnd * .5 * r, Rnd * .25 * r) End Sub
Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long) Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd Dim cRed, Blue, cGreen Static switch As Integer switch = switch + 2 switch = switch Mod 16 + 1 cRed = _Red32(c): cGreen = _Green32(c): Blue = _Blue32(c) r = 10 * scale x1 = x + r * Cos(heading): y1 = y + r * Sin(heading) r = 2 * r 'lg lengths For lg = 1 To 8 If lg < 5 Then a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10) Else a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10) End If 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) If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1 a1 = a + d * _Pi(1 / 12) 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) rd = Int(Rnd * 8) + 1 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) Next 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, &HFF000000 x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12)) fcirc x2, y2, r * .2, &HFF000000 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) End Sub
Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long) Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6 a = _Atan2(y2 - y1, x2 - x1) a1 = a + _Pi(1 / 2) a2 = a - _Pi(1 / 2) 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 End Sub
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4 Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long) ftri x1, y1, x2, y2, x4, y4, c ftri x3, y3, x4, y4, x1, y1, c End Sub
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long) Dim a& a& = _NewImage(1, 1, 32) _Dest a& PSet (0, 0), K _Dest 0 _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3) _FreeImage a& '<<< this is important! End Sub
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long) Dim Radius As Integer, RadiusError As Integer Dim X As Integer, Y As Integer Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0 If Radius = 0 Then PSet (CX, CY), C: Exit Sub Line (CX - X, CY)-(CX + X, CY), C, BF While X > Y RadiusError = RadiusError + Y * 2 + 1 If RadiusError >= 0 Then If X <> Y + 1 Then Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF End If X = X - 1 RadiusError = RadiusError - X * 2 End If 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 Wend End Sub
Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long) Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single Dim prc As _Unsigned Long, tef As Long prc = _RGB32(255, 255, 255, 255) If a > b Then max = a + 1 Else max = b + 1 mx2 = max + max tef = _NewImage(mx2, mx2) _Dest tef _Source tef 'point wont read without this! For k = 0 To 6.2832 + .05 Step .1 i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang) j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang) If k <> 0 Then Line (lasti, lastj)-(i, j), prc Else PSet (i, j), prc End If lasti = i: lastj = j Next Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer For y = 0 To mx2 x = 0 While Point(x, y) <> prc And x < mx2 x = x + 1 Wend xleft(y) = x While Point(x, y) = prc And x < mx2 x = x + 1 Wend While Point(x, y) <> prc And x < mx2 x = x + 1 Wend If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x Next _Dest destHandle& For y = 0 To mx2 If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF Next _FreeImage tef End Sub
Sub handleSpinners For i = 1 To nS If s(i).dead Then 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 End If Else 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 _SndPlay crunch Else drawSpinner s(i).x, s(i).y, s(i).sz, _Atan2(s(i).dy, s(i).dx), s(i).c End If End If Next End Sub
Sub explode (x, y, r, frm) maxParticles = r * 40 For i = 1 To r NewDot i, x, y, r Next rounds = r For loopCount = 0 To frm If _KeyDown(27) Then End For i = 1 To rounds 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 Next If rounds < maxParticles Then For i = 1 To r NewDot (rounds + i), x, y, r Next rounds = rounds + r End If Next End Sub
Sub NewDot (i, x, y, r) angle = _Pi(2 * Rnd) rd = Rnd * 30 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) End Sub
Crunch was intended for bricks but works so much better on spiders! Gong is when you finish the last brick of screen, 2 full screens = 1 Perfect Game. Live is when you hit a brick and release a spider, it squeals. Attachments:crunch.wav (205.85 KB)
gong.wav (1003.29 KB)
life.wav (86.19 KB)
|
|
|
Post by bplus on Aug 19, 2021 13:16:31 GMT -5
3 more attached: Mush was the splat sound that I swapped for brick hitting, really the spider squeal is all you hear. PlayerDie is when you loose a life because ball missed paddle. Pop stupid sound for bouncing off walls or paddle. johnno56 I had no problems with double sounding bricks or spiders but was only getting one crunch sound intended for brick breaking (even if I broke 10 in a row before ball returned to paddle) with what I renamed crunch, so I used it for spiders instead and really more satisfying use of it!! Attachments:mush.wav (209.75 KB)
PlayerDie.mp3 (78.48 KB)
pop.wav (11.39 KB)
|
|
|
Post by bplus on Aug 19, 2021 13:30:48 GMT -5
Update: the dark blue area around the paddle shows the paddle limits. If your paddle seems stuck you are probably trying to push it past the blue zone. I think we need to vary the sound of the spiders coming alive the eek screech gets a little boring after so many brick hits. Update too: I just checked downloading all files separate to Downloads Folder and the .bas file ran fine from there. It might be easier to pickup the attached .bas file (version 2021-08-19A): Attachments:Creep Out wSound.bas (18.58 KB)
|
|
johnno56
Junior Member
Logic is the beginning of wisdom.
Posts: 85
|
Post by johnno56 on Aug 19, 2021 16:26:36 GMT -5
Cool sound effects. You could be right about the screech... Perhaps inserting a simple random number, say 1 out of 5 hits, to play the screech.
As long as the sound files do not change, then logic dictates that, posting only the '.bas' file would be the most efficient method.
A slightly related topic: You may, or may not, be aware that Covid is flaring up again in Australia. One state (New South Wales) has decided to not comply to Covid rules. More than 600 cases in Sydney alone and a handful of deaths. People are trying to 'escape' and have spread it to neighbouring states... even as far as New Zealand. As a result, here in Melbourne, we will begin our 7th lockdown as soon as the 6th is finished... All because of some selfish individuals in NSW not wanting to comply with the governments' vaccination plan... Idiots!
As a result, with all this 'free time' to contemplate life and the universe... I was thinking about a simple menu... I usually go with plain text, just to get the beast working, then look at 'prettying' up... (for want of a better word). I personally like a menu. I like to 'ease' into a game rather than an immediate 'buckle up' start... lol But that's me...
I noticed that you use two subroutines to display text... From what I understand... One is for modifying the size of the text and the other is to actually display the text. I had a crazy thought... stop laughing... If the size of the text is constant then why not use the right sized font and then use 'print using' to align the text? Just a thought... Unless print using is only effective on system fonts.... anyway, that's another issue... Where was I? Oh, yes. The menu.
I suppose the first thing I should have asked was, 'Do you actually want to use a menu?'... The correct answer will directly effect my Christmas Card list... So, think carefully... Moo Ha Ha... But, seriously, I have no list... Nobody gets a card from me... Moo Ha Ha....
First... It's almost 7:30am (coffee already consumed) and I need to pick up some groceries... Only one person per household permitted to leave home for 'essential' goods per day. I can only carry so much on my push bike...
Have a great day.
J
|
|
|
Post by bplus on Aug 19, 2021 18:05:15 GMT -5
Yeah for all that I use Text for, just load a nice font at nice size and print the score line. Good.
Menu would be fine, specially for changing up levels of difficulty. We could follow Breakout rules more closely by reducing paddle to half and only 3 lives to loose. Or we could mess around with other ideas like 3 or 4 or more perfect screens for perfect game. I am open to your suggestions. BTW I am pretty much having one perfect game after another so ready to increase difficulty. I think the sounds help play better.
Maybe different sounds for the different brick levels/colors, surely there is more than one kind of eeee... out there ;-))
|
|
johnno56
Junior Member
Logic is the beginning of wisdom.
Posts: 85
|
Post by johnno56 on Aug 19, 2021 18:21:08 GMT -5
I tried a font and it didn't work. The handle was correct, but for some reason, _font gets a little picky when the game uses several "_dest". Not a problem. The current system works fine. What's the saying? 'If it ain't broke then don't fix it.'... lol
The menu. Just thinking... not even a snicker... Seeing that the game is mouse controlled, seems only fair, that the menu should be too. I will work on an independent menu before contaminating the game with it... lol I will try to incorporate your 'text' etc routines... Constancy... lol
So... Menu items. Play; Instructions; Difficulty and Exit... ? Sound ok?
J
|
|
|
Post by bplus on Aug 19, 2021 18:32:10 GMT -5
Menu could be a graphic image spread over the screen and mouse selection could be decided by what area of screen clicked. The choices strict Breakout Rules: half paddle width at certain point and only 3 lives OR relaxed Breakout rules: .75 paddle width and 5 lives OR quit (dont want to play the game right now).
I'm not sure about your font difficulty, pass one over and I think I could get it going. We don't need to display dx dy that was for debugging mainly. _Dest not needed for just screen printing.
|
|
|
Post by bplus on Aug 19, 2021 19:10:58 GMT -5
Here's an idea have all the letters in a menu turn into spiders and walk off screen when user clicks a choice.
|
|
|
Post by bplus on Aug 19, 2021 19:13:10 GMT -5
Here's another idea, have a spider dangle down screen over choices according to mouse height before user clicks menu.
|
|
johnno56
Junior Member
Logic is the beginning of wisdom.
Posts: 85
|
Post by johnno56 on Aug 20, 2021 5:03:15 GMT -5
Just opened the browser,,, Well... all those ideas made my simple text/mouse menu pale into insignificance.... lol
Not to worry. I will work on another... Hopefully incorporating some of your ideas.... This time I will start with pencil and paper and search for some assets... This could be fun!
|
|
johnno56
Junior Member
Logic is the beginning of wisdom.
Posts: 85
|
Post by johnno56 on Aug 20, 2021 6:12:01 GMT -5
Ok. I have thrown together a rough mockup of the menu... Excuse the recycled graphics but it's just an idea... This is all hopeful.. Coding is another story... When the menu appears, a large spider will drop down from the web and run across the bottom of the screen. Selecting 'play' will default to 'easy'. 'Play' and 'easy' will highlight. Game begins. Selecting a headstone will highlight the difficulty and 'play'. A skeleton will pop up out of the ground and walk across the screen. Game begins. The mouse pointer could be either a spider or bony hand. I am concerned that this style of menu may or may not suit the overall game theme. The menu can be made simpler and reflect an '8 bit' style. Simple gradient background; 8 bit style font and animated menu critters. If I can I will try for both styles and see which on best fits the game? Anyway... Here is a screen shot of the prototype... Of course, suggestions are always welcome...
|
|