'Pongy - by SierraKen

'Made on October 30, 2024



'Thanks to the QB64 Phoenix Forum for the inspiration and past help.

'Thanks also to Chat GPT for the math code.



'How to play: Use Mouse to bounce the white ball and try to aim it toward the moving goal slot above without having the white ball hit the red ball.

'You start out with 5 balls. Feel free to change the variable ball number below to your needs.





begin:

score = 0

ball = 5



' Set box boundaries

boxLeft = 25

boxRight = 775

boxTop = 25

boxBottom = 575





Cls

Screen _NewImage(800, 600, 32)

' Ball properties

Dim As Integer ballX, ballY, ballx2, bally2

Dim As Single angle, angle2

Dim As Integer speedX, speedY, speedx2, speedy2

ballX = (boxRight + boxLeft) / 2 ' Start in the center

ballY = (boxTop + boxBottom) / 2

angle = 45 ' Starting angle in degrees



ballx2 = (boxRight + boxLeft) / 2 ' Start in the center

bally2 = (boxTop + boxBottom) / 2 + 100

angle2 = 45 ' Starting angle in degrees





' Convert angle to radians

Dim As Single radAngle

radAngle = angle * 3.14159265 / 180



Dim As Single radAngle2

radAngle2 = angle2 * 3.14159265 / 180







' Set speed based on angle

speedX = Cos(radAngle) * 5

speedY = Sin(radAngle) * 5



speedx2 = Cos(radAngle2) * 5

speedy2 = Sin(radAngle2) * 5



goalx = 325: goaly = 20

goaldir = 1

redballout = 5





_Title "Pongy - by SierraKen"



Randomize Timer



Do

    Cls

    a$ = InKey$

    If a$ = Chr$(27) Then End

    ' Draw box boundaries

    Line (boxLeft - 5, boxTop - 5)-(boxRight + 5, boxBottom + 5), _RGB32(255, 255, 255), B

    Line (goalx, goaly)-(goalx + 100, goaly), _RGB32(1, 1, 1)

    goalx = goalx + goaldir

    If goalx = 680 And goaldir = 1 Then goaldir = -1

    If goalx = 20 And goaldir = -1 Then goaldir = 1

    ' Draw the ball

    fillCircle ballX, ballY, 10, _RGB32(255, 255, 255)

    If redballout = 0 Then fillCircle ballx2, bally2, 20, _RGB32(255, 0, 0)



    While _MouseInput: Wend

    mouseX = _MouseX

    mouseY = _MouseY

    fillCircle mouseX, mouseY, 20, _RGB32(0, 255, 0)



    ' Update ball position

    ballX = ballX + speedX

    ballY = ballY + speedY

    If redballout = 0 Then

        ballx2 = ballx2 + speedx2

        bally2 = bally2 + speedy2

    End If

    If ballX > goalx And ballX < goalx + 100 And ballY < 26 Then

        score = score + 1: ballX = 375: ballY = 275: speedY = -speedY

        For snd = 300 To 900 Step 50

            Sound snd, .5

        Next snd

    End If



    Locate 1, 20: Print "Score: "; score

    Locate 1, 70: Print "Balls: "; ball



    ' Check for collision with box boundaries

    If ballX <= boxLeft Or ballX >= boxRight Then

        speedX = -speedX ' Reflect on the X axis

        If redballout > 0 Then redballout = redballout - 1

        Sound 600, .5

    End If

    If ballY <= boxTop Or ballY >= boxBottom Then

        speedY = -speedY ' Reflect on the Y axis

        If redballout > 0 Then redballout = redballout - 1

        Sound 600, .5

    End If

    If ballY > boxBottom + .4 Then ballY = boxBottom - 7

    If ballY < boxTop - .4 Then ballY = boxTop + 7

    If ballX > boxRight + .4 Then ballX = boxRight - 7

    If ballX < boxLeft - .4 Then ballX = boxLeft + 7

    If redballout > 0 Then GoTo skip:

    If ballx2 <= boxLeft Or ballx2 >= boxRight Then

        speedx2 = -speedx2 ' Reflect on the X axis

        Sound 600, .5

    End If

    If bally2 <= boxTop Or bally2 >= boxBottom Then

        speedy2 = -speedy2 ' Reflect on the Y axis

        Sound 600, .5

    End If

    If bally2 > boxBottom + .4 Then bally2 = boxBottom - 7

    If bally2 < boxTop - .4 Then bally2 = boxTop + 7

    If ballx2 > boxRight + .4 Then ballx2 = boxRight - 7

    If ballx2 < boxLeft - .4 Then ballx2 = boxLeft + 7

    skip:



    ' Check for collision with mouse position

    If Sqr((mouseX - ballX) ^ 2 + (mouseY - ballY) ^ 2) < 40 Then

        ' Calculate deflection angle

        radAngle = _Atan2(ballY - mouseY, ballX - mouseX) ' * 180 / 3.14159265

        'radAngle = angle * 3.14159265 / 180

        speedX = Cos(radAngle) * 5

        speedY = Sin(radAngle) * 5

        ballX = ballX + speedX

        ballY = ballY + speedY

        Sound 600, .5

    End If



    ' Check for collision between red ball and white ball.

    If redballout > 0 Then GoTo skip2:

    If Sqr((ballx2 - ballX) ^ 2 + (bally2 - ballY) ^ 2) < 50 Then

        fillCircle ballX, ballY, 20, _RGB32(0, 0, 0)

        snd = 300

        _AutoDisplay

        starx = ballX: stary = ballY

        For t = 1 To 25

            fillCircle starx, stary, t * 5, _RGB32(255, 255, 255)

            Sound snd - t, .5

        Next t

        redballout = 5

        Locate 1, 70: ball = ball - 1: Print "Balls: "; ball

        If ball = 0 Then

            _AutoDisplay

            Locate 20, 40: Print "G A M E  O V E R":

            Locate 25, 40

            Print "Again (Y/N)?"

            ask:

            ag$ = InKey$

            If ag$ = "y" Or ag$ = "Y" Then GoTo begin:

            If ag$ = "n" Or ag$ = "N" Then End

            GoTo ask:

        End If

        Sound 600, .5

    End If

    skip2:



    _Display

    _Limit 60 ' Limit the speed of the loop to 60 FPS

Loop Until InKey$ <> ""





'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

Quote:At the same time, don't let the white ball hit the red ball or it will explode.

(11-02-2024, 05:25 PM)bplus Wrote: ...

@SierraKen so now Charlie's got his clone going in BAM, you are officially recognized

(11-02-2024, 08:16 PM)SierraKen Wrote: LOL Thanks guys.

---

I don't know what BAM is though? Last night I ported it to QBJS (without sound). The QBJS guy is looking into the SOUND problem though.