Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
02-04-2023, 08:30 PM
(This post was last modified: 02-04-2023, 08:55 PM by bplus.)
Ever since I saw Rosy's video at RCBasic (where I lurk) I have been meaning to do a version in QB64.
We all know the Classic Pong and this Perspective is very amusing, to me any way!
Rosy's video, just click into it about halfway through and watch until you get an idea how it should go...
https://www.youtube.com/watch?v=jfod2O5Oq7s
I thought I'd show the evolution of my version of development over last couple of days.
So here, my starter I just get started on images and some basic ball handling:
Code: (Select All) Option _Explicit
_Title "Profile Pong 0-1" ' b+ 2023-02-01 started inspired by Rosy game at RCBasic
Const Xmax = 1200, Ymax = 700, PaddleR = 30, BallR = 5, TableL = 100, TableR = 1100
Const TableY = Ymax - 80
Const NetY = TableY - 40
Const NetL = 598
Const NetR = 602
Const Gravity = .1
Const BallSpeed = 8
Dim Shared As Long Table, LPaddle, RPaddle ' images
Screen _NewImage(Xmax, Ymax, 32)
_ScreenMove 0, 0 ' <<<<<<< you may want different
Dim As Long mx, my, playerX, playerY, ballX, ballY, computerX, computerY, playerPt, computerPt, flagPt
Dim As Double ballDX, ballDY, a
makeTableImg
makeLeftPaddle
makeRightpaddle
computerX = 50
Do
flagPt = 0
ballY = 300: ballX = TableR - BallR: ballDX = .01
Do
_PutImage , Table, 0
_PrintString (100, 100), "Computer:" + Str$(computerPt)
_PrintString (1100 - _PrintWidth("Player:" + Str$(playerPt)), 100), "Player:" + Str$(playerPt)
' player is RPaddle
10 If _MouseInput Then GoTo 10
mx = _MouseX: my = _MouseY
If mx > NetR + PaddleR Then
If mx > 1100 + PaddleR Then
playerX = mx: playerY = my
Else
If my + PaddleR < TableY Then playerX = mx: playerY = my
End If
End If
_PutImage (playerX - PaddleR, playerY - PaddleR)-Step(PaddleR, 2 * PaddleR), RPaddle, 0
' computer opponent
computerY = ballY + 5
_PutImage (computerX, computerY - PaddleR)-Step(PaddleR, 2 * PaddleR), LPaddle, 0
' ball handling
ballDY = ballDY + Gravity
ballX = ballX + ballDX: ballY = ballY + ballDY
' collide player
If Sqr((ballX - playerX) ^ 2 + (ballY - playerY) ^ 2) < (BallR + PaddleR) And ballDX > 0 Then
a = _Atan2(ballY - playerY, ballX - playerX)
ballDX = BallSpeed * Cos(a)
ballDY = BallSpeed * Sin(a)
ballX = ballX + 2 * ballDX ' boost
ballY = ballY + 2 * ballDY
End If
' collide computer
If Sqr((ballX - computerX) ^ 2 + (ballY - computerY) ^ 2) < (BallR + PaddleR) And ballDX < 0 Then
a = _Atan2(ballY - computerY, ballX - computerX)
ballDX = BallSpeed * Cos(a)
ballDY = BallSpeed * Sin(a)
ballX = ballX + 2 * ballDX ' boost
ballY = ballY + 2 * ballDY
End If
' collide net
If ballY + BallR > NetY Then
If ballDX > 0 Then ' going towards player
If ballX > NetL - BallR And ballX < NetR + BallR Then ' collide
playerPt = playerPt + 1
flagPt = 1
fcirc ballX, ballY, BallR, &HFFFFFFFF
_Display
_Delay 1
End If
Else ' going towards computer
If ballX > NetL - BallR And ballX < NetR + BallR Then ' collide
computerPt = computerPt + 1
flagPt = 1
fcirc ballX, ballY, BallR, &HFFFFFFFF
_Display
_Delay 1
End If
End If
End If
' collide table
If ballY + BallR > TableY And ((ballX > TableL) Or (ballX < TableR)) Then
ballY = TableY - BallR
ballDY = -ballDY
End If
' collide floor
If ballY + BallR > Ymax Then
If ballX + BallR < TableL Then
playerPt = playerPt + 1
flagPt = 1
ElseIf ballX - BallR > TableR Then
computerPt = computerPt + 1
flagPt = 1
End If
End If
' collide left
If ballX - BallR < 0 Then
playerPt = playerPt + 1
flagPt = 1
ElseIf ballX + BallR > Xmax Then 'collide right
computerPt = computerPt + 1
flagPt = 1
End If
fcirc ballX, ballY, BallR, &HFFFFFFFF
_Display
_Limit 60
Loop Until flagPt
_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
Sub makeLeftPaddle
LPaddle = _NewImage(PaddleR, 2 * PaddleR, 32)
_Dest LPaddle
fcirc -1, PaddleR, PaddleR, &HFFBB6600
_Dest 0
End Sub
Sub makeRightpaddle
RPaddle = _NewImage(PaddleR, 2 * PaddleR, 32)
_Dest RPaddle
fcirc PaddleR, PaddleR, PaddleR, &HFFFFAA00
_Dest 0
End Sub
Sub makeTableImg
Table = _NewImage(_Width, _Height, 32)
_Dest Table
Cls
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
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
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
b = b + ...
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
I tighten up game to rules of Pong and show code to Johnno because I was curious about RCBasic and Rosy.
Code: (Select All) Option _Explicit
_Title "Profile Pong 1.1" ' 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.
' Rules of Profile Ping Pong (now in effect):
' On your serve or return you must not bounce again on your side of the table.
' You must bounce on the opponents side unless opponent chooses not 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 rule and saves the
' players butt many a time!)
Const Xmax = 1200, Ymax = 700, PaddleR = 30, BallR = 5, TableL = 100, TableR = 1100
Const TableY = Ymax - 80
Const NetY = TableY - 40
Const NetL = 598
Const NetR = 602
Const Gravity = .1
Const BallSpeed = 8
Dim Shared As Long Table, LPaddle, RPaddle ' images
Screen _NewImage(Xmax, Ymax, 32)
_ScreenMove 0, 0 ' <<<<<<< you may want different
Dim As Long 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
makeTableImg
makeLeftPaddle
makeRightpaddle
computerX = 50
Do 'resets for serve
TableTouchL = 0: TableTouchR = 0
ballY = 300: ballX = TableR - BallR: ballDX = 0: ballDY = 0
Do
_PutImage , Table, 0
_PrintString (100, 100), "Computer:" + Str$(computerPt)
_PrintString (1100 - _PrintWidth("Player:" + Str$(playerPt)), 100), "Player:" + Str$(playerPt)
' player is RPaddle
10 If _MouseInput Then GoTo 10
mx = _MouseX: my = _MouseY
If mx > NetR + PaddleR Then
If mx > 1100 + PaddleR Then
playerX = mx: playerY = my
Else
If my + PaddleR < TableY Then playerX = mx: playerY = my
End If
End If
_PutImage (playerX - PaddleR, playerY - PaddleR)-Step(PaddleR, 2 * PaddleR), RPaddle, 0
' computer opponent
computerY = ballY + 5
_PutImage (computerX, computerY - PaddleR)-Step(PaddleR, 2 * PaddleR), LPaddle, 0
' ball handling
ballDY = ballDY + Gravity
ballX = ballX + ballDX: ballY = ballY + ballDY
' collide player
If Sqr((ballX - playerX) ^ 2 + (ballY - playerY) ^ 2) < (BallR + PaddleR) And ballDX >= 0 Then
Sound 230, 1
a = _Atan2(ballY - playerY, ballX - playerX)
ballDX = BallSpeed * Cos(a)
ballDY = BallSpeed * Sin(a)
ballX = ballX + 2 * ballDX ' boost
ballY = ballY + 2 * ballDY
TableTouchR = 0
End If
' collide computer
If Sqr((ballX - computerX) ^ 2 + (ballY - computerY) ^ 2) < (BallR + PaddleR) And ballDX <= 0 Then
Sound 230, 1
a = _Atan2(ballY - computerY, 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
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
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
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
Sub makeLeftPaddle
LPaddle = _NewImage(PaddleR, 2 * PaddleR, 32)
_Dest LPaddle
fcirc -1, PaddleR, PaddleR, &HFFBB6600
_Dest 0
End Sub
Sub makeRightpaddle
RPaddle = _NewImage(PaddleR, 2 * PaddleR, 32)
_Dest RPaddle
fcirc PaddleR, PaddleR, PaddleR, &HFFFFAA00
_Dest 0
End Sub
Sub makeTableImg
Table = _NewImage(_Width, _Height, 32)
_Dest Table
Cls
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
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
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
Johnno made the usual comments too hard and not Blue LOL so
version 1-2
Code: (Select All) Option _Explicit
_Title "Profile Pong 1-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...
' Rules of Profile Ping Pong (now in effect):
' On your serve or return you must not bounce again on your side of the table.
' You must bounce on the opponents side unless opponent chooses not 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 rule and saves the
' players butt many a time!)
Const Xmax = 1200, Ymax = 700, PaddleR = 50, BallR = 5, TableL = 100, TableR = 1100
Const TableY = Ymax - 80
Const NetY = TableY - 40
Const NetL = 598
Const NetR = 602
Const Gravity = .1
Const BallSpeed = 8
Dim Shared As Long Table, LPaddle, RPaddle ' images
Screen _NewImage(Xmax, Ymax, 32)
_ScreenMove 0, 0 ' <<<<<<< you may want different
_PrintMode _KeepBackground
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
f = _LoadFont("Arial.ttf", 32) ' everyone has Arial right?
_Font f
makeTableImg
makeLeftPaddle
makeRightpaddle
computerX = 45
Do 'resets for serve
TableTouchL = 0: TableTouchR = 0
ballY = 300: ballX = TableR - BallR: ballDX = 0: ballDY = 0
Do
_PutImage , Table, 0
_PrintString (100, 100), "Computer:" + Str$(computerPt)
_PrintString (1100 - _PrintWidth("Player:" + Str$(playerPt)), 100), "Player:" + Str$(playerPt)
' player is RPaddle
10 If _MouseInput Then GoTo 10
mx = _MouseX: my = _MouseY
If mx > NetR + PaddleR Then
If mx > TableR + PaddleR Then
playerX = mx: playerY = my
Else
If my < TableY Then playerX = mx: playerY = my
End If
End If
_PutImage (playerX - PaddleR, playerY - PaddleR)-Step(PaddleR, 2 * PaddleR), RPaddle, 0
' computer opponent
computerY = ballY + 5
_PutImage (computerX, computerY - PaddleR)-Step(PaddleR, 2 * PaddleR), LPaddle, 0
' ball handling
ballDY = ballDY + Gravity
ballX = ballX + ballDX: ballY = ballY + ballDY
' collide player
If Sqr((ballX - playerX) ^ 2 + (ballY - playerY) ^ 2) < (BallR + PaddleR) And ballDX >= 0 Then
Sound 230, 1
a = _Atan2(ballY - playerY, ballX - playerX)
ballDX = BallSpeed * Cos(a)
ballDY = BallSpeed * Sin(a)
ballX = ballX + 2 * ballDX ' boost
ballY = ballY + 2 * ballDY
TableTouchR = 0
End If
' collide computer
If Sqr((ballX - computerX) ^ 2 + (ballY - computerY) ^ 2) < (BallR + PaddleR) And ballDX <= 0 Then
Sound 230, 1
a = _Atan2(ballY - computerY, 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
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
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
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
Sub makeLeftPaddle
LPaddle = _NewImage(PaddleR, 2 * PaddleR, 32)
_Dest LPaddle
fcirc -1, PaddleR, PaddleR, &HFFBB6600
_Dest 0
End Sub
Sub makeRightpaddle
RPaddle = _NewImage(PaddleR, 2 * PaddleR, 32)
_Dest RPaddle
fcirc PaddleR, PaddleR, PaddleR, &HFFFFAA00
_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
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
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
b = b + ...
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
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
b = b + ...
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
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!
b = b + ...
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
02-04-2023, 08:51 PM
(This post was last modified: 02-04-2023, 08:58 PM by bplus.)
Just fix one little weakness the computer has and it should be more challenging to beat.
I test this idea adding just a couple more lines to Computer Paddle positioning for version 2-3
Code: (Select All) Option _Explicit
_Title "Profile Pong 2-3" ' 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.
'2023-02-04 2-3 Advancements from here will mostly concern AI today I have 2 Stages to outline:
' 1. Adjust height of Computer paddle to ballY AND distance from table
' a. When ballY is low to table Computer consistently fails to arc high enough to get over the net.
' Probably the #1 cause of lost points for computer.
' b. Maybe there is a height high enough that computer can use flat part of paddle or even the
' underside
' 2. Summary we save moving ComputerX for Stage 2 and can 'rush' the net.
' Maybe add some sound effects or images if anyone offers sharable items.
' Wouldn't it be interesting to do a ballistics study and plug in results/lessons/foruma for only
' a few new lines for Computer Paddle move. Not needed, it seems.
' WOW I just made one gross adjustment to ComputerY Paddle height according to ball distance to
' table and made this a very hard game for Player to score!
' I am done for now with Profile Pong with this version, 2-3.
' 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. Version 2-2 and above AI will not attempt a return until players serve or
' return hits its side of 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 and centers of circle ends
Dim As String s ' score string fitting _printstring command on one line, one call to _PrintWidth
f = _LoadFont("Arial.ttf", 32) ' everyone has Arial right?
_Font f
makeTableImg ' background and table, CLS with it
makeLeftPaddle ' Rectircle!
makeRightpaddle ' Rectircle!
computerX = TableL - PaddleR - 3 ' as of now, ComputerX doesnt ever change x position
parkComputerY = TableY - 6 * PaddleR ' keeping Computer paddle above board out of trouble
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
'version 2-3 needs to adjust paddle height to ball height from table
If ballY > NetY - 3 * PaddleR Then
computerY = ballY + .5 * PaddleR + 20 ' <<<<<<<< version 2-3 new line unbeatable
Else
computerY = ballY + .5 * PaddleR + 5 ' so upper round part hits ball upward
End If
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
And I can't even come close to beating it anymore.
I was all set to work on a ballistic study today, but the one change was it!
I am done for now, LOL
b = b + ...
Posts: 1,709
Threads: 63
Joined: Jul 2022
Reputation:
52
The two characters in the game are cute, look like peanuts or rather, like individual members of M&M Peanuts bag. The supermarket near my home has loads of the "family size" bags but I cannot buy it. Last year I became alergic to peanuts. It's a long story so I'm not going to bore anyone else here telling it.
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
02-04-2023, 10:03 PM
(This post was last modified: 02-04-2023, 10:06 PM by bplus.)
Or maybe smileys that got squeezed alittle.
I am nicknaming you Brooke, I dislike typing mnrvovrfc, sorry.
b = b + ...
Posts: 1,709
Threads: 63
Joined: Jul 2022
Reputation:
52
(02-04-2023, 10:03 PM)bplus Wrote: I am nicknaming you Brooke, I dislike typing mnrvovrfc, sorry.
Shields?
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
02-05-2023, 12:01 AM
(This post was last modified: 02-05-2023, 12:02 AM by bplus.)
Fishing streams  kinda goes with your latest signature.
b = b + ...
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
Rats:
Quote:Legal Service (Ping Pong)
The ball must rest on an open hand palm.
Then it must be tossed up at least 6 inches and struck
so the ball first bounces on the server's side and then
the opponent's side. If the serve is legal except that
it touches the net, it is called a let serve.
Well I must be thinking of tennis. They do call it table tennis after all.
b = b + ...
|
