02-04-2023, 08:43 PM
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
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
b = b + ...