Profile Pong Game Development

[bplus]

I don't like shape of those paddles and think hey this is a call to my Rectircle drawing sub!

Ah but these paddles need different collision detection basically
1. Check collision with straight edge of paddle first, collision Circle to Line Segment code.
Return ball by reversing BallDX
2. & 3. Check collision with top circle of paddle and then bottom circle.
Return ball using the angle the ball is to paddle top or bottom circle.

Version 2-0

Code: (Select All)

Option _Explicit
_Title "Profile Pong 2-0" ' b+ 2023-02-01 started inspired by Rosy game at RCBasic
'2023-02-02 1.1 fix straight up and down problem that infinitely loops.
' You can hit a ball again so long as the dx is still headed at you or 0.
' To tighten down game to actual Ping Pong Rules added variables TableTouchL and TableTouchR
' Set those to 0 when ball collides with paddle on that side. Check those when scoring points.
' Oh some sound effects would be nice.
'2023-02-02 1-2 Increase paddleR, let paddle go through table 1/2 way, blue background.
' Try nicer font...
'2023-02-03 2-0 change shape of paddle and work out collision code circle and line segment,
' collision with offset for ball radius. Add recticle draw sub for new paddle shape.
' Collision with paddle has 3 parts now:
' 1. Collision with straight part of paddle
' 2. Collision with top circle of paddle
' 3. Collision with bottom corcle part of paddle
' PaddleR was decressed since now circle parts of paddle instead of 1/2 circle.
' Now it seems too easy to beat Computer, will take care of that next!
' Clean up comments.

'                       Rules of Profile Ping Pong (now in effect):
' On your serve or return you must clear net and not bounce again on your side of the table.
' Opponent may or may not chooses to wait for bounce.
' Opponent should not attempt to return a ball clearly not going to hit his side of table,
' to win a point. (Currently this Computer player is obblivious to this and saves the
' players butt many a time when ball misses table.)

Const Xmax = 1200, Ymax = 700 '     screen size
Const PaddleR = 30, BallR = 5 '     radii
Const TableL = 100, TableR = 1100 ' table ends
Const TableY = Ymax - 80 '          table height from top screen
Const NetY = TableY - 40 '          net height from top screen
Const NetL = 598 '                  net left side
Const NetR = 602 '                  net right side
Const Gravity = .1 '                just about right drop
Const BallSpeed = 8 '               for ball speed

Dim Shared As Long Table, LPaddle, RPaddle ' images shared so can be made in isolated subs once

Screen _NewImage(Xmax, Ymax, 32)
_ScreenMove 60, 20 '               <<< you may want different, for my screen it is almost middle
_PrintMode _KeepBackground '         usebackground color or image for background of text printed

Dim As Long f, mx, my, playerX, playerY, ballX, ballY, computerX, computerY ' locating
Dim As Long playerPt, computerPt, TableTouchL, TableTouchR ' scoring and scoring helper flags
Dim As Double ballDX, ballDY, a, snd
Dim As Long paddleY1, paddleY2 ' top and bottom line segment ends that are centers of circle
Dim As String s
f = _LoadFont("Arial.ttf", 32) ' everyone has Arial right?
_Font f

makeTableImg
makeLeftPaddle
makeRightpaddle
computerX = 45 ' as of now Computer AI is extremely simple, doesnt ever change x position
Do 'resets for serve
    TableTouchL = 0: TableTouchR = 0
    ballY = 300: ballX = TableR - BallR: ballDX = 0: ballDY = 0
    ' serve follows video of Rosy Demo, just drop ball on human side of table
    Do
        _PutImage , Table, 0 '                                     background table...
        _PrintString (100, 100), "Computer:" + Str$(computerPt) '  score update
        s = "Player:" + Str$(playerPt)
        _PrintString (1100 - _PrintWidth(s), 100), s

        ' player is RPaddle
        While _MouseInput: Wend '                   poll mouse status
        mx = _MouseX: my = _MouseY
        If mx > NetR + PaddleR Then '               keep player on his side of table
            If mx > TableR + PaddleR Then '         past end of table?
                playerX = mx: playerY = my
            Else '                                  allow .5 paddle below table
                If my < TableY Then playerX = mx: playerY = my
            End If
        End If
        _PutImage (playerX - PaddleR, playerY - 1.5 * PaddleR), RPaddle, 0

        ' computer opponent paddle: x is constant behind table edge y adjusted to ballY
        computerY = ballY + .5 * PaddleR + 5 '          so upper round part hits ball upward
        _PutImage (computerX - PaddleR, computerY - 1.5 * PaddleR), LPaddle, 0

        ' ball handling
        ballDY = ballDY + Gravity '                     gravity weighs ball down going up or down
        ballX = ballX + ballDX: ballY = ballY + ballDY

        ' collide player
        ' first check if it hit the flat edge of paddle calc the 2 endpoints of that line
        paddleY1 = playerY - .5 * PaddleR ' paddle top circle origin and line segment end
        paddleY2 = playerY + .5 * PaddleR
        If hitLine(ballX, ballY, BallR, playerX - PaddleR, paddleY1, playerX - PaddleR, paddleY2) Then ' ball hit line part of paddle
            ballDX = -ballDX ' the paddle line is straight up and down so x direction is reversed
            ballX = ballX + 2 * ballDX 'boost away
            TableTouchR = 0

            ' 2nd check if hit top circle of paddle
        ElseIf Sqr((ballX - playerX) ^ 2 + (ballY - paddleY1) ^ 2) < (BallR + PaddleR) And ballDX >= 0 Then
            Sound 230, 1
            a = _Atan2(ballY - paddleY1, ballX - playerX)
            ballDX = BallSpeed * Cos(a)
            ballDY = BallSpeed * Sin(a)
            ballX = ballX + 2 * ballDX ' boost
            ballY = ballY + 2 * ballDY
            TableTouchR = 0

            ' 3rd check if hit bottom circle of paddle
        ElseIf Sqr((ballX - playerX) ^ 2 + (ballY - paddleY2) ^ 2) < (BallR + PaddleR) And ballDX >= 0 Then
            a = _Atan2(ballY - paddleY2, ballX - playerX)
            ballDX = BallSpeed * Cos(a)
            ballDY = BallSpeed * Sin(a)
            ballX = ballX + 2 * ballDX ' boost
            ballY = ballY + 2 * ballDY
            TableTouchR = 0
        End If

        'collide with computer paddle
        ' first check if it hit the flat edge of paddle calc the 2 endpoints of that line
        paddleY1 = computerY - .5 * PaddleR ' paddle top circle origin and line segment end
        paddleY2 = computerY + .5 * PaddleR
        If hitLine(ballX, ballY, BallR, computerX + PaddleR, paddleY1, computerX + PaddleR, paddleY2) Then ' ball hit line part of paddle
            ballDX = -ballDX ' the paddle line is straight up and down so x direction is reversed
            ballX = ballX + 2 * ballDX 'boost away
            TableTouchL = 0

            ' 2nd check if hit top circle of paddle
        ElseIf Sqr((ballX - computerX) ^ 2 + (ballY - paddleY1) ^ 2) < (BallR + PaddleR) And ballDX <= 0 Then
            Sound 230, 1
            a = _Atan2(ballY - paddleY1, ballX - computerX)
            ballDX = BallSpeed * Cos(a)
            ballDY = BallSpeed * Sin(a)
            ballX = ballX + 2 * ballDX ' boost
            ballY = ballY + 2 * ballDY
            TableTouchL = 0

            ' 3rd check if hit bottom circle of paddle
        ElseIf Sqr((ballX - computerX) ^ 2 + (ballY - paddleY2) ^ 2) < (BallR + PaddleR) And ballDX <= 0 Then
            a = _Atan2(ballY - paddleY2, ballX - computerX)
            ballDX = BallSpeed * Cos(a)
            ballDY = BallSpeed * Sin(a)
            ballX = ballX + 2 * ballDX ' boost
            ballY = ballY + 2 * ballDY
            TableTouchL = 0
        End If

        ' collide net   vertical part
        If ballY + BallR > NetY Then
            If ballDX > 0 Then ' going towards player
                If ballX > NetL - BallR And ballX < NetR + BallR Then ' collide
                    For snd = 400 To 600 Step 10: Sound snd, .5: Next ' player pt
                    playerPt = playerPt + 1
                    fcirc ballX, ballY, BallR, &HFFFFFFFF
                    _Display
                    _Delay 1
                    Exit Do
                End If
            ElseIf ballDX < 0 Then ' going towards computer
                If ballX > NetL - BallR And ballX < NetR + BallR Then ' collide
                    For snd = 600 To 400 Step -10: Sound snd, .5: Next
                    computerPt = computerPt + 1
                    fcirc ballX, ballY, BallR, &HFFFFFFFF
                    _Display
                    _Delay 1
                    Exit Do
                End If
            End If
        End If

        ' collide table   very import to hit table on opponents side on serve and returns ie after paddleR collides
        If ballY + BallR > TableY And ((ballX > TableL) Or (ballX < TableR)) Then
            Sound 600, .25
            If ballX - BallR < NetL Then
                If TableTouchL = 0 And ballDX > 0 Then
                    For snd = 400 To 600 Step 10: Sound snd, .5: Next ' player pt
                    playerPt = playerPt + 1
                    fcirc ballX, ballY, BallR, &HFFFFFFFF
                    _Display
                    _Delay 1
                    Exit Do
                Else
                    TableTouchL = TableTouchL + 1
                End If
            ElseIf ballX + BallR > NetR Then
                If TableTouchR = 0 And ballDX < 0 Then
                    For snd = 600 To 400 Step -10: Sound snd, .5: Next
                    computerPt = computerPt + 1
                    fcirc ballX, ballY, BallR, &HFFFFFFFF
                    _Display
                    _Delay 1
                    Exit Do
                Else
                    TableTouchR = TableTouchR + 1
                End If
            End If
            ballY = TableY - BallR
            ballDY = -ballDY
        End If

        ' collide floor ?
        If ballY + BallR > Ymax Then
            If ballX + BallR < TableL Then
                If TableTouchL > 0 Then
                    For snd = 400 To 600 Step 10: Sound snd, .5: Next ' player pt
                    playerPt = playerPt + 1
                Else
                    computerPt = computerPt + 1
                    For snd = 600 To 400 Step -10: Sound snd, .5: Next
                End If
            ElseIf ballX - BallR > TableR Then
                If TableTouchR > 0 Then
                    For snd = 600 To 400 Step -10: Sound snd, .5: Next
                    computerPt = computerPt + 1
                Else
                    For snd = 400 To 600 Step 10: Sound snd, .5: Next ' player pt
                    playerPt = playerPt + 1
                End If
            End If
            Exit Do
        End If

        ' collide left boundry
        If ballX - BallR < 0 Then
            If TableTouchL > 0 Then
                For snd = 400 To 600 Step 10: Sound snd, .5: Next ' player pt
                playerPt = playerPt + 1
            Else
                For snd = 600 To 400 Step -10: Sound snd, .5: Next
                computerPt = computerPt + 1
            End If
            Exit Do
        ElseIf ballX + BallR > Xmax Then 'collide right boundary
            If TableTouchR > 0 Then
                For snd = 600 To 400 Step -10: Sound snd, .5: Next
                computerPt = computerPt + 1
            Else
                For snd = 400 To 600 Step 10: Sound snd, .5: Next ' player pt
                playerPt = playerPt + 1
            End If
            Exit Do
        End If
        fcirc ballX, ballY, BallR, &HFFFFFFFF
        _Display
        _Limit 60
    Loop
    _Delay 1
    If computerPt >= 21 Then
        _MessageBox "Sorry,", "The Computer out did you this game."
        computerPt = 0: playerPt = 0
    ElseIf playerPt >= 21 Then
        _MessageBox "Congrats!", "You beat the Computer."
        computerPt = 0: playerPt = 0
    End If
Loop

' ============================================================================== Code for this app

Sub makeLeftPaddle
    LPaddle = _NewImage(2 * PaddleR, 3 * PaddleR, 32)
    _Dest LPaddle
    Rectircle PaddleR - 1, 1.5 * PaddleR, 2 * PaddleR - 1, 3 * PaddleR - 1, PaddleR, &HFFBB6600, -1
    _Dest 0
End Sub

Sub makeRightpaddle
    RPaddle = _NewImage(2 * PaddleR, 3 * PaddleR, 32)
    _Dest RPaddle
    Rectircle PaddleR - 1, 1.5 * PaddleR, 2 * PaddleR - 1, 3 * PaddleR - 1, PaddleR, &HFFFFAA00, -1
    _Dest 0
End Sub

Sub makeTableImg
    Table = _NewImage(_Width, _Height, 32)
    _Dest Table
    Cls , &HFF000088
    Line (TableL, TableY)-(TableR, TableY + 20), &HFF008855, BF
    Line (TableL + 40, TableY + 20)-(TableL + 50, _Height), &HFF444444, BF
    Line (TableR - 50, TableY + 20)-(TableR - 40, _Height), &HFF444444, BF
    Line (NetL, NetY)-(NetR, TableY), &HFF444444, BF
    Line (NetL + 1, NetY)-(NetR - 1, NetY + 20), &HFFFFFFFF, BF
    _Dest 0
End Sub

' =========================================================================== from my Code Library

Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long) ' *** Gold standard for Circle Fill ***
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    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


' this sub uses Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long) ' this does not check raStart and raStop like arcC does
Sub Rectircle (cx, cy, w, h, r, c As _Unsigned Long, Fill) 'assume default single
    ' a Rectangle with arc circular corners
    ' cx, cy is the middle of the Squircle
    ' w, h = rectangle width and height
    ' r = radius of circular arc (as opposed to elliptical arc
    ' c is color
    'so r needs to be  < .5 * s ie if r = .5 * s then it's just a circle
    'likewise? if r = 0 then just a square
    Dim temp&, xo, yo, p, pd2, p32, xConst, yConst
    Static sd& ' so dont have to free image after each use
    sd& = _Dest ' save dest
    temp& = _NewImage(w + 1, h + 1, 32) ' create a drawing area  side of square
    _Dest temp&
    xo = w / 2: yo = h / 2 ' middles
    p = _Pi: pd2 = p / 2: p32 = p * 3 / 2
    xConst = .5 * (w - 2 * r) ' looks like this is first needed number to get the 4 origins for the arcs from xm y center
    yConst = .5 * (h - 2 * r)
    '4 arcs
    arc xo - xConst, yo - yConst, r, p, p32, c
    arc xo + xConst, yo - yConst, r, p32, 0, c
    arc xo + xConst, yo + yConst, r, 0, pd2, c
    arc xo - xConst, yo + yConst, r, pd2, p, c
    '4 lines
    Line (xo - xConst, yo - yConst - r)-(xo + xConst, yo - yConst - r), c
    Line (xo - xConst, yo + yConst + r)-(xo + xConst, yo + yConst + r), c
    Line (xo - xConst - r, yo - yConst)-(xo - xConst - r, yo + yConst), c
    Line (xo + xConst + r, yo - yConst)-(xo + xConst + r, yo + yConst), c
    If Fill Then Paint (xo, yo), c, c
    _Dest sd&
    _PutImage (cx - xo, cy - yo), temp&, sd&
End Sub

'use radians draw arc from Start to Stop Clockwise
Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long) ' this does not check raStart and raStop like arcC does
    Dim al, a
    'x, y origin, r = radius, c = color

    'raStart is first angle clockwise from due East = 0 degrees
    ' arc will start drawing there and clockwise until raStop angle reached

    If raStop < raStart Then
        arc x, y, r, raStart, _Pi(2), c
        arc x, y, r, 0, raStop, c
    Else
        ' modified to easier way suggested by Steve
        'Why was the line method not good? I forgot.
        al = _Pi * r * r * (raStop - raStart) / _Pi(2)
        For a = raStart To raStop Step 1 / al
            PSet (x + r * Cos(a), y + r * Sin(a)), c
        Next
    End If
End Sub

'from Rain Drain 3 check of hitLine Function
Function hitLine (CircleX, CircleY, CircleR, xx1, yy1, xx2, yy2) ' circle intersect line seg
    Dim x1, y1, x2, y2
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2 ' copy these values so they dont get changed with swap
    If x1 > x2 Then Swap x1, x2: Swap y1, y2
    If CircleX + CircleR < x1 Or CircleX - CircleR > x2 Then hitLine = 0: Exit Function
    If ((y2 - y1) / (x2 - x1)) * (CircleX - x1) + y1 - CircleR < CircleY And CircleY < ((y2 - y1) / (x2 - x1)) * (CircleX - x1) + y1 + CircleR Then
        hitLine = 1
    Else
        hitLine = 0
    End If
End Function