Profile Pong Game Development

[bplus]

Version 2-2 some more refinements and fixes:

Code: (Select All)

Option _Explicit
_Title "Profile Pong 2-2" ' 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.
'2023-02-03 2-2 OK attempt to make the computer a little harder to beat. ParkCompterY will keep
' computers paddle parked until the ball hits it's side of the table, then it will spring to
' action, so no more freebee points if you hit it out of ball park.
' Fix problem when last player to hit ball hits backwards like in a serve, should lose
' a point not get one! Now checking lastToHit variable and assigned Computer and Player
' Constants. Now a problem when player lobs just past table and hits computer paddle.
' Computer needs to really duck or fly! Fixed after ball crosses net computer stays above it
' until it hits table, then it gets in position to return.

'                       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
Const Player = 1 '                  for scoring properly
Const Computer = 2 '                need to know who hit ball last

Dim Shared As Long Table, LPaddle, RPaddle ' images shared so can be made in isolated subs once
Dim Shared ballX, ballY
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, computerX, computerY, parkComputerY ' locating
Dim As Long playerPt, computerPt, tableTouchL, tableTouchR, lastToHit ' scoring and scoring helpers
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 = TableL - PaddleR - 3 ' as of now Computer doesnt ever change x position

parkComputerY = TableY - 6 * PaddleR

Do 'resets for serve
    tableTouchL = 0: tableTouchR = 0 ' for serving
    computerY = parkComputerY
    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 Paddle
        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
        Else
            If my < TableY Then playerY = my ' OK let me move in Y direction
        End If
        _PutImage (playerX - PaddleR, playerY - 1.5 * PaddleR), RPaddle, 0
        makeEyes playerX, playerY

        ' Computer x is constant behind table edge y adjusted to ballY             Computer paddle
        If tableTouchL = 0 Then
            If ballX < NetL Then computerY = ballY - 3 * PaddleR Else computerY = parkComputerY
        Else
            computerY = ballY + .5 * PaddleR + 5 '          so upper round part hits ball upward
        End If
        _PutImage (computerX - PaddleR, computerY - 1.5 * PaddleR), LPaddle, 0
        makeEyes computerX, computerY

        '                                                                            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

            ballDX = -ballDX ' the paddle line is straight up and down so x direction is reversed
            ballX = ballX + 2 * ballDX 'boost away
            lastToHit = Player
            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
            lastToHit = Player
            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
            lastToHit = Player
            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

            ballDX = -ballDX ' the paddle line is straight up and down so x direction is reversed
            ballX = ballX + 2 * ballDX 'boost away
            lastToHit = Computer
            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
            lastToHit = Computer
            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
            lastToHit = Computer
            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
                    GoSub player
                    Exit Do
                End If
            ElseIf ballDX < 0 Then ' going towards computer
                If ballX > NetL - BallR And ballX < NetR + BallR Then ' collide
                    GoSub computer
                    Exit Do
                End If
            End If
        End If

        ' collide table   very import to hit table on opponents side on serve and returns
        'If ballY + BallR > TableY And ((ballX > TableL) Or (ballX < TableR)) Then ' why the OR ???
        If (((ballY + BallR) > TableY) And (ballX > TableL)) And (ballX < TableR) Then
            Sound 600, .25
            If (ballX - BallR) < NetL Then
                If tableTouchL = 0 And ballDX > 0 Then
                    GoSub player
                    Exit Do
                Else
                    tableTouchL = tableTouchL + 1
                End If
            ElseIf (ballX - BallR) > NetR Then
                If tableTouchR = 0 And ballDX < 0 Then
                    GoSub computer
                    Exit Do
                Else
                    tableTouchR = tableTouchR + 1
                End If
            End If
            ballY = TableY - BallR
            ballDY = -ballDY
        End If

        ' collide floor ?   I doubt this ever happens
        If ballY + BallR > Ymax Then
            If ballX + BallR < TableL Then
                If (tableTouchL > 0 And lastToHit = Player) Or (lastToHit = Computer) Then
                    GoSub player
                Else
                    GoSub computer
                End If
            ElseIf ballX - BallR > TableR Then
                If (tableTouchR > 0 And lastToHit = Computer) Or (lastToHit = Player) Then
                    GoSub computer
                Else
                    GoSub player
                End If
            End If
            Exit Do
        End If

        ' collide left boundry
        If ballX - BallR < 0 Then
            If (tableTouchL > 0) And (lastToHit = Player) Then
                GoSub player
            ElseIf lastToHit = Computer Then
                GoSub player
            ElseIf ((tableTouchL = 0) And (lastToHit = Player)) Then ' player hit to far
                GoSub computer
            End If
            Exit Do
        ElseIf ballX + BallR > Xmax Then 'collide right boundary
            If (tableTouchR > 0 And lastToHit = Computer) Or (lastToHit = Player) Then
                GoSub computer
            Else ' computer hit too far
                GoSub player
            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
End

player:
For snd = 400 To 800 Step 20: Sound snd, .5: Next ' player pt
playerPt = playerPt + 1
makeSmile playerX, playerY
makeFrown computerX, computerY
fcirc ballX, ballY, BallR, &HFFFFFFFF
_Display
_Delay 1
Return

computer:
For snd = 800 To 400 Step -20: Sound snd, .5: Next
computerPt = computerPt + 1
makeSmile computerX, computerY
makeFrown playerX, playerY
fcirc ballX, ballY, BallR, &HFFFFFFFF
_Display
_Delay 1
Return

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

Sub makeSmile (x, y)
    arc x, y, 23, _D2R(55), _D2R(125), &HFFFF0000
    arc x, y, 24, _D2R(55), _D2R(125), &HFFFF0000
End Sub

Sub makeFrown (x, y)
    arc x, y + 46, 23, _D2R(240), _D2R(300), &HFFFF0000
    arc x, y + 46, 22, _D2R(240), _D2R(300), &HFFFF0000
End Sub

Sub makeEyes (x, y)
    Dim a
    fcirc x - 10, y, 8, &HFFFFFFFF
    fcirc x + 10, y, 8, &HFFFFFFFF
    a = _Atan2(ballY - y, ballX - (x - 10))
    fcirc x - 10 + 2.5 * Cos(a), y + 2.5 * Sin(a), 3, &HFF000000
    a = _Atan2(ballY - y, ballX - (x + 10))
    fcirc x + 10 + 2.5 * Cos(a), y + 2.5 * Sin(a), 3, &HFF000000
    Line (x - 3, y + 23)-Step(6, 2), &HFFFF0000, BF
End Sub

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
    yConst = .5 * (h - 2 * r) '             to get the 4 origins for the arcs from xm y center
    '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
' this does not check raStart and raStop like arcC does
Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long)
    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

Oh yeah, PLUS some fun!