Announcement

Collapse
No announcement yet.

PB3D.bas - 3D Glut/OpenGL Example

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PB3D.bas - 3D Glut/OpenGL Example

    Code:
    '******************************************************************************
    '
    ' PB3D.BAS
    '
    ' Glut/OpenGL sample for PB/DLL 6.0
    '
    ' Use the arrow keys to move through the scene.
    ' ESC to exit.
    '
    ' Needs Glut and OpenGL include file from Sublevel6
    ' http://root.tty0.org/sublevel6/ 
    '
    ' and the glut32.dll from Nate Robins
    ' http://www.xmission.com/~nate/glut.html 
    '
    ' You may want to take a look at
    ' http://www.lighthouse3d.com/opengl/glut/ 
    ' for a Glut tutorial.
    '
    ' and at the OpenGl "REDBOOK"
    ' http://fly.cc.fer.hr/~unreal/theredbook/ 
    '
    ' Tested on 98/ME and 2000.
    '
    ' by RValois, January 2002.
    '
    ' email: [email protected]
    '
    '     This program is distributed in the hope that it will be useful,
    '     but WITHOUT ANY WARRANTY; without even the implied warranty of
    '     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    '
    '     USE AT YOUR OWN RISK
    '
    '******************************************************************************
    
    #Compile Exe
    #Dim All
    #Include "gl/glut.inc"
    
    '******************************************************************************
    ' You may want to update the glut.inc. Add this
    '******************************************************************************
    %GLUT_GAME_MODE_POSSIBLE         = 1
    Declare Sub glutGameModeString             Lib "glut32.dll" Alias "glutGameModeString"             (GameStr As Asciiz)
    Declare Function glutEnterGameMode         Lib "glut32.dll" Alias "glutEnterGameMode"              () As Long
    Declare Sub glutLeaveGameMode              Lib "glut32.dll" Alias "glutLeaveGameMode"              ()
    Declare Function glutGameModeGet           Lib "glut32.dll" Alias "glutGameModeGet"                (ByVal Mode As Long) As Long
    Declare Sub glutIgnoreKeyRepeat            Lib "glut32.dll" Alias "glutIgnoreKeyRepeat"            (ByVal Ignore As Long)
    '******************************************************************************
    
    '******************************************************************************
    ' From win32api.inc
    '******************************************************************************
    %False = 0
    %True = 1
    %VK_ESCAPE   = &H1B
    Declare Sub PostQuitMessage Lib "USER32.DLL" Alias "PostQuitMessage" (ByVal nExitCode As Long)
    Declare Function ShowCursor Lib "USER32.DLL" Alias "ShowCursor" (ByVal bShow As Long) As Long
    '******************************************************************************
    
    ' Aux Structure.
    Type XYZSTRUCT
      x As Double
      y As Double
      z As Double
    End Type
    
    'Camera position increment/decrement.
    Global CamDeltaMove As Double
    'Camera angle increment/decrement.
    Global CamDeltaAngle As Double
    'OpenGL scene display list
    Global SceneList As Dword
    
    '******************************************************************************
    'SetCamPos -  Calculate and set the new camera Position/LookAt based on
    '             CamDeltaMove and CamDeltaAngle
    '******************************************************************************
    Sub SetCamPos()
      Local CamPointTo As XYZSTRUCT
      Static CamPos As XYZSTRUCT
      Static CamAngle As Double
    
      CamAngle = CamAngle + CamDeltaAngle
      CamPointTo.x  = Sin(CamAngle)
      CamPointTo.z  = -Cos(CamAngle)
    
      CamPos.x = CamPos.x + CamDeltaMove * CamPointTo.x
      CamPos.y = 1.5#
      CamPos.z = CamPos.z  + CamDeltaMove * CamPointTo.z
    
      If CamPos.x < -45 Then
        CamPos.x = -45
      End If
      If CamPos.x > 45 Then
        CamPos.x = 45
      End If
      If CamPos.z < -45 Then
        CamPos.z = -45
      End If
      If CamPos.z > 45 Then
        CamPos.z = 45
      End If
    
      glLoadIdentity
      gluLookAt CamPos.x,CamPos.y,CamPos.z, _
                CamPos.x+CamPointTo.x, CamPos.y+CamPointTo.y, CamPos.z+CamPointTo.z, _
                0.0#,1.0#,0.0#
    
    End Sub
    
    '******************************************************************************
    'ReshapeFunc -  Callback called after resize. It calculates the new ViewPort
    '******************************************************************************
    Sub ReshapeFunc CDecl(ByVal WinWidth As Long, ByVal WinHeight As Long)
      Local Ratio As Double
    
      If WinHeight Then
        Ratio = WinWidth/WinHeight
      Else
        Ratio = WinWidth
      End If
    
      glMatrixMode %GL_PROJECTION
      glLoadIdentity
      glViewPort 0,0,WinWidth,WinHeight
      gluPerspective 45#,Ratio,1#,1000#
    
      glMatrixMode %GL_MODELVIEW
      SetCamPos
    
    End Sub
    
    '******************************************************************************
    'DisplayFunc -  Callback to display the scene. Called also when Idle
    '******************************************************************************
    Sub DisplayFunc CDecl()
    
      glClear %GL_COLOR_BUFFER_BIT Or %GL_DEPTH_BUFFER_BIT
      SetCamPos
      glPushMatrix
      glCallList SceneList
      glPopMatrix
      glutSwapBuffers
    
    End Sub
    
    '******************************************************************************
    'DrawScene - Generate the Scene display list
    '******************************************************************************
    Sub DrawScene()
      Local p As Single
      Local x As Single, z As Single
    
      glBegin %GL_LINES
        glColor3f 1!,1!,0
        For p = -50! To 50! Step 5!
          glVertex3f   p,  0!,-50!
          glVertex3f   p,  0!, 50!
          glVertex3f -50!,  0!,  p
          glVertex3f  50!,  0!,  p
        Next p
      glEnd
    
      For x = -50! To 50!  Step 10!
        For z = -50! To 50! Step 10!
          glPushMatrix
          glTranslatef x, 0!, z
          glBegin %GL_TRIANGLE_FAN
            glColor3f   1!, 0!, 0!
            glVertex3f  0!, 4!, 0!
            glColor3f   0!, 1!, 0!
            glVertex3f -1!,-0!,-1!
            glColor3f   0!, 0!, 1!
            glVertex3f  1!, 0!,-1!
            glColor3f   1!, 1!, 0!
            glVertex3f  1!, 0!, 1!
            glColor3f   1!, 0!, 1!
            glVertex3f -1!, 0!, 1!
            glColor3f   0!, 1!, 0!
            glVertex3f -1!, 0!,-1!
          glEnd
          glPopMatrix
        Next z
      Next x
    
    End Sub
    
    '******************************************************************************
    'InitScene - General initialization and Scene display list creation.
    '******************************************************************************
    Sub InitScene()
    
      showCursor %False
      glEnable %GL_DEPTH_TEST
    
      SceneList = glGenLists(1)
      glNewList SceneList, %GL_COMPILE
        DrawScene
      glEndList
    
    End Sub
    
    '******************************************************************************
    'PressSpecialKeyFunc - Callback called when user press a special key
    '******************************************************************************
    Sub PressSpecialKeyFunc CDecl(ByVal Key As Long, ByVal x As Long, ByVal y As Long)
    
      Select Case Key
        Case %GLUT_KEY_LEFT
          CamDeltaAngle = -0.015#
        Case %GLUT_KEY_RIGHT
          CamDeltaAngle = 0.015#
        Case %GLUT_KEY_UP
          CamDeltaMove = 0.2#
        Case %GLUT_KEY_DOWN
          CamDeltaMove = -0.2#
      End Select
    
    End Sub
    
    '******************************************************************************
    'ReleaseSpecialKeyFunc - Callback called when user release a special key
    '******************************************************************************
    Sub ReleaseSpecialKeyFunc CDecl(ByVal Key As Long, ByVal x As Long, ByVal y As Long)
    
      Select Case Key
        Case %GLUT_KEY_LEFT
          CamDeltaAngle = 0#
        Case %GLUT_KEY_RIGHT
          CamDeltaAngle = 0#
        Case %GLUT_KEY_UP
          CamDeltaMove = 0#
        Case %GLUT_KEY_DOWN
          CamDeltaMove = 0#
      End Select
    
    End Sub
    
    '******************************************************************************
    'KeyboardFunc - Normal Keyboard callback
    '******************************************************************************
    Sub KeyboardFunc CDecl(ByVal Key As Byte, ByVal x As Long, ByVal y As Long)
    
      Select Case Key
        Case %VK_ESCAPE
          showCursor %True
          glutLeaveGameMode
          PostQuitMessage 0
      End Select
    
    End Sub
    
    '******************************************************************************
    'PBMAIN - glut Initialization
    '******************************************************************************
    Function PbMain()
    
      glutInit
      glutInitDisplayMode %GLUT_DOUBLE Or %GLUT_DEPTH Or %GLUT_RGB
      glutGameModeString "1024x768:16"
      If glutGameModeGet(%GLUT_GAME_MODE_POSSIBLE) Then
        glutEnterGameMode
      Else
        glutGameModeString "800x600:16"
        If glutGameModeGet(%GLUT_GAME_MODE_POSSIBLE) Then
          glutEnterGameMode
        Else
          glutGameModeString "640x480:16"
          If glutGameModeGet(%GLUT_GAME_MODE_POSSIBLE) Then
            glutEnterGameMode
          Else
            PostQuitMessage 0
          End If
        End If
      End If
      glutIgnoreKeyRepeat %True
      glutDisplayFunc CodePtr(DisplayFunc)
      glutIdleFunc CodePtr(DisplayFunc)
      glutKeyboardFunc CodePtr(KeyboardFunc)
      glutSpecialFunc CodePtr(PressSpecialKeyFunc)
      glutSpecialUpFunc CodePtr(ReleaseSpecialKeyFunc)
      glutReshapeFunc CodePtr(ReshapeFunc)
    
      InitScene
    
      glutMainLoop
    
    End Function
    
    '******************************************************************************
    'THE END
    '******************************************************************************

    ------------------


    [This message has been edited by Roberto Valois (edited January 05, 2002).]
    http://www.rvalois.com.br/downloads/free/

  • #2
    Code:
    '******************************************************************************
    '
    ' PB3D.BAS V 1.2
    '
    ' Glut/OpenGL sample for PB/DLL 6.1
    '
    ' Use the arrow keys to move through the scene.
    '
    ' Needs Glut and OpenGL include file from Sublevel6
    ' http://root.tty0.org/sublevel6/ 
    '
    ' and the glut32.dll from Nate Robins
    ' http://www.xmission.com/~nate/glut.html 
    '
    ' You may want to take a look at
    ' http://www.lighthouse3d.com/opengl/glut/ 
    ' for a Glut tutorial
    '
    ' and at the OpenGl "REDBOOK"
    ' http://fly.cc.fer.hr/~unreal/theredbook/ 
    '
    ' Tested on 98/ME and 2000.
    '
    ' by RValois, January 2002.
    '
    ' email: [email protected]
    '
    '     This program is distributed in the hope that it will be useful,
    '     but WITHOUT ANY WARRANTY; without even the implied warranty of
    '     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    '
    '     USE AT YOUR OWN RISK
    '
    '******************************************************************************
    
    '******************************************************************************
    ' Version historic:
    ' 1.1 6 jan 2002
    '     May be this become a game ...
    '     Added collision detection with obstacle and border
    '     The render is now controlled by timer
    '     Some minor modification (cosmetic)
    ' 1.2 9 jan 2002
    '     The collision detection routine was ridiculous. Modified.
    '     Camera new angle calculated only when necessary
    '
    '******************************************************************************
    
    #Compile Exe
    #Dim All
    #Include "gl/glut.inc"
    
    '******************************************************************************
    ' You may want to update the glut.inc. Add this
    '******************************************************************************
    %GLUT_GAME_MODE_POSSIBLE         = 1
    Declare Sub glutGameModeString             Lib "glut32.dll" Alias "glutGameModeString"             (GameStr As Asciiz)
    Declare Function glutEnterGameMode         Lib "glut32.dll" Alias "glutEnterGameMode"              () As Long
    Declare Sub glutLeaveGameMode              Lib "glut32.dll" Alias "glutLeaveGameMode"              ()
    Declare Function glutGameModeGet           Lib "glut32.dll" Alias "glutGameModeGet"                (ByVal Mode As Long) As Long
    Declare Sub glutIgnoreKeyRepeat            Lib "glut32.dll" Alias "glutIgnoreKeyRepeat"            (ByVal Ignore As Long)
    '******************************************************************************
    
    '******************************************************************************
    ' From win32api.inc
    '******************************************************************************
    %False = 0
    %True = 1
    %VK_ESCAPE   = &H1B
    Declare Sub PostQuitMessage Lib "USER32.DLL" Alias "PostQuitMessage" (ByVal nExitCode As Long)
    Declare Function ShowCursor Lib "USER32.DLL" Alias "ShowCursor" (ByVal bShow As Long) As Long
    '******************************************************************************
    
    'Camera Position types
    %NORMALPOS = %False
    %INITIALPOS = %True
    
    'Scene Sizes
    %SCENESZ = 50
    
    ' Aux Structure.
    Type XYZSTRUCT
      x As Double
      y As Double
      z As Double
    End Type
    
    'Camera position increment/decrement.
    Global CamDeltaMove As Double
    'Camera angle increment/decrement.
    Global CamDeltaAngle As Double
    'OpenGL scene display list
    Global SceneList As Dword
    
    '******************************************************************************
    'CheckCamColObstacle -  Checks Camera Collision with Obstacle
    '                       returns TRUE if detect collision
    '******************************************************************************
    Function CheckCamColObstacle(CamPos As XYZSTRUCT) As Long
      Local ObstPosX  As Double
      Local ObstPosZ  As Double
    
      ObstPosX = CLng(CamPos.x/10#) * 10#
      ObstPosZ = CLng(CamPos.z/10#) * 10#
    
      If CamPos.x > (ObstPosX  - 2#) And CamPos.x < (ObstPosX  + 2#) And CamPos.z > (ObstPosZ - 2#) And CamPos.z < (ObstPosZ + 2#) Then
        Function = %True
      Else
        Function = %false
      End If
    
    End Function
    
    '******************************************************************************
    'CheckCamColBorders  -  Checks Camera Collision with Borders
    '                       returns TRUE if detect collision
    '******************************************************************************
    Function CheckCamColBorders(CamPos As XYZSTRUCT) As Long
    
      If CamPos.x < -(%SCENESZ-2#) Or CamPos.x > (%SCENESZ-2#) Or CamPos.z < -(%SCENESZ-2#) Or CamPos.z > (%SCENESZ-2#) Then
        Function = %True
      Else
        Function = %False
      End If
    
    End Function
    
    '******************************************************************************
    'CheckCamCollision -  Checks all Camera Colision
    '                     returns TRUE if detect collision
    '******************************************************************************
    Function CheckCamCollision(CamPos As XYZSTRUCT) As Long
    
      If CheckCamColObstacle(CamPos) Or CheckCamColBorders (CamPos) Then
        Function = %True
      Else
        Function = %False
      End If
    
    End Function
    
    '******************************************************************************
    'SetCamInitPos  - Set Camera initial position
    '******************************************************************************
    Sub SetCamInitPos (ByRef CamAngle As Double, ByRef CamPointTo As XYZSTRUCT, ByRef CamPos As XYZSTRUCT)
    
      CamPos.x = -5#
      CamPos.y = 1.5#
      CamPos.z = 0#
    
      CamAngle = 0#
    
      CamPointTo.x  = Sin(CamAngle)
      CamPointTo.z  = -Cos(CamAngle)
    
    End Sub
    
    '******************************************************************************
    'SetCamNormalPos - Set camera position during game
    '******************************************************************************
    Sub SetCamNormalPos (ByRef CamAngle As Double, ByRef CamPointTo As XYZSTRUCT, ByRef CamPos As XYZSTRUCT)
      Local AuxCamPos As XYZSTRUCT
    
      If CamDeltaAngle <> 0 Then
        CamAngle = CamAngle + CamDeltaAngle
        CamPointTo.x  = Sin(CamAngle)
        CamPointTo.z  = -Cos(CamAngle)
      End If
      
      AuxCamPos.x = CamPos.x + CamDeltaMove * CamPointTo.x
      AuxCamPos.y = CamPos.y
      AuxCamPos.z = CamPos.z + CamDeltaMove * CamPointTo.z
    
      If IsFalse(CheckCamCollision (AuxCamPos)) Then
        CamPos = AuxCamPos
      End If
    
    End Sub
    
    '******************************************************************************
    'SetCamPos -  Calculate and set the new camera Position/LookAt based on
    '             CamDeltaMove and CamDeltaAngle
    '******************************************************************************
    Sub SetCamPos(ByVal InitPos As Long)
      Static CamPointTo As XYZSTRUCT
      Static CamPos As XYZSTRUCT
      Static CamAngle As Double
    
      If InitPos Then
        SetCamInitPos CamAngle, CamPointTo, CamPos
      Else
        SetCamNormalPos CamAngle, CamPointTo, CamPos
      End If
    
      glLoadIdentity
      gluLookAt CamPos.x,CamPos.y,CamPos.z, _
                CamPos.x+CamPointTo.x, CamPos.y+CamPointTo.y, CamPos.z+CamPointTo.z, _
                0.0#,1.0#,0.0#
    
    End Sub
    
    '******************************************************************************
    'ReshapeFunc -  Callback called after resize. It calculates the new ViewPort
    '******************************************************************************
    Sub ReshapeFunc CDecl(ByVal WinWidth As Long, ByVal WinHeight As Long)
      Local Ratio As Double
    
      If WinHeight Then
        Ratio = WinWidth/WinHeight
      Else
        Ratio = WinWidth
      End If
    
      glMatrixMode %GL_PROJECTION
      glLoadIdentity
      glViewPort 0,0,WinWidth,WinHeight
      gluPerspective 45#,Ratio,1#,160#
    
      glMatrixMode %GL_MODELVIEW
      SetCamPos %NORMALPOS
    
    End Sub
    
    '******************************************************************************
    'DisplayFunc -  Callback to display the scene. Called also after timer interval
    '******************************************************************************
    Sub DisplayFunc CDecl()
    
      glClear %GL_COLOR_BUFFER_BIT Or %GL_DEPTH_BUFFER_BIT
      SetCamPos %NORMALPOS
      glPushMatrix
      glCallList SceneList
      glPopMatrix
      glutSwapBuffers
    
    End Sub
    
    '******************************************************************************
    'DrawBorders -  Draw the lines that makes the Border
    '******************************************************************************
    Sub DrawBorders()
      Local i As Single
    
      glLineWidth 2!
      glBegin %GL_LINES
        glColor3f 1!,0!,1!
        For i = 1! To 3!
          glVertex3f -%SCENESZ, i,-%SCENESZ
          glVertex3f -%SCENESZ, i, %SCENESZ
    
          glVertex3f  %SCENESZ, i,-%SCENESZ
          glVertex3f  %SCENESZ, i!, %SCENESZ
    
          glVertex3f -%SCENESZ, i!,-%SCENESZ
          glVertex3f  %SCENESZ, i!,-%SCENESZ
    
          glVertex3f -%SCENESZ, i!, %SCENESZ
          glVertex3f  %SCENESZ, i!, %SCENESZ
        Next
      glEnd
      glLineWidth 1.0!
    
    End Sub
    
    '******************************************************************************
    'DrawFloor -  Draw the lines that makes the floor
    '******************************************************************************
    Sub DrawFloor()
      Local p As Single
    
      glBegin %GL_LINES
        glColor3f 1!,1!,0
        For p = -%SCENESZ-5 To %SCENESZ+5 Step 5!
          glVertex3f   p,  0!,-%SCENESZ-5
          glVertex3f   p,  0!, %SCENESZ+5
          glVertex3f -%SCENESZ-5,  0!,  p
          glVertex3f  %SCENESZ+5,  0!,  p
        Next p
      glEnd
    
    End Sub
    
    '******************************************************************************
    'DrawObstacles -  Draw the pyramids
    '******************************************************************************
    Sub DrawObstacles()
      Local x As Single, z As Single
    
        For x = -%SCENESZ To %SCENESZ  Step 10!
          For z = -%SCENESZ To %SCENESZ Step 10!
            glPushMatrix
            glTranslatef x, 0!, z
            glBegin %GL_TRIANGLE_FAN
              glColor3f   1!, 0!, 0!
              glVertex3f  0!, 4!, 0!
              glColor3f   0!, 1!, 0!
              glVertex3f -1!,-0!,-1!
              glColor3f   0!, 0!, 1!
              glVertex3f  1!, 0!,-1!
              glColor3f   0!, 1!, 0!
              glVertex3f  1!, 0!, 1!
              glColor3f   0!, 0!, 1!
              glVertex3f -1!, 0!, 1!
              glColor3f   0!, 1!, 0!
              glVertex3f -1!, 0!,-1!
            glEnd
            glPopMatrix
          Next z
        Next x
    
    End Sub
    
    '******************************************************************************
    'DrawScene - Generate the Scene display list
    '******************************************************************************
    Sub DrawScene()
    
      DrawFloor
      DrawObstacles
      DrawBorders
    
    End Sub
    
    '******************************************************************************
    'InitScene - General initialization and Scene display list creation.
    '******************************************************************************
    Sub InitScene()
    
      showCursor %False
      glEnable %GL_DEPTH_TEST
    
      SceneList = glGenLists(1)
      glNewList SceneList, %GL_COMPILE
        DrawScene
      glEndList
    
      SetCamPos %INITIALPOS
    
    End Sub
    
    '******************************************************************************
    'PressSpecialKeyFunc - Callback called when user press a special key
    '******************************************************************************
    Sub PressSpecialKeyFunc CDecl(ByVal Key As Long, ByVal x As Long, ByVal y As Long)
    
      Select Case Key
        Case %GLUT_KEY_LEFT
          CamDeltaAngle = -0.015#
        Case %GLUT_KEY_RIGHT
          CamDeltaAngle = 0.015#
        Case %GLUT_KEY_UP
          CamDeltaMove = 0.15#
        Case %GLUT_KEY_DOWN
          CamDeltaMove = -0.15#
      End Select
    
    End Sub
    
    '******************************************************************************
    'ReleaseSpecialKeyFunc - Callback called when user release a special key
    '******************************************************************************
    Sub ReleaseSpecialKeyFunc CDecl(ByVal Key As Long, ByVal x As Long, ByVal y As Long)
    
      Select Case Key
        Case %GLUT_KEY_LEFT
          CamDeltaAngle = 0#
        Case %GLUT_KEY_RIGHT
          CamDeltaAngle = 0#
        Case %GLUT_KEY_UP
          CamDeltaMove = 0#
        Case %GLUT_KEY_DOWN
          CamDeltaMove = 0#
      End Select
    
    End Sub
    
    '******************************************************************************
    'KeyboardFunc - Normal Keyboard callback
    '******************************************************************************
    Sub KeyboardFunc CDecl(ByVal Key As Byte, ByVal x As Long, ByVal y As Long)
    
      Select Case Key
        Case %VK_ESCAPE
          showCursor %True
          glutLeaveGameMode
          PostQuitMessage 0
      End Select
    
    End Sub
    
    '******************************************************************************
    'TimerFunc -  Callback called when time expire.
    '             generates another timer callback and a Call to display
    '             I´m trying to generate +/- 30 fps
    '******************************************************************************
    Sub TimerFunc CDecl(ByVal Value As Long)
    
      glutTimerFunc 33???,CodePtr(TimerFunc),0&
      DisplayFunc
    
    End Sub
    
    '******************************************************************************
    'SetSetVideoMode - Try and set a display mode
    '******************************************************************************
    Sub SetVideoMode()
    
      glutGameModeString "1024x768:16"
      If glutGameModeGet(%GLUT_GAME_MODE_POSSIBLE) Then
        glutEnterGameMode
      Else
        glutGameModeString "800x600:16"
        If glutGameModeGet(%GLUT_GAME_MODE_POSSIBLE) Then
          glutEnterGameMode
        Else
          glutGameModeString "640x480:16"
          If glutGameModeGet(%GLUT_GAME_MODE_POSSIBLE) Then
            glutEnterGameMode
          Else
            PostQuitMessage 0
          End If
        End If
      End If
    
    End Sub
    
    '******************************************************************************
    'SetCallBackCalls - Set Callback functions
    '******************************************************************************
    Sub SetCallBackCalls()
    
      glutDisplayFunc CodePtr(DisplayFunc)
      glutTimerFunc 33???,CodePtr(TimerFunc),0&
      glutKeyboardFunc CodePtr(KeyboardFunc)
      glutSpecialFunc CodePtr(PressSpecialKeyFunc)
      glutSpecialUpFunc CodePtr(ReleaseSpecialKeyFunc)
      glutReshapeFunc CodePtr(ReshapeFunc)
    
    End Sub
    
    '******************************************************************************
    'PBMAIN - glut Initialization
    '******************************************************************************
    Function PbMain()
    
      glutInit
      glutInitDisplayMode %GLUT_DOUBLE Or %GLUT_DEPTH Or %GLUT_RGB
      SetVideoMode
      glutIgnoreKeyRepeat %True
      SetCallBackCalls
      InitScene
    
    ' GO !
      glutMainLoop
    
    End Function
    
    '******************************************************************************
    'THE END
    '******************************************************************************
    ------------------


    [This message has been edited by Roberto Valois (edited January 09, 2002).]
    http://www.rvalois.com.br/downloads/free/

    Comment


    • #3
      Roberto,

      Could you please kindly post a PB/CC 2.1 version of your program.

      I downloaded glut_pre-r2.zip and opengl32_r4.zip from sublevel6 and
      glut-3.7.6-bin.zip from Nate Robin's web site and tried to compile
      the PB/DLL 6.1 program using my PB/CC 2.1 but the compiler gave
      a 426 error 'Variable expected' on line 290 in the glut.inc file
      regarding subroutine 'glutSetCursor'.

      The reason I tried your code on my PB/CC 2.1 compiler is that I
      noticed that you used FUNCTION PBMAIN() rather than
      FUNCTION WINMAIN().

      Thanks in anticipation.


      ------------------
      Regards
      Haitham
      Regards
      Haitham

      Comment


      • #4
        Roberto,

        I just compiled successfully your program (PB3D.BAS) under PB/CC 2.1 and it ran nicely

        The compiler error that was in the file glut.inc on line 290 was because of the PB/CC keyword CURSOR.
        So I changed it to HaiCursor (for Haitham's Cursor ) and the program compiled just fine.

        Also I compiled the same program under PB/CC 2.0, the executable was about 2K smaller (15,360 against 17,408 bytes) but was noticably slower, why I don't know. Maybe Lance or Tom can explain to us why.

        All it matters to me that I can use glut with PB/CC 2.1 without any problems and thanks to you Roberto, I will print the glut manual and start using it.

        have a nice day.


        ------------------
        Regards
        Haitham
        Regards
        Haitham

        Comment


        • #5
          Code:
          '******************************************************************************
          '
          ' PB3D.BAS V 1.4
          '
          ' Glut/OpenGL sample for PB/DLL 10.03
          '
          ' Use the arrow keys to move through the scene.
          '
          ' Needs Glut and OpenGL include file from José Roca
          ' http://www.jose.it-berater.org/smfforum/index.php
          ' http://www.powerbasic.com/support/pbforums/showthread.php?t=50151
          '
          ' and the glut32.dll from
          ' http://www.transmissionzero.co.uk/software/freeglut-devel/
          '
          ' You may want to take a look at
          ' http://www.lighthouse3d.com/opengl/glut/
          ' for a Glut tutorial
          '
          ' and at the OpenGl "REDBOOK"
          ' http://fly.cc.fer.hr/~unreal/theredbook/
          '
          ' Tested on XP.
          '
          ' by RValois, January 2012.
          '
          ' email: [email protected]
          '
          '     This program is distributed in the hope that it will be useful,
          '     but WITHOUT ANY WARRANTY; without even the implied warranty of
          '     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
          '
          '     USE AT YOUR OWN RISK
          '
          '******************************************************************************
          
          '******************************************************************************
          '
          ' Version historic:
          ' 1.1 6 jan 2002
          '     May be this become a game ...
          '     Added collision detection with obstacle and border
          '     The render is now controlled by timer
          '     Some minor modification (cosmetic)
          ' 1.2 9 jan 2002
          '     The collision detection routine was ridiculous. Modified.
          '     Camera new angle calculated only when necessary
          ' 1.3 17 sep 2012
          '     Updated to use José Roca Includes instead of Sublevel6 includes
          ' 1.4 18 sep 2012
          '     Fix vsync
          '     Hide cursor
          '
          '******************************************************************************
          
          #Compile Exe
          #Dim All
          #Include "freeglut.inc"
          
          
          'Camera Position types
          %NORMALPOS = %False
          %INITIALPOS = %True
          
          'Scene Sizes
          %SCENESZ = 50
          
          ' Aux Structure.
          Type XYZSTRUCT
            x As Double
            y As Double
            z As Double
          End Type
          
          'Camera position increment/decrement.
          Global CamDeltaMove As Double
          'Camera angle increment/decrement.
          Global CamDeltaAngle As Double
          'OpenGL scene display list
          Global SceneList As Dword
          
          '******************************************************************************
          'CheckCamColObstacle -  Checks Camera Collision with Obstacle
          '                       returns TRUE if detect collision
          '******************************************************************************
          Function CheckCamColObstacle(CamPos As XYZSTRUCT) As Long
            Local ObstPosX  As Double
            Local ObstPosZ  As Double
          
            ObstPosX = CLng(CamPos.x/10#) * 10#
            ObstPosZ = CLng(CamPos.z/10#) * 10#
          
            If CamPos.x > (ObstPosX  - 2#) And CamPos.x < (ObstPosX  + 2#) And CamPos.z > (ObstPosZ - 2#) And CamPos.z < (ObstPosZ + 2#) Then
              Function = %True
            Else
              Function = %false
            End If
          
          End Function
          
          '******************************************************************************
          'CheckCamColBorders  -  Checks Camera Collision with Borders
          '                       returns TRUE if detect collision
          '******************************************************************************
          Function CheckCamColBorders(CamPos As XYZSTRUCT) As Long
          
            If CamPos.x < -(%SCENESZ-2#) Or CamPos.x > (%SCENESZ-2#) Or CamPos.z < -(%SCENESZ-2#) Or CamPos.z > (%SCENESZ-2#) Then
              Function = %True
            Else
              Function = %False
            End If
          
          End Function
          
          '******************************************************************************
          'CheckCamCollision -  Checks all Camera Colision
          '                     returns TRUE if detect collision
          '******************************************************************************
          Function CheckCamCollision(CamPos As XYZSTRUCT) As Long
          
            If CheckCamColObstacle(CamPos) Or CheckCamColBorders (CamPos) Then
              Function = %True
            Else
              Function = %False
            End If
          
          End Function
          
          '******************************************************************************
          'SetCamInitPos  - Set Camera initial position
          '******************************************************************************
          Sub SetCamInitPos (ByRef CamAngle As Double, ByRef CamPointTo As XYZSTRUCT, ByRef CamPos As XYZSTRUCT)
          
            CamPos.x = -5#
            CamPos.y = 1.5#
            CamPos.z = 0#
          
            CamAngle = 0#
          
            CamPointTo.x  = Sin(CamAngle)
            CamPointTo.z  = -Cos(CamAngle)
          
          End Sub
          
          '******************************************************************************
          'SetCamNormalPos - Set camera position during game
          '******************************************************************************
          Sub SetCamNormalPos (ByRef CamAngle As Double, ByRef CamPointTo As XYZSTRUCT, ByRef CamPos As XYZSTRUCT)
            Local AuxCamPos As XYZSTRUCT
          
            If CamDeltaAngle <> 0 Then
              CamAngle = CamAngle + CamDeltaAngle
              CamPointTo.x  = Sin(CamAngle)
              CamPointTo.z  = -Cos(CamAngle)
            End If
          
            AuxCamPos.x = CamPos.x + CamDeltaMove * CamPointTo.x
            AuxCamPos.y = CamPos.y
            AuxCamPos.z = CamPos.z + CamDeltaMove * CamPointTo.z
          
            If IsFalse(CheckCamCollision (AuxCamPos)) Then
              CamPos = AuxCamPos
            End If
          
          End Sub
          
          '******************************************************************************
          'SetCamPos -  Calculate and set the new camera Position/LookAt based on
          '             CamDeltaMove and CamDeltaAngle
          '******************************************************************************
          Sub SetCamPos(ByVal InitPos As Long)
            Static CamPointTo As XYZSTRUCT
            Static CamPos As XYZSTRUCT
            Static CamAngle As Double
          
            If InitPos Then
              SetCamInitPos CamAngle, CamPointTo, CamPos
            Else
              SetCamNormalPos CamAngle, CamPointTo, CamPos
            End If
          
            glLoadIdentity
            gluLookAt CamPos.x,CamPos.y,CamPos.z, _
                      CamPos.x+CamPointTo.x, CamPos.y+CamPointTo.y, CamPos.z+CamPointTo.z, _
                      0.0#,1.0#,0.0#
          
          End Sub
          
          '******************************************************************************
          'ReshapeFunc -  Callback called after resize. It calculates the new ViewPort
          '******************************************************************************
          Sub ReshapeFunc CDecl(ByVal WinWidth As Long, ByVal WinHeight As Long)
            Local Ratio As Double
          
            If WinHeight Then
              Ratio = WinWidth/WinHeight
            Else
              Ratio = WinWidth
            End If
          
            glMatrixMode %GL_PROJECTION
            glLoadIdentity
            glViewPort 0,0,WinWidth,WinHeight
            gluPerspective 45#,Ratio,1#,160#
          
            glMatrixMode %GL_MODELVIEW
            SetCamPos %NORMALPOS
          
          End Sub
          
          '******************************************************************************
          'DisplayFunc -  Callback to display the scene. Called also after timer interval
          '******************************************************************************
          Sub DisplayFunc CDecl()
          
            glClear %GL_COLOR_BUFFER_BIT Or %GL_DEPTH_BUFFER_BIT
            SetCamPos %NORMALPOS
            glPushMatrix
            glCallList SceneList
            glPopMatrix
            glutSwapBuffers
          
          End Sub
          
          '******************************************************************************
          'DrawBorders -  Draw the lines that makes the Border
          '******************************************************************************
          Sub DrawBorders()
            Local i As Single
          
            glLineWidth 2!
            glBegin %GL_LINES
              glColor3f 1!,0!,1!
              For i = 1! To 3!
                glVertex3f -%SCENESZ, i,-%SCENESZ
                glVertex3f -%SCENESZ, i, %SCENESZ
          
                glVertex3f  %SCENESZ, i,-%SCENESZ
                glVertex3f  %SCENESZ, i!, %SCENESZ
          
                glVertex3f -%SCENESZ, i!,-%SCENESZ
                glVertex3f  %SCENESZ, i!,-%SCENESZ
          
                glVertex3f -%SCENESZ, i!, %SCENESZ
                glVertex3f  %SCENESZ, i!, %SCENESZ
              Next
            glEnd
            glLineWidth 1.0!
          
          End Sub
          
          '******************************************************************************
          'DrawFloor -  Draw the lines that makes the floor
          '******************************************************************************
          Sub DrawFloor()
            Local p As Single
          
            glBegin %GL_LINES
              glColor3f 1!,1!,0
              For p = -%SCENESZ-5 To %SCENESZ+5 Step 5!
                glVertex3f   p,  0!,-%SCENESZ-5
                glVertex3f   p,  0!, %SCENESZ+5
                glVertex3f -%SCENESZ-5,  0!,  p
                glVertex3f  %SCENESZ+5,  0!,  p
              Next p
            glEnd
          
          End Sub
          
          '******************************************************************************
          'DrawObstacles -  Draw the pyramids
          '******************************************************************************
          Sub DrawObstacles()
            Local x As Single, z As Single
          
              For x = -%SCENESZ To %SCENESZ  Step 10!
                For z = -%SCENESZ To %SCENESZ Step 10!
                  glPushMatrix
                  glTranslatef x, 0!, z
                  glBegin %GL_TRIANGLE_FAN
                    glColor3f   1!, 0!, 0!
                    glVertex3f  0!, 4!, 0!
                    glColor3f   0!, 1!, 0!
                    glVertex3f -1!,-0!,-1!
                    glColor3f   0!, 0!, 1!
                    glVertex3f  1!, 0!,-1!
                    glColor3f   0!, 1!, 0!
                    glVertex3f  1!, 0!, 1!
                    glColor3f   0!, 0!, 1!
                    glVertex3f -1!, 0!, 1!
                    glColor3f   0!, 1!, 0!
                    glVertex3f -1!, 0!,-1!
                  glEnd
                  glPopMatrix
                Next z
              Next x
          
          End Sub
          
          '******************************************************************************
          'DrawScene - Generate the Scene display list
          '******************************************************************************
          Sub DrawScene()
          
            DrawFloor
            DrawObstacles
            DrawBorders
          
          End Sub
          
          '******************************************************************************
          'InitScene - General initialization and Scene display list creation.
          '******************************************************************************
          Sub InitScene()
          
            showCursor %False
            glEnable %GL_DEPTH_TEST
          
            SceneList = glGenLists(1)
            glNewList SceneList, %GL_COMPILE
              DrawScene
            glEndList
          
            SetCamPos %INITIALPOS
          
          End Sub
          
          '******************************************************************************
          'PressSpecialKeyFunc - Callback called when user press a special key
          '******************************************************************************
          Sub PressSpecialKeyFunc CDecl(ByVal Key As Long, ByVal x As Long, ByVal y As Long)
          
            Select Case Key
              Case %GLUT_KEY_LEFT
                CamDeltaAngle = -0.015#
              Case %GLUT_KEY_RIGHT
                CamDeltaAngle = 0.015#
              Case %GLUT_KEY_UP
                CamDeltaMove = 0.15#
              Case %GLUT_KEY_DOWN
                CamDeltaMove = -0.15#
            End Select
          
          End Sub
          
          '******************************************************************************
          'ReleaseSpecialKeyFunc - Callback called when user release a special key
          '******************************************************************************
          Sub ReleaseSpecialKeyFunc CDecl(ByVal Key As Long, ByVal x As Long, ByVal y As Long)
          
            Select Case Key
              Case %GLUT_KEY_LEFT
                CamDeltaAngle = 0#
              Case %GLUT_KEY_RIGHT
                CamDeltaAngle = 0#
              Case %GLUT_KEY_UP
                CamDeltaMove = 0#
              Case %GLUT_KEY_DOWN
                CamDeltaMove = 0#
            End Select
          
          End Sub
          
          '******************************************************************************
          'KeyboardFunc - Normal Keyboard callback
          '******************************************************************************
          Sub KeyboardFunc CDecl(ByVal Key As Byte, ByVal x As Long, ByVal y As Long)
          
            Select Case Key
              Case %VK_ESCAPE
                showCursor %True
                glutLeaveGameMode
                PostQuitMessage 0
            End Select
          
          End Sub
          
          '******************************************************************************
          'TimerFunc -  Callback called when time expire.
          '             generates another timer callback and a Call to display
          '             I´m trying to generate +/- 30 fps
          '******************************************************************************
          Sub TimerFunc CDecl(ByVal Value As Long)
          
            glutTimerFunc 33???,CodePtr(TimerFunc),0&
            DisplayFunc
          
          End Sub
          
          '******************************************************************************
          'SetSetVideoMode - Try and set a display mode
          '******************************************************************************
          Sub SetVideoMode()
          
            glutGameModeString "1024x768:16"
            If glutGameModeGet(%GLUT_GAME_MODE_POSSIBLE) Then
              glutEnterGameMode
            Else
              glutGameModeString "800x600:16"
              If glutGameModeGet(%GLUT_GAME_MODE_POSSIBLE) Then
                glutEnterGameMode
              Else
                glutGameModeString "640x480:16"
                If glutGameModeGet(%GLUT_GAME_MODE_POSSIBLE) Then
                  glutEnterGameMode
                Else
                  PostQuitMessage 0
                End If
              End If
            End If
          
          End Sub
          
          '******************************************************************************
          'SetCallBackCalls - Set Callback functions
          '******************************************************************************
          Sub SetCallBackCalls()
          
            glutDisplayFunc CodePtr(DisplayFunc)
            glutTimerFunc 33???,CodePtr(TimerFunc),0&
            glutKeyboardFunc CodePtr(KeyboardFunc)
            glutSpecialFunc CodePtr(PressSpecialKeyFunc)
            glutSpecialUpFunc CodePtr(ReleaseSpecialKeyFunc)
            glutReshapeFunc CodePtr(ReshapeFunc)
          
          End Sub
          
          '******************************************************************************
          'PBMAIN - glut Initialization
          '******************************************************************************
          Function PBMain()
          
            glutInit(0,"")
            glutInitDisplayMode %GLUT_DOUBLE Or %GLUT_DEPTH Or %GLUT_RGB
            SetVideoMode
            glutIgnoreKeyRepeat %True
            SetCallBackCalls
            InitScene
            glutSetCursor(%GLUT_CURSOR_NONE)
            GL_SwapInterval(1)
          
          ' GO !
            glutMainLoop
          
          End Function
          
          '******************************************************************************
          'THE END
          '******************************************************************************
          Last edited by Roberto Valois; 18 Sep 2012, 07:44 AM.
          http://www.rvalois.com.br/downloads/free/

          Comment


          • #6
            Nice thanks. Worked great on Windows 7, kinda fun "Driving" around the scene.
            LarryC
            Website
            Sometimes life's a dream, sometimes it's a scream

            Comment


            • #7
              Thank you Roberto. I have always enjoyed your source code offerings.

              Jim

              Comment


              • #8
                James,
                I'm glad you like it, it is like a push to post more.

                Larry,
                Sometimes find myself spend to much time just doing that...

                Thank you guys,
                RValois.
                Last edited by Roberto Valois; 25 Sep 2012, 06:10 AM.
                http://www.rvalois.com.br/downloads/free/

                Comment

                Working...
                X