09-05-2024, 04:13 PM
This is more of a prototype for a bigger game, but it works enough to play and try out. It's like a plinko game, you position the ball, let it drop and try to make it stop on the winning area.
Use arrow keys to move the ball left/right. When ready to drop the ball press ENTER. The ball will bounce off the bumpers. The goal is to make the ball stop on the green winners pad at the bottom.
Right now the bumpers are positioned random, not always good, but it would be easy to design a screen, make shapes (lines with slopes) out of the bumpers too.
- Dav
Use arrow keys to move the ball left/right. When ready to drop the ball press ENTER. The ball will bounce off the bumpers. The goal is to make the ball stop on the green winners pad at the bottom.
Right now the bumpers are positioned random, not always good, but it would be easy to design a screen, make shapes (lines with slopes) out of the bumpers too.
- Dav
Code: (Select All)
'==============
'BUMPERBALL.BAS
'==============
'Simple drop the ball on the pad game.
'Coded by Dav, SEP/2024
'Use left/right arrows to move the ball.
'Press the ENTER key to drop the ball.
'Try to make the ball stop on the pad.
'ESC key quits.
Randomize Timer
Screen _NewImage(1000, 800, 32)
bumps = 25 'number of bumpers on the screen
Dim bumpx(bumps), bumpy(bumps), bumpsize(bumps), ballclr~&(bumps)
'===========
restartgame:
'===========
'make random bumper values
For b = 1 To bumps
bumpsize(b) = 15 'bumper size
bumpx(b) = 30 + (Rnd * (_Width - 30)) 'x position
'bumpy(b) = 60 + (Rnd * (_Height - 190))
bumpy(b) = 60 + (b * 25)
ballclr~&(b) = _RGBA(0, 0, 255, 255)
Next
'init puck to drop
pucksize = 30 'puck size
puckclr~& = _RGBA(255, 64, 64, 255) 'puck color
puckx = _Width / 2 'x position
pucky = pucksize 'y position
puckxv = 0 'x speed
puckyv = 0 'y speed
gravity = 0.5 'gravity value
'for timing bouncing stopping
puckytimer = 0
'random location for a winning pad
padx = Rnd * (_Width - 200)
padx2 = padx + 200
pady = _Height - 3
pady2 = 3
'=== loop to move puck until Enter key pressed
Do
Cls , _RGB(45, 45, 45)
'controls
key$ = InKey$
If key$ = Chr$(0) + Chr$(75) Then puckx = puckx - 8 ' Left Arrow
If key$ = Chr$(0) + Chr$(77) Then puckx = puckx + 8 ' Right Arrow
If key$ = Chr$(13) Then Exit Do 'enter drop puck
If key$ = Chr$(27) Then End
'make sure puck stays on screen
If puckx < pucksize Then puckx = pucksize
If puckx > _Width - pucksize Then puckx = _Width - pucksize
'draw puck
fc puckx, pucky, pucksize, puckclr~&, 1
'draw all the bumpers
For b = 1 To bumps
fc bumpx(b), bumpy(b), bumpsize(b), ballclr~&(b), 1
Next
'draw winning pad
Line (padx, pady)-(padx2, pady + pady2), _RGBA(0, 255, 0, 255), BF
_Limit 30
_Display
Loop
'loop for dropping the puck
Do
Cls , _RGB(45, 45, 45)
'apply gravity
puckyv = puckyv + gravity
puckx = puckx + puckxv
pucky = pucky + puckyv
'if hits bottom, bounce off
If pucky > _Height - pucksize Then
If puckyv > .3 Then Play "mbt200l32o1d"
pucky = _Height - pucksize
puckyv = -puckyv * 0.7
End If
'bounce puck off screen edges
If puckx < pucksize Then
Play "mbt200l32o1b"
puckx = pucksize
puckxv = -puckxv * 0.7
End If
If puckx > _Width - pucksize Then
Play "mbt200l32o1b"
puckx = _Width - pucksize
puckxv = -puckxv * 0.7
End If
'draw the puck
fc puckx, pucky, pucksize, puckclr~&, 1
'draw all the bumpers
For b = 1 To bumps
fc bumpx(b), bumpy(b), bumpsize(b), ballclr~&(b), 1
'check for puck collisions with bumpers
If ((puckx - bumpx(b)) ^ 2 + (pucky - bumpy(b)) ^ 2) < (pucksize + bumpsize(b)) ^ 2 Then
fc bumpx(b), bumpy(b), bumpsize(b), _RGBA(255, 255, 0, 255), 1
Play "mbt200o5l32ef"
x = (puckx - bumpx(b)): y = (pucky - bumpy(b))
dis = Sqr(x * x + y * y)
If dis > 0 Then
x = x / dis: y = y / dis
End If
vr = puckxv * x + puckyv * y
puckxv = puckxv - 2 * vr * x
puckyv = puckyv - 2 * vr * y
over = (pucksize + bumpsize(b)) - Sqr((puckx - bumpx(b)) ^ 2 + (pucky - bumpy(b)) ^ 2)
puckx = puckx + x * over
pucky = pucky + y * over
End If
Next
'reduce x velocity so ball doesn't roll on bottom too long
If pucky >= _Height - pucksize Then
puckxv = puckxv * 0.88 'reduce x velocity
End If
'I'm using a timer to see if ball has stopped moving much.
'check if puck is near bottom, and if puckyv hasn't changed since timer
If Abs(pucky - (_Height - pucksize)) < 10 Then
If Abs(puckyv - lastPuckyv) < .1 Then
puckytimer = puckytimer + 0.033
Else
puckytimer = 0
End If
lastPuckyv = puckyv
'if it's been 2 seconds since puckyv was stable
If puckytimer >= 2.0 Then
'if puck is on winning pad
If puckx >= padx And puckx <= padx2 Then
Line (0, 0)-(_Width, _Height), _RGBA(0, 255, 0, 25), BF
Play "mbt120l16o2c,e e,g e,g,o3c"
Else
Line (0, 0)-(_Width, _Height), _RGBA(255, 0, 0, 25), BF
Play "mbt120l16o2b,f e b,f"
End If
_Display
Exit Do
End If
Else
puckytimer = 0 'Reset timer otherwise
lastPuckyv = puckyv
End If
' Draw winning pad
Line (padx, pady)-(padx2, pady + pady2), _RGBA(0, 255, 0, 255), BF
_Limit 30
_Display
If InKey$ = Chr$(27) Then End
Loop
_Delay 2
GoTo restartgame
Sub fc (cx, cy, radius, clr~&, grad)
If radius = 0 Then Exit Sub ' safety bail
If grad = 1 Then
red = _Red32(clr~&)
grn = _Green32(clr~&)
blu = _Blue32(clr~&)
alpha = _Alpha32(clr~&)
End If
r2 = radius * radius
For y = -radius To radius
x = Int(Sqr(r2 - y * y))
' If doing gradient
If grad = 1 Then
For i = -x To x
dis = Sqr(i * i + y * y) / radius
red2 = red * (1 - dis) + (red / 2) * dis
grn2 = grn * (1 - dis) + (grn / 2) * dis
blu2 = blu * (1 - dis) + (blu / 2) * dis
clr2~& = _RGBA(red2, grn2, blu2, alpha)
Line (cx + i, cy + y)-(cx + i, cy + y), clr2~&, BF
Next
Else
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
End If
Next
End Sub