Option _Explicit
' OpenGl Pong
DefLng L ' Longs start with L
DefInt I ' Integers start with I
DefStr S ' Strings start with S
DefSng N 'Singles start with N

' type of data called OBJECT
Type obj
    X As Integer
    Y As Integer
    Width1 As Integer
    Height As Integer
    Color1 As _Unsigned Long
    Active As Integer
    SpeedX As Integer
    SpeedY As Integer
End Type

Const True = -1, False = 0, Left = 19200, Right = 19712, Escape = 27
Const Enter = 13, iPlayer1 = 1, iPlayer2 = 2
Dim lScreen
Dim Shared iKeyb(1 To 2) As Integer
Dim Shared iActiveGl, myScreen As obj, Pad(1 To 2) As obj, Ball As obj
Dim Shared Gc As Integer, Rc As Integer, Bc As Integer, Ac As Integer
Dim Shared InitGl As Integer, iBallGl As Integer
Dim Shared iPadGl1 As Integer, iPadGl2 As Integer

lScreen = _NewImage(800, 600, 32) ' graphic
Screen lScreen ' graphic  creating the window of the program
'  wait that window has been created
_Delay 2 'Do While Not _ScreenExists: Loop
_ScreenMove 1, 1
_Title "OpenGl Pong v.1.0: press Enter to switch between normal vs OpenGl mode"


Init

Do While (iKeyb(iPlayer1) <> Escape) Or (iKeyb(iPlayer2) <> Escape)
    GetInput
    ' stardard graphic mode
    If iActiveGl = False Then
        Border
        Showpad iPlayer1
        Showpad iPlayer2
        ShowBall
        Call Message(1, 1, "press Escape to quit, A/S player 1 Left/Right, cursor Left/Right player 2")
        '    Else
        '  GL() graphic mode

        ' Nothing to do here  go to _GL()
    End If

    ' calculations for new screenshot
    MovePad
    MoveBall

    ' this toggles between standard graphic mode and  Gl graphic mode
    If iKeyb(iPlayer1) = Enter Or iKeyb(iPlayer2) = Enter Then iActiveGl = Not iActiveGl
    ' saving CPU usage
    _Limit 20
Loop
End

' area GL--------------------------------------------------------------

Sub _GL ()
    If iActiveGl = 0 Then Exit Sub
    If InitGl Then InitGlSub
    ClearScreen

    If iBallGl = True Then BallGl
    If iPadGl1 Then PADgL1
    If iPadGl2 Then PADgL2
    _glFlush
End Sub

Sub BallGl
    Dim nGc, nBc, nRc, nAc
    Dim e As Single, gXb As Single, gYb As Single
    ComponentColor Ball.Color1
    If SetColorGL!(nGc, nBc, nRc, nAc) Then
        _glBegin _GL_TRIANGLE_FAN
        For e = 1 To (_Pi(2)) Step (2 * _Pi / 6)
            gXb = Proportion!(0, _Width, -1, 1, Ball.X + (Ball.Width1 * Cos(e)))
            gYb = Proportion!(0, _Height, 1, -1, Ball.Y + (Ball.Height * Sin(e)))
            _glVertex2f gXb, gYb
        Next e
        _glEnd
    End If
End Sub

Sub PADgL1
    Dim nGc, nBc, nRc, nAc
    Dim nx1, nx2, ny1, ny2, dummy
    ComponentColor Pad(iPlayer1).Color1
    If SetColorGL!(nGc, nBc, nRc, nAc) Then
        nx1 = Proportion(0, _Width, -1, 1, Pad(iPlayer1).X)
        ny1 = Proportion(0, _Height, 1, -1, Pad(iPlayer1).Y)
        ny2 = Proportion(0, _Height, 1, -1, Pad(iPlayer1).Y + Pad(iPlayer1).Height)
        nx2 = Proportion(0, _Width, -1, 1, Pad(iPlayer1).X + Pad(iPlayer1).Width1)
        _glBegin _GL_QUADS
        _glVertex2f nx1, ny1
        _glVertex2f nx1, ny2
        _glVertex2f nx2, ny2
        _glVertex2f nx2, ny1
        _glEnd
        ComponentColor _RGB32(0)
        dummy = SetColorGL!(nGc, nBc, nRc, nAc)
        nx1 = Proportion(0, _Width, -1, 1, Pad(iPlayer1).X + 2)
        ny1 = Proportion(0, _Height, 1, -1, Pad(iPlayer1).Y + 2)
        ny2 = Proportion(0, _Height, 1, -1, Pad(iPlayer1).Y + Pad(iPlayer1).Height - 2)
        nx2 = Proportion(0, _Width, -1, 1, Pad(iPlayer1).X + Pad(iPlayer1).Width1 - 2)
        _glBegin _GL_LINE_LOOP
        _glVertex2f nx1, ny1
        _glVertex2f nx1, ny2
        _glVertex2f nx2, ny2
        _glVertex2f nx2, ny1
        _glEnd

    End If
End Sub

Sub PADgL2
    Dim nGc, nBc, nRc, nAc
    Dim nx1, nx2, ny1, ny2, dummy
    ComponentColor Pad(iPlayer2).Color1
    If SetColorGL!(nGc, nBc, nRc, nAc) Then
        nx1 = Proportion(0, _Width, -1, 1, Pad(iPlayer2).X)
        ny1 = Proportion(0, _Height, 1, -1, Pad(iPlayer2).Y)
        ny2 = Proportion(0, _Height, 1, -1, Pad(iPlayer2).Y + Pad(iPlayer2).Height)
        nx2 = Proportion(0, _Width, -1, 1, Pad(iPlayer2).X + Pad(iPlayer2).Width1)
        _glBegin _GL_QUADS
        _glVertex2f nx1, ny1
        _glVertex2f nx1, ny2
        _glVertex2f nx2, ny2
        _glVertex2f nx2, ny1
        _glEnd
        ComponentColor _RGB32(0)
        dummy = SetColorGL!(nGc, nBc, nRc, nAc)
        nx1 = Proportion(0, _Width, -1, 1, Pad(iPlayer2).X + 2)
        ny1 = Proportion(0, _Height, 1, -1, Pad(iPlayer2).Y + 2)
        ny2 = Proportion(0, _Height, 1, -1, Pad(iPlayer2).Y + Pad(iPlayer2).Height - 2)
        nx2 = Proportion(0, _Width, -1, 1, Pad(iPlayer2).X + Pad(iPlayer2).Width1 - 2)
        _glBegin _GL_LINE_LOOP
        _glVertex2f nx1, ny1
        _glVertex2f nx1, ny2
        _glVertex2f nx2, ny2
        _glVertex2f nx2, ny1
        _glEnd
    End If
End Sub

Sub ClearScreen
    _glClear _GL_COLOR_BUFFER_BIT
End Sub

Function SetColorGL! (nGc, nRc, nBc, nAc)
    SetColorGL! = False
    nGc = Proportion(1, 255, 0, 1, Gc)
    nRc = Proportion(1, 255, 0, 1, Rc)
    nBc = Proportion(1, 255, 0, 1, Bc)
    nAc = Proportion(1, 255, 0, 1, Ac)
    _glColor3f nRc, nGc, nBc
    SetColorGL! = True
End Function

Sub InitGlSub
    'settings viewport for GL screen
    _glViewport myScreen.X, myScreen.Y, myScreen.Width1, myScreen.Height
    Dim nGc, nBc, nRc, nAc
    ComponentColor myScreen.Color1
    If SetColorGL!(nGc, nRc, nBc, nAc) Then
        _glClearColor nRc, nGc, nBc, nAc
    Else
        Print "Error"
    End If
    InitGl = False
End Sub


' area sub/functions*****************************************************
Function Proportion (imin1, imax1, imin2, imax2, ivalue)
    Dim iDelta1, iDelta2
    iDelta1 = (imax1 - imin1)
    iDelta2 = (imax2 - imin2)
    Proportion = ((ivalue * iDelta2) / iDelta1) + imin2
End Function



Sub ComponentColor (C As _Unsigned Long)
    Gc = _Green32(C)
    Rc = _Red32(C)
    Bc = _Blue32(C)
    Ac = _Alpha32(C)
End Sub

Sub Init
    ' window of program
    myScreen.X = 0
    myScreen.Y = 0
    myScreen.Width1 = _Width
    myScreen.Height = _Height
    myScreen.Color1 = _RGB32(200, 200, 50)
    myScreen.Active = True

    ' ball
    Ball.X = 400
    Ball.Y = 300
    Ball.Active = True
    Ball.Width1 = 10
    Ball.Height = 10
    Ball.SpeedX = 3
    Ball.SpeedY = 3
    Ball.Color1 = _RGB32(200, 10, 10)

    'PAD player1
    Pad(iPlayer1).X = 350
    Pad(iPlayer1).Y = 400
    Pad(iPlayer1).Width1 = 100
    Pad(iPlayer1).Height = 30
    Pad(iPlayer1).Color1 = _RGB32(40, 230, 200)
    Pad(iPlayer1).SpeedX = 0
    Pad(iPlayer1).SpeedY = 0
    Pad(iPlayer1).Active = True


    'PAD player2
    Pad(iPlayer2).X = 350
    Pad(iPlayer2).Y = 150
    Pad(iPlayer2).Width1 = 100
    Pad(iPlayer2).Height = 30
    Pad(iPlayer2).Color1 = _RGB32(230, 130, 220)
    Pad(iPlayer2).SpeedX = 0
    Pad(iPlayer2).SpeedY = 0
    Pad(iPlayer2).Active = True

    'Gl
    InitGl = True
    iBallGl = True
    iPadGl1 = True
    iPadGl2 = True
    iActiveGl = False ' at the start the graphic is normal
End Sub

' Graphic normal---------------
Sub Showpad (P As Integer)
    If Pad(P).Active Then
        Line (Pad(P).X, Pad(P).Y)-Step(Pad(P).Width1, Pad(P).Height), Pad(P).Color1, BF
        Line (Pad(P).X, Pad(P).Y)-Step(Pad(P).Width1, Pad(P).Height), _RGB32(0), B
    End If
End Sub

Sub ShowBall
    Circle (Ball.X, Ball.Y), Ball.Width1, Ball.Color1
    Paint Step(0, 0), Ball.Color1, Ball.Color1
End Sub

Sub Border
    Line (myScreen.X + 1, myScreen.Y + 1)-(myScreen.X + myScreen.Width1 - 1, myScreen.Y + myScreen.Height - 1), myScreen.Color1, BF
End Sub

' movement and I/O area-----------------------------
Sub Message (iWhereX As Integer, iWhereY As Integer, sMessage As String)
    Locate iWhereY, iWhereX
    Print sMessage;
End Sub

Sub MovePad
    Dim i
    For i = iPlayer1 To iPlayer2 Step 1
        If iKeyb(i) = Right Then Pad(i).X = Pad(i).X + 10
        If Pad(i).X > myScreen.Width1 - Pad(i).Width1 Then Pad(i).X = myScreen.Width1 - Pad(i).Width1
        If iKeyb(i) = Left Then Pad(i).X = Pad(i).X - 10
        If Pad(i).X < myScreen.X Then Pad(i).X = myScreen.X
    Next
End Sub

Sub MoveBall
    Ball.X = Ball.X + Ball.SpeedX
    Ball.Y = Ball.Y + Ball.SpeedY
    ' bouncing control
    'vs walls
    If Ball.X < 0 Then Ball.X = Int(Ball.Width1 / 2) + 1: Ball.SpeedX = -Ball.SpeedX
    If Ball.X > myScreen.Width1 - Int(Ball.Width1 / 2) + 1 Then Ball.X = myScreen.Width1 - Int(Ball.Width1 / 2) + 1: Ball.SpeedX = -Ball.SpeedX
    If Ball.Y < 0 Then Ball.Y = Int(Ball.Height / 2) + 1: Ball.SpeedY = -Ball.SpeedY
    If Ball.Y > myScreen.Height - Int(Ball.Height / 2) + 1 Then Ball.Y = myScreen.Height - Int(Ball.Height / 2) + 1: Ball.SpeedY = -Ball.SpeedY
    ' vs player1
    If Abs(Pad(iPlayer1).Y + Int(Pad(iPlayer1).Height / 2) - (Ball.Y + Int(Ball.Height / 2))) < Int((Pad(iPlayer1).Height + Ball.Height) / 2) Then
        If Abs((Pad(iPlayer1).X + Int(Pad(iPlayer1).Width1 / 2)) - (Ball.X + Int(Ball.Width1 / 2))) < Int((Pad(iPlayer1).Width1 + Ball.Width1) / 2) Then
            Ball.SpeedY = -Ball.SpeedY
        End If
    End If
    ' vs player2
    If Abs(Pad(iPlayer2).Y + Int(Pad(iPlayer2).Height / 2) - (Ball.Y + Int(Ball.Height / 2))) < Int((Pad(iPlayer2).Height + Ball.Height) / 2) Then
        If Abs((Pad(iPlayer2).X + Int(Pad(iPlayer2).Width1 / 2)) - (Ball.X + Int(Ball.Width1 / 2))) < Int((Pad(iPlayer2).Width1 + Ball.Width1) / 2) Then
            Ball.SpeedY = -Ball.SpeedY
        End If
    End If
End Sub

Sub GetInput
    ' it resets command variables
    iKeyb(iPlayer1) = 0
    iKeyb(iPlayer2) = 0
    ' keyboard input
    iKeyb(iPlayer1) = _KeyHit
    If _KeyDown(115) Or _KeyDown(83) Then iKeyb(iPlayer2) = Right Else If iKeyb(iPlayer2) = Right Then iKeyb(iPlayer2) = False
    If _KeyDown(65) Or _KeyDown(97) Then iKeyb(iPlayer2) = Left Else If iKeyb(iPlayer2) = Left Then iKeyb(iPlayer2) = False
    If _KeyDown(27) Then iKeyb(iPlayer2) = Escape
    If _KeyDown(13) Then iKeyb(iPlayer2) = Enter
    '  Do: Loop Until _KeyHit = 0
    ' mouse input
    ' -->in developing
    'joystick input
    '-->in developing
End Sub

