Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Air Hockey
#14
(05-24-2022, 12:58 AM)SierraKen Wrote: B+, I've been using your math code from this game to make an example of wall reflection. It's not perfect, but I thought I would show you what I made using this code. If you have any suggestions or comments, I'm all ears. Smile  Thanks for making this game!

Code: (Select All)
'Walls Reflection Example by SierraKen
'Reflection math from B+'s Air Hockey.

Screen _NewImage(800, 600, 32)
Const pr = 20 '
Const pr2 = 2 * pr '
start:
Cls
cx = 350: cy = 250: r = 20
c = _RGB32(0, 255, 0)
rr = 20
cc = _RGB32(255, 0, 0)
speed = 5

Dim pao
Randomize Timer
pao = _Pi(1 / 10) * Rnd
If Rnd < .5 Then pa = _Pi(.5) Else pa = _Pi(1.5)
If Rnd < .5 Then pa = pa + pao Else pa = pa - pao
_Title "Reflection Walls Example - Press Space Bar to reset."
Do
    _Limit 100
    a$ = InKey$
    If a$ = " " Then GoTo start:
    If a$ = Chr$(27) Then End
    Line (100, 100)-(700, 500), _RGB32(255, 255, 255), B
    Do While _MouseInput 'mouse status changes only
        x = _MouseX
        y = _MouseY
    Loop
    fillCircle x, y, rr, cc
    If Sqr((x - cx) ^ 2 + (y - cy) ^ 2) < (pr + pr2) Then
        pa = _Atan2(y - cy, x - cx)
        pa = _Pi(1) - pa
        GoTo go:
    End If
    go:
    cx = cx + speed * Cos(pa)
    cy = cy + speed * Sin(pa)
    If cx > 675 Then pa = -pa: speed = -speed
    If cx < 125 Then pa = -pa: speed = -speed
    If cy > 475 Then pa = -pa
    If cy < 125 Then pa = -pa
    fillCircle cx, cy, r, c

    _Display
    Cls
Loop

'from Steve Gold standard
Sub fillCircle (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

@SierraKen and all who want a good model to work from:
After I fixed the sum of 2 radius for collision, I saw the ball still not travelling correctly specially off the mouse so I overhauled everything for clear Model of Ball Reflections. It is important to point out when ball collides with mouse or wall to pull it out of collision point and then send it on it's merry way.

Also want to say, the physics of this is not correct, it is over simplified bounce off paddle.

Code: (Select All)
_Title " 2022-05-24 b+ Overhaul of Ken's Reflection Walls Example"
'Walls Reflection Example by SierraKen
'Reflection math from B+'s Air Hockey.

Randomize Timer
Screen _NewImage(800, 600, 32)
'' Const pr = 20    '  not using !
'' Const pr2 = 2 * pr '  not using !

' thses remain constant
px = 350: py = 250: pr = 5: pc = _RGB32(0, 255, 0) ' <<<< lets label everything of puck with p
speed = 5 ' really keeping puck at constant speed

mr = 50: mc = _RGB32(255, 0, 0) ' <<<< evrything mouse starts with m , use different radius for mouse

start:
px = 400: py = 300
Cls
'pao = _Pi(1 / 10) * Rnd ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ????  this is silly
'If Rnd < .5 Then pa = _Pi(.5) Else pa = _Pi(1.5) ' ?????
'If Rnd < .5 Then pa = pa + pao Else pa = pa - pao '???

pa = _Pi(2) * Rnd ' pa = puck angle this is rnd times all directions 0 to 360 in degrees 0 to 2*pi in radians

_Title "Reflection Walls Example - Press Space Bar to reset."
Do

    Cls ' Clear our work and recalulate and redraw everything
    Line (100, 100)-(700, 500), _RGB32(255, 255, 255), B ' draw the boundary

    a$ = InKey$
    If a$ = " " Then GoTo start:
    If a$ = Chr$(27) Then End

    'inefficient way to poll mouse = update mx and my
    'Do While _MouseInput 'mouse status changes only
    '    x = _MouseX
    '    y = _MouseY
    'Loop
    While _MouseInput: Wend ' better way to poll mouse and label mouse x, y as mx, my like everyone else
    mx = _MouseX
    my = _MouseY
    fillCircle mx, my, mr, mc ' draw mouse paddle

    ' check for collision
    ' first part measure distance between mouse center and puck center, is it less than radius of mouse + puck?
    If Sqr((mx - px) ^ 2 + (my - py) ^ 2) < (pr + mr) Then ' (pr + pr2) to (r + rr)   collision!
        pa = _Atan2(py - my, px - mx) ' get the angle of the puck to the mouse

        px = px + speed * Cos(pa) ' move the puck out of the mouse paddle
        py = py + speed * Sin(pa) '

        ' show the collision and replacement of ball AFTER removed from inside the mouse
        Line (mx, my)-(px, py), &HFFFFFFFF
        _Display
        _Delay .1
    End If

    'keep puck out of wall = wall boundary +- radius of puck
    If px > 700 - pr Then pa = _Pi - pa: px = 700 - pr ' move puck out of wall !!!
    If px < 100 + pr Then pa = _Pi - pa: px = 100 + pr ' move puck out of wall !!!
    If py > 500 - pr Then pa = -pa: py = 500 - pr ' move puck out of wall !!!
    If py < 100 + pr Then pa = -pa: py = 100 + pr ' move puck out of wall !!!

    ' nove the puck along and draw it
    px = px + speed * Cos(pa) ' now move the puck along  it's new direction pa = puck angle
    py = py + speed * Sin(pa) '
    fillCircle px, py, pr, pc ' draw puck

    _Display
    _Limit 60 ' hold screen for moment

Loop

'from Steve Gold standard
Sub fillCircle (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
b = b + ...
Reply


Messages In This Thread
Air Hockey - by bplus - 04-27-2022, 11:53 PM
RE: Air Hockey - by vince - 05-03-2022, 02:15 AM
RE: Air Hockey - by bplus - 05-14-2022, 03:54 PM
RE: Air Hockey - by vince - 05-17-2022, 07:20 PM
RE: Air Hockey - by bplus - 05-17-2022, 07:38 PM
RE: Air Hockey - by SierraKen - 05-23-2022, 11:20 PM
RE: Air Hockey - by OldMoses - 05-23-2022, 11:46 PM
RE: Air Hockey - by bplus - 05-24-2022, 12:35 AM
RE: Air Hockey - by SierraKen - 05-24-2022, 12:58 AM
RE: Air Hockey - by vince - 05-24-2022, 02:34 AM
RE: Air Hockey - by bplus - 05-24-2022, 02:41 AM
RE: Air Hockey - by SierraKen - 05-24-2022, 02:55 AM
RE: Air Hockey - by bplus - 05-24-2022, 03:24 PM
RE: Air Hockey - by bplus - 05-24-2022, 04:44 PM
RE: Air Hockey - by SierraKen - 05-24-2022, 08:17 PM
RE: Air Hockey - by bplus - 05-30-2022, 11:27 PM
RE: Air Hockey - by Dav - 05-31-2022, 12:50 AM
RE: Air Hockey - by SierraKen - 05-31-2022, 02:14 AM
RE: Air Hockey - by bplus - 05-31-2022, 01:45 PM



Users browsing this thread: 8 Guest(s)