QB64 Phoenix Edition
Air Hockey - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: bplus (https://qb64phoenix.com/forum/forumdisplay.php?fid=36)
+---- Thread: Air Hockey (/showthread.php?tid=255)

Pages: 1 2


RE: Air Hockey - bplus - 05-24-2022

If Sqr((x - cx) ^ 2 + (y - cy) ^ 2) < (pr + pr2) Then

Sqr((x - cx) ^ 2 + (y - cy) ^ 2) = distance between (x,y) and (cx, cy)

(pr + pr2) = the sum of radius of 2 round objects

The radii you are using @SierraKen are r and rr, the same you use for drawing the circles.

See if it looks better replacing pr+pr2 with r and rr.


RE: Air Hockey - SierraKen - 05-24-2022

Wow that does work a bit better, thanks B+!


RE: Air Hockey - bplus - 05-24-2022

(05-24-2022, 02:34 AM)vince Wrote: Yes, this is in the top 10 QB64 games of all time, nice job B+.  You should post your fully working angle pong in this thread as well!

Not practical in a game of Pong or Air Hockey, takes too long. Saving the effect for my snow plowing program where you have to angle the blade of the plow.


RE: Air Hockey - bplus - 05-24-2022

(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



RE: Air Hockey - SierraKen - 05-24-2022

Wow thank you B+! I like how you move the puck away from the wall. I might turn this into some kind of game. I was going to use this with my Bricks Smasher game but we'll see. Thanks again! I am learning. Smile


RE: Air Hockey - bplus - 05-30-2022

I took Ken's mod of my notes above and overhauled it for the Pong Clone that he had.
Code: (Select All)
_Title " bplus Overhaul of Pong Clone by SierraKen"
Dim Shared pScore, cScore, ballX, ballY, computerX, computerY, playerX, playerY
Dim Shared ballR, computerR, playerR, speed, newGameF, maxPoint
Dim Shared As _Unsigned Long ballC, computerC, playerC
Randomize Timer
Screen _NewImage(950, 550, 32)
_ScreenMove 200, 60
_PrintMode _KeepBackground

' constants
ballR = 5: ballC = _RGB32(255, 255, 255) ' <<<< lets label everything of puck with p
playerR = 20: playerC = _RGB32(225, 100, 0)
computerR = 20: computerC = _RGB32(220, 80, 10)
speed = 7: maxPoint = 10 ' really keeping puck at constant speed

intro
newGame: ' resets
newGameF = 0: pScore = 0: cScore = 0
While newGameF = 0

    ' throw out the ball, ready players and ball
    playerX = 700: playerY = 275
    computerX = 250: computerY = 275: 'Computer Racket
    ballX = 475: ballY = 25
    'throw ball out towards computer or player but not or nearly straight across
    If Rnd < .5 Then ballAngle = _Pi(.2) * Rnd + _Pi(.25) Else ballAngle = _Pi(.75) - Rnd * _Pi(.2)

    updateScreen
    _Delay 1 ' give human a moment to get ready
    Do

        'player mouse controled paddle
        While _MouseInput: Wend ' better way to poll mouse and label mouse x, y as playerX, playerY like everyone else
        playerY = _MouseY: testx = _MouseX ' move x too!!! this is not 1972
        If testx >= _Width / 2 Then playerX = testx

        ' b+ AI
        If ballX < computerX Then
            If (computerX - 25) > (25 + computerR) Then computerX = computerX - 25
            'If ballY > 300 Then computerY = ballY - 55 Else computerY = ballY + 55
        Else
            If Timer(.001) - htime > .5 Then
                c1 = c1 + _Pi(1 / 80)
                If ballX > computerX Then computerX = 250 + 200 * Sin(c1)
                computerY = ballY + 25 * Sin(c1)
            End If
        End If

        ' collision computer paddle
        d = Sqr((computerX - ballX) ^ 2 + (computerY - ballY) ^ 2) - (ballR + computerR)
        If d < 0 Then ' (pr + pr2) to (r + rr)   collision!
            ballAngle = _Atan2(ballY - computerY, ballX - computerX) ' get the angle of the puck to the mouse
            ballX = ballX + 20 * Cos(ballAngle) ' move the puck out of the mouse paddle
            ballY = ballY + 20 * Sin(ballAngle) '
            Sound 230, 1
            htime = Timer(.001)
        End If

        ' check for collision player paddle
        d = Sqr((playerX - ballX) ^ 2 + (playerY - ballY) ^ 2) - (ballR + playerR)
        If d < 0 Then ' (ballR + pr2) to (r + rr)   collision!
            ballAngle = _Atan2(ballY - playerY, ballX - playerX) ' get the angle of the puck to the mouse
            ballX = ballX + 20 * Cos(ballAngle) ' move the puck out of the mouse paddle
            ballY = ballY + 20 * Sin(ballAngle) '
            Sound 230, 1
        End If

        ' scoring balls
        If ballX > 925 Then cScore = cScore + 1: For snd = 600 To 400 Step -10: Sound snd, .5: Next: Exit Do
        If ballX < 25 Then pScore = pScore + 1: For snd = 400 To 600 Step 10: Sound snd, .5: Next: Exit Do
        'keep puck out of wall = wall boundary +- radius of puck
        If ballY > 525 - ballR Then Sound 600, .25: ballAngle = -ballAngle: ballY = 525 - ballR ' move puck out of wall !!!
        If ballY < 25 + ballR Then Sound 600, .25: ballAngle = -ballAngle: ballY = 25 + ballR ' move puck out of wall !!!

        ' nove the puck along and draw it
        ballX = ballX + speed * Cos(ballAngle) ' now move the puck along  it's new direction ballAngle = puck angle
        ballY = ballY + speed * Sin(ballAngle) '

        If _KeyDown(27) Then System ' quit
        updateScreen
        If cScore = maxPoint Then
            yCP 25, "You Lose!" + Space$(45) + "Play Again (Y/N)?"
        ElseIf pScore = maxPoint Then
            yCP 25, "You Win!" + Space$(45) + "Play Again (Y/N)?"
        End If
        _Display
        _Limit 60 ' hold screen for moment
        If cScore >= maxPoint Or pScore >= maxPoint Then
            k$ = " "
            Do
                k$ = LCase$(InKey$)
                If k$ = "y" Then newGameF = -1: Exit Do
                If k$ = "n" Then End
            Loop
        End If
        If newGameF Then GoTo newGame
    Loop
Wend

Sub updateScreen
    If cScore = maxPoint Or pScore = maxPoint Then computerX = 250: computerY = 275
    Cls ' Clear our work and redraw everything
    Line (25, 25)-(925, 525), _RGB32(0, 100, 50), BF
    Line (25, 25)-(925, 525), _RGB32(255, 255, 255), B
    Line (25, 275)-(925, 275), _RGB32(255, 255, 255)
    Line (473, 20)-(473, 530), _RGB32(255, 255, 255), , &B0000011111000000
    Line (475, 20)-(475, 530), _RGB32(255, 255, 255), , &B1111100000111110
    Line (477, 20)-(477, 530), _RGB32(255, 255, 255), , &B0000011111000000
    _PrintString (200, 5), "Computer:" + Str$(cScore)
    _PrintString (680, 5), "You: " + Str$(pScore)
    drawBall ballX, ballY, ballR, ballC ' draw puck
    fillCircle playerX + 2, playerY + 4, playerR + Rnd * 3 + 2, &H20000000 ' draw mouse paddle
    fillCircle playerX, playerY, playerR, playerC ' draw mouse paddle
    fillCircle computerX - 2, computerY + 4, computerR + Rnd * 3 + 2, &H20000000
    fillCircle computerX, computerY, computerR, computerC
End Sub

Sub intro
    Cls
    yCP 10, "P  O   N   G     C   L   O   N   E"
    yCP 12, "By SierraKen"
    yCP 14, "bplus overhauled  2022-05-30"
    yCP 18, "Use your mouse to control the round paddle on the right side."
    yCP 20, "First one to reach 10 points wins."
    yCP 29, "Press Mouse Button To Begin."
    Do
        While _MouseInput: Wend
        If _MouseButton(1) = -1 Then Exit Do
    Loop
End Sub

Sub yCP (row, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
    'Locate row, 1: Print Space$(_Width); ' clear old
    _PrintString ((_Width - _PrintWidth(s$)) / 2, row * 16), s$
End Sub

'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

Sub drawBall (x, y, r, c As _Unsigned Long)
    Dim rred As Long, grn As Long, blu As Long, rr As Long, f
    rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
    For rr = r To 0 Step -1
        f = 1 - .25 * rr / r
        fillCircle x, y, rr, _RGB32(rred * f, grn * f, blu * f)
    Next
End Sub

   

The only hint I can give for this weird AI is to shoot for one of the corners while the computer paddle is up front.


RE: Air Hockey - Dav - 05-31-2022

Really great game, and coding.  I'm finding it hard to beat.  Yeah, I can see I'll be playing this one for a while.

- Dav


RE: Air Hockey - SierraKen - 05-31-2022

LOL That's really cool B+! I like the other dimension of play you added.


RE: Air Hockey - bplus - 05-31-2022

Thanks, Air Hockey and Pong without the paddle on a rail are just about the same, but oddly I could not get the Air Hockey AI to work in our Pong Clone. Also odd the computer can get 2 or 3 hits in before it crosses the net. I had to time out the hits to prevent continuous shoving up the screen, like a good hockey player may do before passing or taking a goal shot.