02-04-2023, 08:35 PM
I tighten up game to rules of Pong and show code to Johnno because I was curious about RCBasic and Rosy.
Johnno made the usual comments too hard and not Blue LOL so
version 1-2
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 SubJohnno 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 + ...