Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Profile Pong Game Development
#21
OK @SierraKen the Computer now has a hard time returning your wicked serve Wink

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 Wink
b = b + ...
Reply
#22
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.  Wink
Reply
#23
Sounds like Steve has a major MOD in mind Wink 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!
b = b + ...
Reply
#24
Awesome game Bplus! I'm finally getting the hang of it. 

LOL Steve, sounds almost like Pinball, except with 2 players. Smile We need a good Pinball actually, if there hasn't been one yet.
Reply
#25
Add a few blocking obstacles, kickers, spinners, a drain or two which give points to a random player, and you've got Paddle Pinball.
Reply
#26
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.
b = b + ...
Reply
#27
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.
b = b + ...
Reply
#28
(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]

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.)
Reply
#29
Already done! see post above.

Coffee ?!? Oh yeah but get good laugh from skinny armed disks with faces LOL

   
b = b + ...
Reply
#30
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!
b = b + ...
Reply




Users browsing this thread: 5 Guest(s)