05-25-2022, 08:07 PM
I made a quick fix to make it easier after you win or lose and want to play again that you have enough time to look at the ball by going to the welcome screen instead.
Code: (Select All)
'Pong Clone by SierraKen - May 25, 2022.
'Thank you to B+ for the deflection math code!
_Title "Pong Clone - by SierraKen"
Screen _NewImage(800, 600, 32)
begin:
Cls
Locate 4, 35: Print "P O N G C L O N E"
Locate 7, 44: Print "By SierraKen"
Locate 10, 44: Print "With help by B+"
Locate 15, 25: Print "Use your mouse to control the round paddle on the right side."
Locate 16, 25: Print "First one to reach 10 points wins."
Locate 20, 37: Print "Press Mouse Button To Begin."
Do
While _MouseInput: Wend
If _MouseButton(1) = -1 Then GoTo begin2:
Loop
begin2:
Randomize Timer
' these remain constant
px = 350: py = 250: pr = 5: pc = _RGB32(0, 255, 0) ' <<<< lets label everything of puck with p
speed = 7 ' really keeping puck at constant speed
cx = 100: cy = 300: cr = 25: cc = _RGB32(255, 0, 0) 'Computer Racket
mx = 700: mr = 25: mc = _RGB32(255, 0, 0) ' <<<< evrything mouse starts with m , use different radius for mouse - Your Racket
score = 0
cscore = 0
start:
px = 400: py = 300
Cls
angle:
pa = _Pi(2) * Rnd ' pa = puck angle this is rnd times all directions 0 to 360 in degrees 0 to 2*pi in radians
ang = _R2D(pa)
If ang > 85 And ang < 95 Then GoTo angle:
If ang > 265 And ang < 275 Then GoTo angle:
Do
Cls ' Clear our work and recalulate and redraw everything
Line (25, 25)-(775, 25), _RGB32(255, 255, 255)
Line (25, 575)-(775, 575), _RGB32(255, 255, 255)
For nety = 25 To 575 Step 20
Line (400, nety)-(400, nety + 10), _RGB32(255, 255, 255)
Next nety
Locate 1, 10: Print " Computer: "; cscore
Locate 1, 78: Print " You: "; score
If cscore = 10 Then
_AutoDisplay
Cls
Locate 5, 40
Print "You Lose!"
Locate 10, 40
Print "Again (Y/N)?";
again:
ag$ = InKey$
If ag$ = "y" Or ag$ = "Y" Then GoTo begin:
If ag$ = "n" Or ag$ = "N" Or ag$ = Chr$(27) Then End
GoTo again
End If
If score = 10 Then
_AutoDisplay
Cls
Locate 5, 20
Print "You Win!"
Locate 10, 20
Print "Again (Y/N)?";
again2:
ag2$ = InKey$
If ag2$ = "y" Or ag2$ = "Y" Then GoTo begin:
If ag2$ = "n" Or ag2$ = "N" Or ag2$ = Chr$(27) Then End
GoTo again2
End If
a$ = InKey$
If a$ = " " Then GoTo start:
If a$ = Chr$(27) Then End
While _MouseInput: Wend ' better way to poll mouse and label mouse x, y as mx, my like everyone else
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
If py > cy Then
cdist = py - cy
cy = cy + cdist / 6.25
End If
If py < cy Then
cdist = cy - py
cy = cy - cdist / 6.25
End If
fillCircle cx, cy, cr, cc
If Sqr((cx - px) ^ 2 + (cy - py) ^ 2) < (pr + cr) Then ' (pr + pr2) to (r + rr) collision!
pa = _Atan2(py - cy, px - cx) ' 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 (cx, cy)-(px, py), &HFFFFFFFF
_Display
_Delay .1
End If
'keep puck out of wall = wall boundary +- radius of puck
If px > 775 Then cscore = cscore + 1: _Delay .25: GoTo start:
If px < 25 Then score = score + 1: _Delay .25: GoTo start:
If py > 575 - pr Then pa = -pa: py = 575 - pr ' move puck out of wall !!!
If py < 25 + pr Then pa = -pa: py = 25 + 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