Post by bplus on Aug 14, 2021 14:23:28 GMT -5
I've been working on my version of Breakout, took johnno56 hint about altering reflection from paddle according to distance away from paddle center for ball control. Works pretty nice except when your mouse wanders off screen and paddle gets stuck.
_Title "Breakout simplify 2021-08" 'B+ redo trans
'_Title "Breakout trans from SdlBasic" 'B+ tranlate 2019-03-25
'Breakout.sdlbas (B+=MGA) 2016-12-24
'adapted from just posted JB version add 3d modifications
Randomize Timer
Const xmax = 700 '<==== drawing area width
Const ymax = 560 '<==== drawing area height
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
Const py = 480 ' paddle surface
'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, my, 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
pw = 50 ' paddle width, 100 wide to start half that at certain point
plf = 0 ' paddle left side
prt = 0 ' paddle right side
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
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
updatescore
If hits = 112 And scrn = 0 Then 'setup new
_Delay 1
scrn = 1
speedups = 0: obk = 0: rbk = 0: pw = 50
initwall
drawtable
initball
Else
If hits = 224 Then
Color white
Text 65, 200, 32, orange, "Congratulations on a perfect score!!!"
Exit While
End If
End If
_Display
_Limit 60 '< adjust as needed for speed of your system
Wend
If _KeyDown(27) Then System
Color white
Text 260, 290, 48, orange, "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 = rand(br, 700 - br)
by = rand(py - 100, py - 10)
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
'erase last paddle, it is aligned with Blue Computer Goal Line
'Color black
'Line (px - pw, py)-(px + pw, py + ph), black, BF
'EllipseFill px, py + 10, pw, 20, black
While _MouseInput: Wend
px = _MouseX 'update paddle location
'k$ = InKey$
'If Len(k$) Then
' If Len(k$) = 2 And Asc(Right$(k$, 1)) = 75 Then px = px - 8
' If Len(k$) = 2 And Asc(Right$(k$, 1)) = 77 Then px = px + 8
'End If
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
'For i = 20 To 1 Step -1
' cc = 255 - i * 10
' EllipseFill px, py + 10, pw - (20 - i), i, _RGB32(cc, .5 * cc, .25 * cc)
'Next
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
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