RE: Profile Pong Game Development - bplus - 10-27-2024
OK @SierraKen the Computer now has a hard time returning your wicked serve ![Wink Wink](https://qb64phoenix.com/forum/images/smilies/wink.png)
Not only is Computer handicapped, the game is played to 11 Points not 21.
Plus I gave the player more space @PhilOfPerth
I like these changes.
Code: (Select All) Option _Explicit
_Title "Profile Pong 4-0" ' b+ 2023-02-01 started inspired by Rosy game at RCBasic
' 2024-10-27 4-0 Starting with version 3-0
' widen screen for more room for player
' make mouth more visible
' DUMB Down Computer
' Play to 11 not 21
' Thank you Ken for reviving interest in this game :)
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Rules of Profile Ping Pong (now in effect):
' Ping Pong Legal Service:
' The ball must be struck so the ball first bounces on the server's side and then the
' opponent's side. Version 2-4
' On your 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 on his side of table.
' 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 = 1280, Ymax = 700 ' screen size
Const PaddleR = 44, 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
Const Server = 3 ' track serve hits right side first
Dim Shared As Long Table ' background image handle
Dim Shared As Long PlayerX, PlayerY ' locating
Dim Shared As Long ComputerX, ComputerY
Dim Shared As Long BallX, BallY
Dim Shared As Double BallDX, BallDY ' ball direction
Dim Shared As Long LastToHit ' scoring helper flags
Dim Shared As Long TouchL, TouchR
Screen _NewImage(Xmax, Ymax, 32) ' Game QB Settings
_ScreenMove 0, 20 ' <<< you may want different, for my screen it is almost middle
_MouseHide
Dim As Long mx, my, parkComputerY ' locating
Dim As Long playerPt, computerPt ' scoring and scoring helpers
Dim As Double snd ' freq for making sounds
Dim As String s ' temp string for scores
_Font _LoadFont("Arial.ttf", 32) ' everyone has Arial right?
MakeTableImg ' draw table image
ComputerX = TableL - PaddleR - 3 ' as of now, ComputerX doesnt ever change x position
parkComputerY = TableY - 3 * PaddleR ' keeping ComputerY paddle above board out of trouble
Do '
' Serve similar to Rosy Demo Video, just drops ball on human side of table
TouchL = 0: TouchR = 0: LastToHit = Server: ComputerY = parkComputerY ' resets for serve
BallY = 550: BallX = TableR - BallR: BallDX = 0: BallDY = 0
Do ' one round of play loop until a point is scored
Cls
_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
PlayerX = mx: PlayerY = my
Else
PlayerY = my ' OK let me move in Y direction at least
End If
FCirc PlayerX, PlayerY, PaddleR, &HFF00BB00
MakeEyes PlayerX, PlayerY
' Computer x is constant behind table edge y adjusted to ballY Computer Paddle
If TouchL = 0 Then
If BallX < NetL Then ComputerY = BallY - 3 * PaddleR Else ComputerY = parkComputerY
Else
If BallY > NetY - 3 * PaddleR Then ' dumb down with Rnd!!!
ComputerY = BallY + 20 + Rnd * 20 - 15 ' this is pure guess!!! Thank you gravity!
Else
ComputerY = BallY + 5 + Rnd * 20 - 15 ' so upper round part of paddle hits ball upward
End If
End If
FCirc ComputerX, ComputerY, PaddleR, &HFFBB4400
MakeEyes ComputerX, ComputerY
' ball handling
BallDY = BallDY + Gravity ' gravity weighs ball down going up or down
BallX = BallX + BallDX: BallY = BallY + BallDY
PaddleCollisions ' check if ball collides with either opponents paddle
' 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 GoSub player: Exit Do
ElseIf BallDX < 0 Then ' going towards computer
If BallX > NetL - BallR And BallX < NetR + BallR Then GoSub computer: Exit Do
End If
End If
' collide table very important to hit table on opponents side on returns
If (((BallY + BallR) > TableY) And (BallX > TableL)) And (BallX < TableR) Then
Sound 600, .25
If (BallX - BallR) < NetL Then ' table left
If LastToHit = Server Then GoSub computer: Exit Do
If TouchL = 0 And BallDX > 0 Then
GoSub player: Exit Do
Else
TouchL = TouchL + 1
If TouchL > 1 Then GoSub player: Exit Do
End If
ElseIf (BallX - BallR) > NetR Then 'table right
If TouchR = 0 And BallDX < 0 Then ' ball headed left
'If server struck ball correctly on his side first then else computer Pt
If LastToHit = Server Then LastToHit = Player Else GoSub computer: Exit Do
Else ' player can only loose round if not serving
TouchR = TouchR + 1
If TouchR > 1 And LastToHit <> Server Then GoSub computer: Exit Do
End If
End If
BallY = TableY - BallR: BallDY = -BallDY
End If
' collide floor ? I doubt this ever happens
If BallY + BallR > Ymax Then
If LastToHit = Server Then
GoSub computer: Exit Do
End If
If BallX + BallR < TableL Then
If (TouchL > 0 And LastToHit = Player) Or (LastToHit = Computer) Then
GoSub player
Else
GoSub computer
End If
ElseIf BallX - BallR > TableR Then
If (TouchR > 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 LastToHit = Server Then GoSub computer: Exit Do
If (TouchL > 0) And (LastToHit = Player) Then
GoSub player
ElseIf LastToHit = Computer Then
GoSub player
ElseIf ((TouchL = 0) And (LastToHit = Player)) Then ' player hit to far
GoSub computer
End If
Exit Do
ElseIf BallX + BallR > Xmax Then 'collide right boundary
If LastToHit = Server Then GoSub computer: Exit Do
If (TouchR > 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
_PrintString (100, 100), "Computer:" + Str$(computerPt) ' score update
s = "Player:" + Str$(playerPt)
_PrintString (1100 - _PrintWidth(s), 100), s
_Display
If computerPt >= 11 Then
_MessageBox "Sorry,", "The Computer out did you this game."
computerPt = 0: playerPt = 0
ElseIf playerPt >= 11 Then
_MessageBox "Congrats!", "You beat the Computer."
computerPt = 0: playerPt = 0
Else
_Delay 1.3
End If
Loop
End
player:
For snd = 400 To 800 Step 20: Sound snd, .5: Next ' player pt
playerPt = playerPt + 1
FArc PlayerX, PlayerY, 23, 2, _D2R(55), _D2R(125), &HFFFF8888 ' smile
FArc ComputerX, ComputerY + 46, 23, 2, _D2R(240), _D2R(300), &HFFFF8888 ' frown
FCirc BallX, BallY, BallR, &HFFFFFFFF
_Display
_Delay 1
Return
computer:
For snd = 800 To 400 Step -20: Sound snd, .5: Next ' computer pt
computerPt = computerPt + 1
FArc ComputerX, ComputerY, 23, 2, _D2R(55), _D2R(125), &HFFFF8888 ' smile
FArc PlayerX, PlayerY + 46, 23, 2, _D2R(240), _D2R(300), &HFFFF8888 ' frown
FCirc BallX, BallY, BallR, &HFFFFFFFF
_Display
_Delay 1
Return
' ============================================================================= Code for this app
Sub PaddleCollisions ' handles collisions with both paddles
Dim a##, x&, y&, collided&
x& = PlayerX: y& = PlayerY ' check Players Paddle
GoSub checkCollision
If collided& Then
If LastToHit <> Server Then LastToHit = Player
TouchR = 0
End If
x& = ComputerX: y& = ComputerY ' check Computers Paddle
GoSub checkCollision
If collided& Then LastToHit = Computer: TouchL = 0
Exit Sub
checkCollision: ' distance between circle origins of ball and paddle
If Sqr((x& - BallX) ^ 2 + (y& - BallY) ^ 2) < BallR + PaddleR Then
Sound 230, 1 ' paddle strike
a## = _Atan2(BallY - y&, BallX - x&) ' redirect ball
BallDX = BallSpeed * Cos(a##)
BallDY = BallSpeed * Sin(a##)
BallX = BallX + 2 * BallDX ' boost ball innew direction
BallY = BallY + 2 * BallDY
collided& = -1 ' flag collided
Else
collided& = 0 ' flag not collided
End If
Return
End Sub
Sub MakeEyes (x, y)
Dim a
FCirc x - 10, y, 8, &HFFFFFFFF ' eyeballs
FCirc x + 10, y, 8, &HFFFFFFFF
a = _Atan2(BallY - y, BallX - (x - 10)) ' for left iris pointing at ball
FCirc x - 10 + 2.5 * Cos(a), y + 2.5 * Sin(a), 3, &HFF000000
a = _Atan2(BallY - y, BallX - (x + 10)) ' for right iris pointing at ball
FCirc x + 10 + 2.5 * Cos(a), y + 2.5 * Sin(a), 3, &HFF000000
Line (x - 4, y + 23)-Step(8, 3), &HFFFF9999, BF ' for mouth
End Sub
Sub MakeTableImg
Table = _NewImage(_Width, _Height, 32)
Color , &HFF000088: Cls
_Dest Table
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
'2023-02-04 Fill Arc draw an arc with thickness, tested in Profile Pong 3-0
' this sub needs sub FCirc(CX As Long, CY As Long, R As Long, C As _Unsigned Long) for dots
Sub FArc (x, y, r, thickness, RadianStart, RadianStop, c As _Unsigned Long)
Dim al, a
'x, y origin of arc, r = radius, thickness is radius of dots, c = color
'RadianStart is first angle clockwise from due East = 0 in Radians
' arc will start drawing there and clockwise until RadianStop angle reached
If RadianStop < RadianStart Then
FArc x, y, r, thickness, RadianStart, _Pi(2), c
FArc x, y, r, 0, thickness, RadianStop, c
Else
al = _Pi * r * r * (RadianStop - RadianStart) / _Pi(2)
For a = RadianStart To RadianStop Step 1 / al
FCirc x + r * Cos(a), y + r * Sin(a), thickness, c
Next
End If
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
It's now a little easier being green
RE: Profile Pong Game Development - SMcNeill - 10-27-2024
If you guys want to make a different type of Pong, make one with unusual angles.
For example, your paddle isn't straight line of | -- instead make it an X that rotates in a circular motion. Then, when the ball hits that rotating X, you calculate how it bounces based on the current angle of that rotation. Don't play in a square box; play in a hexagon, or inside a destroyable maze where the ball erases the inner walls as it hits them. Push a mouse button and let the "paddle" zoom forward X number of pixels, as if it was one a spring, and then it can hit the ball with forward momentium and toss it back at the other side.
Lots of little tweaks to make a Pong Supreme that you could insert into a game to change the playing dynamics somewhat.
RE: Profile Pong Game Development - bplus - 10-27-2024
Sounds like Steve has a major MOD in mind I look forward to seeing it.
Here, you save misery of calculations of paddle rotations by using spherical paddle, imagine a sphere for paddle in real world, angle of paddle means nothing! But where the ball meets the sphere means everything.
Play volley ball with everyone holding beach balls, could be a ball!
RE: Profile Pong Game Development - SierraKen - 10-27-2024
Awesome game Bplus! I'm finally getting the hang of it.
LOL Steve, sounds almost like Pinball, except with 2 players. We need a good Pinball actually, if there hasn't been one yet.
RE: Profile Pong Game Development - JRace - 10-28-2024
Add a few blocking obstacles, kickers, spinners, a drain or two which give points to a random player, and you've got Paddle Pinball.
RE: Profile Pong Game Development - bplus - 10-28-2024
Pinball is fine idea to play with but not what this thread is about.
As ball approaches paddle, maybe could show a tangent line (angled flat paddle) perpendicular to angle ball is to paddle. Picking up on what Steve said.
That might be interesting to this side view game of Ping Pong. The paddle automatically changes angle according to angle of circle centers. hmm... crazy trig and geometry challenge!
Edited: Corrected since Steve quoted ths.
RE: Profile Pong Game Development - bplus - 10-28-2024
Ok here it is!
LOL big flat paddles held by skinny little arms
Code: (Select All) Option _Explicit
_Title "Profile Pong 4-1 Experiment" ' b+ 2023-02-01 started inspired by Rosy game at RCBasic
' 2024-10-27 4-0 Starting with version 3-0
' widen screen for more room for player
' make mouth more visible
' DUMB Down Computer
' Play to 11 not 21
' Thank you Ken for reviving interest in this game :)
' 4.1 add an easy scale to play by
' LOL big flat paddles help by skinny little arms
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Rules of Profile Ping Pong (now in effect):
' Ping Pong Legal Service:
' The ball must be struck so the ball first bounces on the server's side and then the
' opponent's side. Version 2-4
' On your 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 on his side of table.
' 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 = 1280, Ymax = 700 ' screen size
Const PaddleR = 44, 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
Const Server = 3 ' track serve hits right side first
Dim Shared As Long Table ' background image handle
Dim Shared As Long PlayerX, PlayerY ' locating
Dim Shared As Long ComputerX, ComputerY
Dim Shared As Long BallX, BallY
Dim Shared As Double BallDX, BallDY ' ball direction
Dim Shared As Long LastToHit ' scoring helper flags
Dim Shared As Long TouchL, TouchR
Screen _NewImage(Xmax, Ymax, 32) ' Game QB Settings
_ScreenMove 0, 20 ' <<< you may want different, for my screen it is almost middle
_MouseHide
Dim As Long mx, my, parkComputerY ' locating
Dim As Long playerPt, computerPt ' scoring and scoring helpers
Dim As Double snd ' freq for making sounds
Dim As String s ' temp string for scores
Dim easy
_Font _LoadFont("Arial.ttf", 32) ' everyone has Arial right?
MakeTableImg ' draw table image
ComputerX = TableL - PaddleR - 3 ' as of now, ComputerX doesnt ever change x position
parkComputerY = TableY - 3 * PaddleR ' keeping ComputerY paddle above board out of trouble
Locate 10, 1
Input "On a scale from 0 to 10, how easy do you want the Computer to play"; easy
Do '
' Serve similar to Rosy Demo Video, just drops ball on human side of table
TouchL = 0: TouchR = 0: LastToHit = Server: ComputerY = parkComputerY ' resets for serve
BallY = 550: BallX = TableR - BallR: BallDX = 0: BallDY = 0
Do ' one round of play loop until a point is scored
Cls
_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
PlayerX = mx: PlayerY = my
Else
PlayerY = my ' OK let me move in Y direction at least
End If
FCirc PlayerX, PlayerY, PaddleR, &HFF00BB00
MakeEyes PlayerX, PlayerY
' Computer x is constant behind table edge y adjusted to ballY Computer Paddle
If TouchL = 0 Then
If BallX < NetL Then ComputerY = BallY - 3 * PaddleR Else ComputerY = parkComputerY
Else
If BallY > NetY - 3 * PaddleR Then ' dumb down with Rnd!!!
ComputerY = BallY + 20 + Rnd * 2 * easy - 1.5 * easy ' this is pure guess!!! Thank you gravity!
Else
ComputerY = BallY + 5 + Rnd * 20 - 15 ' so upper round part of paddle hits ball upward
End If
End If
FCirc ComputerX, ComputerY, PaddleR, &HFFBB4400
MakeEyes ComputerX, ComputerY
' ball handling
BallDY = BallDY + Gravity ' gravity weighs ball down going up or down
BallX = BallX + BallDX: BallY = BallY + BallDY
' !!!! try a tangent line on player paddle if ball made contac !!!!
Dim a, px, py, p1x, p1y, p2x, p2y
a = _Atan2(BallY - PlayerY, BallX - PlayerX)
px = PlayerX + PaddleR * Cos(a): py = PlayerY + PaddleR * Sin(a) ' point on paddle edge
p1x = px + 100 * Cos(a + _Pi(.5)): p1y = py + 100 * Sin(a + _Pi(.5))
p2x = px + 100 * Cos(a - _Pi(.5)): p2y = py + 100 * Sin(a - _Pi(.5))
Line (p1x, p1y)-(p2x, p2y), &HFFFFFFFF
Line (PlayerX, PlayerY)-(p2x, p2y), &HFF00BB00
Line (p1x, p1y)-(PlayerX, PlayerY), &HFF00BB00
a = _Atan2(BallY - ComputerY, BallX - ComputerX)
px = ComputerX + PaddleR * Cos(a): py = ComputerY + PaddleR * Sin(a) ' point on paddle edge
p1x = px + 100 * Cos(a + _Pi(.5)): p1y = py + 100 * Sin(a + _Pi(.5))
p2x = px + 100 * Cos(a - _Pi(.5)): p2y = py + 100 * Sin(a - _Pi(.5))
Line (p1x, p1y)-(p2x, p2y), &HFFFFFFFF
Line (ComputerX, ComputerY)-(p2x, p2y), &HFFBB4400
Line (p1x, p1y)-(ComputerX, ComputerY), &HFFBB4400
PaddleCollisions ' check if ball collides with either opponents paddle
' 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 GoSub player: Exit Do
ElseIf BallDX < 0 Then ' going towards computer
If BallX > NetL - BallR And BallX < NetR + BallR Then GoSub computer: Exit Do
End If
End If
' collide table very important to hit table on opponents side on returns
If (((BallY + BallR) > TableY) And (BallX > TableL)) And (BallX < TableR) Then
Sound 600, .25
If (BallX - BallR) < NetL Then ' table left
If LastToHit = Server Then GoSub computer: Exit Do
If TouchL = 0 And BallDX > 0 Then
GoSub player: Exit Do
Else
TouchL = TouchL + 1
If TouchL > 1 Then GoSub player: Exit Do
End If
ElseIf (BallX - BallR) > NetR Then 'table right
If TouchR = 0 And BallDX < 0 Then ' ball headed left
'If server struck ball correctly on his side first then else computer Pt
If LastToHit = Server Then LastToHit = Player Else GoSub computer: Exit Do
Else ' player can only loose round if not serving
TouchR = TouchR + 1
If TouchR > 1 And LastToHit <> Server Then GoSub computer: Exit Do
End If
End If
BallY = TableY - BallR: BallDY = -BallDY
End If
' collide floor ? I doubt this ever happens
If BallY + BallR > Ymax Then
If LastToHit = Server Then
GoSub computer: Exit Do
End If
If BallX + BallR < TableL Then
If (TouchL > 0 And LastToHit = Player) Or (LastToHit = Computer) Then
GoSub player
Else
GoSub computer
End If
ElseIf BallX - BallR > TableR Then
If (TouchR > 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 LastToHit = Server Then GoSub computer: Exit Do
If (TouchL > 0) And (LastToHit = Player) Then
GoSub player
ElseIf LastToHit = Computer Then
GoSub player
ElseIf ((TouchL = 0) And (LastToHit = Player)) Then ' player hit to far
GoSub computer
End If
Exit Do
ElseIf BallX + BallR > Xmax Then 'collide right boundary
If LastToHit = Server Then GoSub computer: Exit Do
If (TouchR > 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
_PrintString (100, 100), "Computer:" + Str$(computerPt) ' score update
s = "Player:" + Str$(playerPt)
_PrintString (1100 - _PrintWidth(s), 100), s
_Display
If computerPt >= 11 Then
_MessageBox "Sorry,", "The Computer out did you this game."
computerPt = 0: playerPt = 0
ElseIf playerPt >= 11 Then
_MessageBox "Congrats!", "You beat the Computer."
computerPt = 0: playerPt = 0
Else
_Delay 1.3
End If
Loop
End
player:
For snd = 400 To 800 Step 20: Sound snd, .5: Next ' player pt
playerPt = playerPt + 1
FArc PlayerX, PlayerY, 23, 2, _D2R(55), _D2R(125), &HFFFF8888 ' smile
FArc ComputerX, ComputerY + 46, 23, 2, _D2R(240), _D2R(300), &HFFFF8888 ' frown
FCirc BallX, BallY, BallR, &HFFFFFFFF
_Display
_Delay 1
Return
computer:
For snd = 800 To 400 Step -20: Sound snd, .5: Next ' computer pt
computerPt = computerPt + 1
FArc ComputerX, ComputerY, 23, 2, _D2R(55), _D2R(125), &HFFFF8888 ' smile
FArc PlayerX, PlayerY + 46, 23, 2, _D2R(240), _D2R(300), &HFFFF8888 ' frown
FCirc BallX, BallY, BallR, &HFFFFFFFF
_Display
_Delay 1
Return
' ============================================================================= Code for this app
Sub PaddleCollisions ' handles collisions with both paddles
Dim a##, x&, y&, collided&
x& = PlayerX: y& = PlayerY ' check Players Paddle
GoSub checkCollision
If collided& Then
If LastToHit <> Server Then LastToHit = Player
TouchR = 0
End If
x& = ComputerX: y& = ComputerY ' check Computers Paddle
GoSub checkCollision
If collided& Then LastToHit = Computer: TouchL = 0
Exit Sub
checkCollision: ' distance between circle origins of ball and paddle
If Sqr((x& - BallX) ^ 2 + (y& - BallY) ^ 2) < BallR + PaddleR Then
Sound 230, 1 ' paddle strike
a## = _Atan2(BallY - y&, BallX - x&) ' redirect ball
BallDX = BallSpeed * Cos(a##)
BallDY = BallSpeed * Sin(a##)
BallX = BallX + 2 * BallDX ' boost ball innew direction
BallY = BallY + 2 * BallDY
collided& = -1 ' flag collided
Else
collided& = 0 ' flag not collided
End If
Return
End Sub
Sub MakeEyes (x, y)
Dim a
FCirc x - 10, y, 8, &HFFFFFFFF ' eyeballs
FCirc x + 10, y, 8, &HFFFFFFFF
a = _Atan2(BallY - y, BallX - (x - 10)) ' for left iris pointing at ball
FCirc x - 10 + 2.5 * Cos(a), y + 2.5 * Sin(a), 3, &HFF000000
a = _Atan2(BallY - y, BallX - (x + 10)) ' for right iris pointing at ball
FCirc x + 10 + 2.5 * Cos(a), y + 2.5 * Sin(a), 3, &HFF000000
Line (x - 4, y + 23)-Step(8, 3), &HFFFF9999, BF ' for mouth
End Sub
Sub MakeTableImg
Table = _NewImage(_Width, _Height, 32)
Color , &HFF000088: Cls
_Dest Table
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
'2023-02-04 Fill Arc draw an arc with thickness, tested in Profile Pong 3-0
' this sub needs sub FCirc(CX As Long, CY As Long, R As Long, C As _Unsigned Long) for dots
Sub FArc (x, y, r, thickness, RadianStart, RadianStop, c As _Unsigned Long)
Dim al, a
'x, y origin of arc, r = radius, thickness is radius of dots, c = color
'RadianStart is first angle clockwise from due East = 0 in Radians
' arc will start drawing there and clockwise until RadianStop angle reached
If RadianStop < RadianStart Then
FArc x, y, r, thickness, RadianStart, _Pi(2), c
FArc x, y, r, 0, thickness, RadianStop, c
Else
al = _Pi * r * r * (RadianStop - RadianStart) / _Pi(2)
For a = RadianStart To RadianStop Step 1 / al
FCirc x + r * Cos(a), y + r * Sin(a), thickness, c
Next
End If
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
Why am I reminded of South Park? only saw some clips from it.
RE: Profile Pong Game Development - SMcNeill - 10-28-2024
(10-28-2024, 08:04 AM)bplus Wrote: Pinball is fine idea to play with but not what this thread is about.
As ball approaches paddle, maybe could show a tangent line (angled flat paddle) if contact made with ball and paddle at ball height to circle?
Picking up on what Steve said. That might be interesting to this side view game of Ping Pong. The paddle automatically changes angle according to height of paddle and ball centers. hmm... crazy trig and geometry challenge!
It's really not that complex math. The angle of incidence equals the angle of reflection.
Hit a flat wall at 45 degrees, then you have a 45 degree reflection.
![[Image: ole1.gif]](https://solitaryroad.com/c1033/ole1.gif)
Now, if you have a slanted wall, you just subtract angles. For example, let's use a 45 degree wall... if you draw it on a sheet of paper, that wall will look like / <-- that slash almost. To make it a "flat line" like the picture above, just rotate your sheet of paper 45 degrees. / now becomes __. Of course, since you rotated the whole page 45 degrees, if you measure your angle of incidence, it's now rotated that same 45 degrees... So at the end, that's basically all you do -- subtract the angle of rotatation from the angle of incidence to get the angle of reflection.
(That is, if my brain is working well enough to explain it properly, at 5:30 in the morning, before my first cup of coffee in the day has even finished brewing.)
RE: Profile Pong Game Development - bplus - 10-28-2024
Already done! see post above.
Coffee ?!? Oh yeah but get good laugh from skinny armed disks with faces LOL
RE: Profile Pong Game Development - bplus - 10-28-2024
OK let's try it with Lightsabers!
Code: (Select All) Option _Explicit
_Title "Profile Pong 4-1 Experiment" ' b+ 2023-02-01 started inspired by Rosy game at RCBasic
' 2024-10-27 4-0 Starting with version 3-0
' widen screen for more room for player
' make mouth more visible
' DUMB Down Computer
' Play to 11 not 21
' Thank you Ken for reviving interest in this game :)
' 4.1 add an easy scale to play by
' LOL one armed LightSabers
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Rules of Profile Ping Pong (now in effect):
' Ping Pong Legal Service:
' The ball must be struck so the ball first bounces on the server's side and then the
' opponent's side. Version 2-4
' On your 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 on his side of table.
' 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 = 1280, Ymax = 700 ' screen size
Const PaddleR = 44, 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
Const Server = 3 ' track serve hits right side first
Dim Shared As Long Table ' background image handle
Dim Shared As Long PlayerX, PlayerY ' locating
Dim Shared As Long ComputerX, ComputerY
Dim Shared As Long BallX, BallY
Dim Shared As Double BallDX, BallDY ' ball direction
Dim Shared As Long LastToHit ' scoring helper flags
Dim Shared As Long TouchL, TouchR
Screen _NewImage(Xmax, Ymax, 32) ' Game QB Settings
_ScreenMove 0, 20 ' <<< you may want different, for my screen it is almost middle
_MouseHide
Dim As Long mx, my, parkComputerY ' locating
Dim As Long playerPt, computerPt ' scoring and scoring helpers
Dim As Double snd ' freq for making sounds
Dim As String s ' temp string for scores
Dim easy, handicap, c
_Font _LoadFont("Arial.ttf", 32) ' everyone has Arial right?
MakeTableImg ' draw table image
ComputerX = TableL - PaddleR - 3 ' as of now, ComputerX doesnt ever change x position
parkComputerY = TableY - 3 * PaddleR ' keeping ComputerY paddle above board out of trouble
Locate 10, 1
Input "On a scale from 0 to 10, how easy do you want the Computer to play"; easy
Do '
' Serve similar to Rosy Demo Video, just drops ball on human side of table
TouchL = 0: TouchR = 0: LastToHit = Server: ComputerY = parkComputerY ' resets for serve
BallY = 550: BallX = TableR - BallR: BallDX = 0: BallDY = 0
Do ' one round of play loop until a point is scored
Cls
_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
PlayerX = mx: PlayerY = my
Else
PlayerY = my ' OK let me move in Y direction at least
End If
' Computer x is constant behind table edge y adjusted to ballY Computer Paddle
c = c + 15
handicap = 2 * easy * Sin(_D2R(c))
If TouchL = 0 Then
If BallX < NetL Then ComputerY = BallY - 3 * PaddleR Else ComputerY = parkComputerY
Else
If BallY > NetY - 3 * PaddleR Then ' dumb down with Rnd!!!
ComputerY = BallY + 20 + handicap ' this is pure guess!!! Thank you gravity!
Else
ComputerY = BallY + 5 + handicap ' so upper round part of paddle hits ball upward
End If
End If
' ball handling
BallDY = BallDY + Gravity ' gravity weighs ball down going up or down
BallX = BallX + BallDX: BallY = BallY + BallDY
' !!!! try a tangent line on player paddle if ball made contac !!!!
Dim a, px, py, p1x, p1y, p2x, p2y
a = _Atan2(BallY - PlayerY, BallX - PlayerX)
px = PlayerX + (PaddleR + 4) * Cos(a): py = PlayerY + (PaddleR + 4) * Sin(a) ' point on paddle edge
p1x = px + 100 * Cos(a + _Pi(.5)): p1y = py + 100 * Sin(a + _Pi(.5))
p2x = px + 100 * Cos(a - _Pi(.5)): p2y = py + 100 * Sin(a - _Pi(.5))
thic p1x, p1y, p2x, p2y, 4, &HFFFFFFFF
thic p1x, p1y, p2x, p2y, 10, &H88FFFFFF
thic p1x, p1y, p2x, p2y, 20, &H44FFFFFF
px = PlayerX + 15 * Cos(a): py = PlayerY + 15 * Sin(a)
'ftri px, py, p1x, p1y, PlayerX, PlayerY, &HFF00BB00
ftri px, py, p2x, p2y, PlayerX, PlayerY, &HFF00BB00
'FCirc p1x, p1y, 5, &HFF00BB00
FCirc p2x, p2y, 5, &HFF00BB00
FCirc PlayerX, PlayerY, PaddleR, &HFF00BB00
MakeEyes PlayerX, PlayerY
a = _Atan2(BallY - ComputerY, BallX - ComputerX)
px = ComputerX + (PaddleR + 4) * Cos(a): py = ComputerY + (PaddleR + 4) * Sin(a) ' point on paddle edge
p1x = px + 100 * Cos(a + _Pi(.5)): p1y = py + 100 * Sin(a + _Pi(.5))
p2x = px + 100 * Cos(a - _Pi(.5)): p2y = py + 100 * Sin(a - _Pi(.5))
thic p1x, p1y, p2x, p2y, 4, &HFFFFFFFF
thic p1x, p1y, p2x, p2y, 10, &H88FFFFFF
thic p1x, p1y, p2x, p2y, 20, &H44FFFFFF
px = ComputerX + 15 * Cos(a): py = ComputerY + 15 * Sin(a)
ftri px, py, p1x, p1y, ComputerX, ComputerY, &HFFBB4400
'ftri px, py, p2x, p2y, ComputerX, ComputerY, &HFFBB4400
FCirc p1x, p1y, 5, &HFFBB4400
'FCirc p2x, p2y, 5, &HFFBB4400
FCirc ComputerX, ComputerY, PaddleR, &HFFBB4400
MakeEyes ComputerX, ComputerY
PaddleCollisions ' check if ball collides with either opponents paddle
' 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 GoSub player: Exit Do
ElseIf BallDX < 0 Then ' going towards computer
If BallX > NetL - BallR And BallX < NetR + BallR Then GoSub computer: Exit Do
End If
End If
' collide table very important to hit table on opponents side on returns
If (((BallY + BallR) > TableY) And (BallX > TableL)) And (BallX < TableR) Then
Sound 600, .25
If (BallX - BallR) < NetL Then ' table left
If LastToHit = Server Then GoSub computer: Exit Do
If TouchL = 0 And BallDX > 0 Then
GoSub player: Exit Do
Else
TouchL = TouchL + 1
If TouchL > 1 Then GoSub player: Exit Do
End If
ElseIf (BallX - BallR) > NetR Then 'table right
If TouchR = 0 And BallDX < 0 Then ' ball headed left
'If server struck ball correctly on his side first then else computer Pt
If LastToHit = Server Then LastToHit = Player Else GoSub computer: Exit Do
Else ' player can only loose round if not serving
TouchR = TouchR + 1
If TouchR > 1 And LastToHit <> Server Then GoSub computer: Exit Do
End If
End If
BallY = TableY - BallR: BallDY = -BallDY
End If
' collide floor ? I doubt this ever happens
If BallY + BallR > Ymax Then
If LastToHit = Server Then
GoSub computer: Exit Do
End If
If BallX + BallR < TableL Then
If (TouchL > 0 And LastToHit = Player) Or (LastToHit = Computer) Then
GoSub player
Else
GoSub computer
End If
ElseIf BallX - BallR > TableR Then
If (TouchR > 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 LastToHit = Server Then GoSub computer: Exit Do
If (TouchL > 0) And (LastToHit = Player) Then
GoSub player
ElseIf LastToHit = Computer Then
GoSub player
ElseIf ((TouchL = 0) And (LastToHit = Player)) Then ' player hit to far
GoSub computer
End If
Exit Do
ElseIf BallX + BallR > Xmax Then 'collide right boundary
If LastToHit = Server Then GoSub computer: Exit Do
If (TouchR > 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
_PrintString (100, 100), "Computer:" + Str$(computerPt) ' score update
s = "Player:" + Str$(playerPt)
_PrintString (1100 - _PrintWidth(s), 100), s
_Display
If computerPt >= 11 Then
_MessageBox "Sorry,", "The Computer out did you this game."
computerPt = 0: playerPt = 0
ElseIf playerPt >= 11 Then
_MessageBox "Congrats!", "You beat the Computer."
computerPt = 0: playerPt = 0
Else
_Delay 1.3
End If
Loop
End
player:
For snd = 400 To 800 Step 20: Sound snd, .5: Next ' player pt
playerPt = playerPt + 1
FArc PlayerX, PlayerY, 23, 2, _D2R(55), _D2R(125), &HFFFF8888 ' smile
FArc ComputerX, ComputerY + 46, 23, 2, _D2R(240), _D2R(300), &HFFFF8888 ' frown
FCirc BallX, BallY, BallR, &HFFFFFFFF
_Display
_Delay 1
Return
computer:
For snd = 800 To 400 Step -20: Sound snd, .5: Next ' computer pt
computerPt = computerPt + 1
FArc ComputerX, ComputerY, 23, 2, _D2R(55), _D2R(125), &HFFFF8888 ' smile
FArc PlayerX, PlayerY + 46, 23, 2, _D2R(240), _D2R(300), &HFFFF8888 ' frown
FCirc BallX, BallY, BallR, &HFFFFFFFF
_Display
_Delay 1
Return
' ============================================================================= Code for this app
Sub PaddleCollisions ' handles collisions with both paddles
Dim a##, x&, y&, collided&
x& = PlayerX: y& = PlayerY ' check Players Paddle
GoSub checkCollision
If collided& Then
If LastToHit <> Server Then LastToHit = Player
TouchR = 0
End If
x& = ComputerX: y& = ComputerY ' check Computers Paddle
GoSub checkCollision
If collided& Then LastToHit = Computer: TouchL = 0
Exit Sub
checkCollision: ' distance between circle origins of ball and paddle
If Sqr((x& - BallX) ^ 2 + (y& - BallY) ^ 2) < BallR + PaddleR Then
Sound 230, 1 ' paddle strike
a## = _Atan2(BallY - y&, BallX - x&) ' redirect ball
BallDX = BallSpeed * Cos(a##)
BallDY = BallSpeed * Sin(a##)
BallX = BallX + 2 * BallDX ' boost ball innew direction
BallY = BallY + 2 * BallDY
collided& = -1 ' flag collided
Else
collided& = 0 ' flag not collided
End If
Return
End Sub
Sub MakeEyes (x, y)
Dim a
FCirc x - 10, y, 8, &HFFFFFFFF ' eyeballs
FCirc x + 10, y, 8, &HFFFFFFFF
a = _Atan2(BallY - y, BallX - (x - 10)) ' for left iris pointing at ball
FCirc x - 10 + 2.5 * Cos(a), y + 2.5 * Sin(a), 3, &HFF000000
a = _Atan2(BallY - y, BallX - (x + 10)) ' for right iris pointing at ball
FCirc x + 10 + 2.5 * Cos(a), y + 2.5 * Sin(a), 3, &HFF000000
Line (x - 4, y + 23)-Step(8, 3), &HFFFF9999, BF ' for mouth
End Sub
Sub MakeTableImg
Table = _NewImage(_Width, _Height, 32)
Color , &HFF000088: Cls
_Dest Table
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
'2023-02-04 Fill Arc draw an arc with thickness, tested in Profile Pong 3-0
' this sub needs sub FCirc(CX As Long, CY As Long, R As Long, C As _Unsigned Long) for dots
Sub FArc (x, y, r, thickness, RadianStart, RadianStop, c As _Unsigned Long)
Dim al, a
'x, y origin of arc, r = radius, thickness is radius of dots, c = color
'RadianStart is first angle clockwise from due East = 0 in Radians
' arc will start drawing there and clockwise until RadianStop angle reached
If RadianStop < RadianStart Then
FArc x, y, r, thickness, RadianStart, _Pi(2), c
FArc x, y, r, 0, thickness, RadianStop, c
Else
al = _Pi * r * r * (RadianStop - RadianStart) / _Pi(2)
For a = RadianStart To RadianStop Step 1 / al
FCirc x + r * Cos(a), y + r * Sin(a), thickness, c
Next
End If
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
'update 2020-01-24 to include PD2 inside the sub
Sub thic (x1, y1, x2, y2, thick, K As _Unsigned Long)
Dim PD2 As Double, t2 As Single, a As Single, x3 As Single, y3 As Single, x4 As Single, y4 As Single
Dim x5 As Single, y5 As Single, x6 As Single, y6 As Single
PD2 = 1.570796326794897
t2 = thick / 2
If t2 < 1 Then t2 = 1
a = _Atan2(y2 - y1, x2 - x1)
x3 = x1 + t2 * Cos(a + PD2)
y3 = y1 + t2 * Sin(a + PD2)
x4 = x1 + t2 * Cos(a - PD2)
y4 = y1 + t2 * Sin(a - PD2)
x5 = x2 + t2 * Cos(a + PD2)
y5 = y2 + t2 * Sin(a + PD2)
x6 = x2 + t2 * Cos(a - PD2)
y6 = y2 + t2 * Sin(a - PD2)
ftri x6, y6, x4, y4, x3, y3, K
ftri x3, y3, x5, y5, x6, y6, K
End Sub
'' BEST saves dest and optimized with Static a& and alpha colors work better
'2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
Update: Nope! those Lightsabers are more distraction than any sort of help!
|