+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: Plinko (/showthread.php?tid=940)
Plinko - james2464 - 10-02-2022
I wanted to learn more about collisions, so I tried this.
I'm sure most people here already know about this but I figured I'd share anyway. The subject that is central here is "collision response", and in this case it's the "dynamic / static" variety. Interesting stuff for a mathematician I'm sure. Rather than deep dive into the physics I was able to accomplish a decent result using Terry's game tutorial (have I mentioned how great that is yet? haha)
Sound files are attached.
(Edit: use mouse to position chip and click to drop it)
Code: (Select All)
'Plinko
'james2464
'Oct 2022
Dim Shared scx, scy As Integer
'screen size
scx = 500 '
scy = 700 '
Screen _NewImage(scx, scy, 32)
Dim Shared xx, yy
xx = scx / 2
yy = scy / 2
Randomize Timer
Const PI = 3.141592654#
Dim Shared chip&, pin1&, bgsnap&
chip& = _NewImage(101, 101, 32)
pin1& = _NewImage(21, 21, 32)
bgsnap& = _NewImage(scx + 1, scy + 1, 32)
Dim Shared c0(100) As Long
colour1
Type movingchip
x As Single
y As Single
xv As Single
yv As Single
spd As Single
live As Integer
age As Integer
rad As Integer
colour As Integer
x1 As Integer
x2 As Integer
y1 As Integer
y2 As Integer
End Type
Dim Shared ch(10) As movingchip
Type fixedpin
x As Single
y As Single
rad As Integer
colour As Integer
x1 As Integer
x2 As Integer
y1 As Integer
y2 As Integer
End Type
Dim Shared pin(200) As fixedpin
'create chip image with clear background
Circle (xx, yy), 16, c0(7) 'chip outline
Paint (xx, yy), c0(7)
Circle (xx, yy), 14, c0(9) 'chip colour
Paint (xx, yy), c0(9)
_PutImage (0, 0), 0, chip&, (xx - 50, yy - 50)-(xx + 50, yy + 50)
_ClearColor c0(0), chip&
Cls
'create pin image with clear background
Circle (xx, yy), 5, c0(7) 'pin outline
Paint (xx, yy), c0(7)
Circle (xx, yy), 3, c0(1) 'pin colour
Paint (xx, yy), c0(1)
_PutImage (0, 0), 0, pin1&, (xx - 10, yy - 10)-(xx + 10, yy + 10)
_ClearColor c0(0), pin1&
Line (0, 0)-(scx, scy), c0(10), BF 'background colour
Line (1, 1)-(30, scy), c0(5), BF 'side borders
Line (scx, 1)-(scx - 30, scy), c0(5), BF
Line (30, 637)-(scx - 30, 639), c0(0), BF 'result position slots
Line (29, 600)-(31, 639), c0(0), BF
Line (scx - 29, 600)-(scx - 31, 639), c0(0), BF
For t = 1 To 8
Line (24 + 50 * t, 600)-(26 + 50 * t, 637), c0(0), BF
Next t
'result slot colours
Line (31, 640)-(75, scy), c0(11), BF
Line (76, 640)-(125, scy), c0(12), BF
Line (126, 640)-(175, scy), c0(13), BF
Line (176, 640)-(225, scy), c0(14), BF
Line (226, 640)-(275, scy), c0(15), BF
Line (276, 640)-(325, scy), c0(16), BF
Line (326, 640)-(375, scy), c0(17), BF
Line (376, 640)-(425, scy), c0(18), BF
Line (426, 640)-(scx - 30, scy), c0(19), BF
Dim Shared click& '3 sounds to choose from
click& = _SndOpen("button30.wav") 'reasonably authentic sound
'click& = _SndOpen("G021.mp3") 'mild arcade sound
'click& = _SndOpen("pop10.ogg") 'gentle sound
_SndVol click&, .5
Dim Shared vx, vy, lv1, vx2, vy2, vx3, vy3, lv2, sp As Single
Dim Shared j As Integer
'define chip and pin
ch(1).rad = 16
Dim pintot As Integer
pintot = 93
t = 0
t2 = 0
t3 = 0
Do
t3 = t3 + 1
If t2 = 0 Then
For t1 = 1 To 8
t = t + 1
pin(t).x = 25 + t1 * 50
pin(t).y = 30 + t3 * 50
Next t1
t2 = 1
Else
For t1 = 1 To 9
t = t + 1
pin(t).x = 0 + t1 * 50
pin(t).y = 30 + t3 * 50
Next t1
t2 = 0
End If
Loop Until t = pintot
For t = 1 To pintot
pin(t).rad = 4
pin(t).x1 = pin(t).x - pin(t).rad
pin(t).x2 = pin(t).x + pin(t).rad
pin(t).y1 = pin(t).y - pin(t).rad
pin(t).y2 = pin(t).y + pin(t).rad
Next t
'draw pins
For t = 1 To pintot
_PutImage (pin(t).x - 10, pin(t).y - 10)-(pin(t).x + 10, pin(t).y + 10), pin1&, 0 ' draw pin
Next t
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen
Do 'general program loop
Cls
'chip starting pos - using mouse
mouseclick1 = 0
Do
_Limit 30
Do While _MouseInput
Loop
mx% = _MouseX
my% = 35
If mx% < 50 Then mx% = 50
If mx% > scx - 50 Then mx% = scx - 50
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'draw background
_PutImage (mx% - 50, my% - 50)-(mx% + 50, my% + 50), chip&, 0 ' draw chip
_Display
lc% = _MouseButton(1)
If lc% = -1 Then mouseclick1 = 1
Loop Until mouseclick1 = 1
stx = mx%
sty = my%
ch(1).x = stx: ch(1).y = sty
flag = 0
ch(1).xv = 0 'starting velocity
ch(1).yv = 0 'starting velocity
Do '======================================= loop for falling chip
_Limit 150
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'draw background
'====================================================================================================
'====================================================================================================
gravityadd = .025 ' apply some gravity
ch(1).yv = ch(1).yv + gravityadd
'====================================================================================================
'====================================================================================================
ch(1).x = ch(1).x + ch(1).xv ' update X position value
ch(1).y = ch(1).y + ch(1).yv ' update Y position value
If ch(1).y > 580 Then ' minimize chip X motion upon exit
ch(1).xv = ch(1).xv * .8
End If
If ch(1).x < 47 Then ' left side wall
ch(1).x = 47
ch(1).xv = ch(1).xv * -1
End If
If ch(1).x > scx - 47 Then 'right side wall
ch(1).x = scx - 47
ch(1).xv = ch(1).xv * -1
End If
'================================================================================================
ch(1).x1 = ch(1).x - 50 'get image box corner positions for rectangle early collision detection
ch(1).x2 = ch(1).x + 50
ch(1).y1 = ch(1).y - 50
ch(1).y2 = ch(1).y + 50
For j = 1 To pintot 'check for collision
If collide1 = 1 Then 'quick rectangle check
If collide2 = 1 Then 'if rectangle check confirmed, then circle collision check
vectorupdate 'change chip vector based on collision angle
End If
End If
Next j
'================================================================================================
_PutImage (ch(1).x - 50, ch(1).y - 50)-(ch(1).x + 50, ch(1).y + 50), chip&, 0 ' draw chip
_Display
If ch(1).y > 620 Then 'chip hits the bottom
_SndPlayCopy click&
flag = 1
End If
Loop Until flag = 1
If _SndPlaying(click&) Then _SndStop click%
_Delay 3.
'-=======================================================
'for later...insert section for scoring etc
'-=======================================================
If _KeyDown(27) Then quit1 = 1 'esc key to quit
Loop Until quit1 = 1
End
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
Function collide1 'rectangle - early detection
collide1 = 0
If ch(1).x2 >= pin(j).x1 Then
If ch(1).x1 <= pin(j).x2 Then
If ch(1).y2 >= pin(j).y1 Then
If ch(1).y1 <= pin(j).y2 Then
collide1 = 1
End If
End If
End If
End If
End Function
Function collide2 'circle detection
Dim SideA%
Dim SideB%
Dim Hypot&
If ch(1).x = pin(j).x Then 'prevent chip from being perfectly above a pin (randomize and nudge)
t = Rnd * 100
If t > 49 Then
ch(1).x = ch(1).x + .05
Else
ch(1).x = ch(1).x - .05
End If
End If
collide2 = 0
SideA% = ch(1).x - pin(j).x
SideB% = ch(1).y - pin(j).y
Hypot& = SideA% * SideA% + SideB% * SideB%
If Hypot& <= ((ch(1).rad + pin(j).rad) * (ch(1).rad + pin(j).rad) + 4) Then 'added + 4 to prevent late detection
_SndPlayCopy click&
collide2 = 1
End If
End Function
Sub vectorupdate 'change chip movement based on collision
'normalize chip velocity vectors
vx = ch(1).xv
vy = ch(1).yv
sp = vx + vy 'speed based on velocities
lv1 = Sqr(vx * vx + vy * vy)
vx = vx / lv1
vy = vy / lv1
'normalize collision point vectors
vx2 = ch(1).x - pin(j).x
vy2 = ch(1).y - pin(j).y
lv2 = Sqr(vx2 * vx2 + vy2 * vy2)
vx3 = vx2 / lv2
vy3 = vy2 / lv2
'update chip velocity vectors
If sp > .5 Then sp = sp * .65 'govern speed to prevent craziness
If ch(1).x <= pin(j).x Then
ch(1).xv = sp * vx3
If ch(1).xv > -.3 Then ch(1).xv = -.3 'keep things moving - override
Else
ch(1).xv = sp * vx3
If ch(1).xv < .3 Then ch(1).xv = .3 'keep things moving - override
End If
If ch(1).y <= pin(j).y Then
ch(1).yv = vy3 * sp
If ch(1).yv > -.3 Then ch(1).yv = -.3 'keep things moving - override
Else
ch(1).yv = 0 - vy3 * sp
If ch(1).yv < .3 Then ch(1).yv = .3 'keep things moving - override
End If
End Sub
Sub colour1 ' some predefined colours
c0(0) = _RGB(0, 0, 0)
c0(1) = _RGB(255, 255, 255) 'pin
c0(2) = _RGB(255, 0, 0)
c0(3) = _RGB(150, 150, 255)
c0(4) = _RGB(0, 200, 50)
c0(5) = _RGB(25, 50, 100) 'borders
c0(6) = _RGB(55, 50, 45)
c0(7) = _RGB(40, 40, 40) 'chip and pin outline
c0(8) = _RGB(125, 125, 200)
c0(9) = _RGB(200, 200, 200) 'chip
c0(10) = _RGB(50, 100, 200) 'board background
c0(11) = _RGB(250, 0, 0) 'result slot 1
c0(12) = _RGB(50, 150, 250) 'result slot 2
c0(13) = _RGB(25, 50, 250) 'result slot 3
c0(14) = _RGB(250, 0, 0) 'result slot 4
c0(15) = _RGB(0, 250, 0) 'result slot 5 (center)
c0(16) = _RGB(250, 0, 0) 'result slot 6
c0(17) = _RGB(25, 50, 250) 'result slot 7
c0(18) = _RGB(50, 150, 250) 'result slot 8
c0(19) = _RGB(250, 0, 0) 'result slot 9
End SubRE: Plinko - bplus - 10-02-2022
Works fine even without sound!
RE: Plinko - TerryRitchie - 10-02-2022
Cool!