Posts: 1,510
Threads: 53
Joined: Jul 2022
Reputation:
47
(02-05-2023, 12:56 AM)bplus Wrote: 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.
I actually knew as much as you about it, and should have known even more if I forced myself to watch Adriana Diaz playing. :O
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
I should have know about serve, use to play all the time in college but that was 50 years ago!
OK the serve stuff is fixed, but I hated the way that paddle shape was playing so I switched back to a bigger circle, better!
Then I discovered a trick to beat the machine! Player's new color is Green because it ain't easy...
Code: (Select All) Option _Explicit
_Title "Profile Pong 2-4" ' 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
' 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!
'2023-02-04 2-4
' Observe the proper rule for legal serve, hit server's side first and then opponent's side.
' Add Const Server and use for scoring. Now get in habit of striking ball with bottom circle
' maybe side?
' New Paddle, back to big circle!!! Ah much better!
' If the ball hasn't touched the table you can hit it more than once.
' 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.
' 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
Const CircR = 50 ' 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, LPaddle ' 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
_MouseHide
makeTableImg ' background and table, CLS with it
makeLeftPaddle ' 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: lastToHit = Server ' for serving
computerY = parkComputerY
ballY = 550: 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 + CircR Then ' keep player on his side of table
playerX = mx: playerY = my
Else
playerY = my ' OK let me move in Y direction
End If
fcirc playerX, playerY, CircR, &HFF00BB00
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
If Sqr((playerX - ballX) ^ 2 + (playerY - ballY) ^ 2) < BallR + CircR 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
If lastToHit <> Server Then 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 ' table left
If lastToHit = Server Then
GoSub computer
Exit Do
End If
If tableTouchL = 0 And ballDX > 0 Then
GoSub player
Exit Do
Else
tableTouchL = tableTouchL + 1
If tableTouchL > 1 Then
GoSub player
Exit Do
End If
End If
ElseIf (ballX - BallR) > NetR Then 'table right
If tableTouchR = 0 And ballDX < 0 Then ' ball headed left
If lastToHit = Server Then ' server struck ball correctly on his side first
lastToHit = Player
Else
GoSub computer ' player hit his side first, not on a serve
Exit Do
End If
Else
tableTouchR = tableTouchR + 1
If tableTouchR > 1 And lastToHit <> Server Then
GoSub computer
Exit Do
End If
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 (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 lastToHit = Server Then
GoSub computer
Exit Do
End If
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 lastToHit = Server Then
GoSub computer
Exit Do
End If
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 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
b = b + ...
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
Well need to do one more version with both paddles as circle and reduce LOC < 300:
Code: (Select All) Option _Explicit
_Title "Profile Pong 3-0" ' b+ 2023-02-01 started inspired by Rosy game at RCBasic
' 2023-02-05 3-0 Starting with version 2-4 fixed for Proper serving, I redid both paddle shapes to
'circle fills and cleaned up code to that including consolidating Paddle Collision code.
' 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.
' 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 = 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 60, 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
ComputerY = BallY + 20 ' this is pure guess!!! Thank you gravity!
Else
ComputerY = BallY + 5 ' 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 >= 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
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, 1, _D2R(55), _D2R(125), &HFFFF0000 ' smile
FArc ComputerX, ComputerY + 46, 23, 1, _D2R(240), _D2R(300), &HFFFF0000 ' 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, 1, _D2R(55), _D2R(125), &HFFFF0000 ' smile
FArc PlayerX, PlayerY + 46, 23, 1, _D2R(240), _D2R(300), &HFFFF0000 ' 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 - 3, y + 23)-Step(6, 2), &HFFFF0000, 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
b = b + ...
|
