Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

OpenGL Template File for PB 8.0

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

  • OpenGL Template File for PB 8.0

    Here is a simple OpenGL template for PB 8.0. Name the file with a .PBTpl extension (e.g. "OpenGL.PBTpl") and dump in PowerBASIC 8.0's BIN directory. Then whenever you need a quick OpenGL skeleton so you can play around with OpenGL commands just click on File/New and choose the OpenGL skeleton.

    The skeleton will initialize a fullscreen OpenGL window (sized to your desktop, so if your desktop is 1024x768 the resulting OpenGL window will be 1024x768) and create a Windows message pump. The cursor is placed where you should begin your code. Press ESC to exit the message pump loop and clean up.

    Thanks,
    Flick

    Code:
    1
    .bas
    OpenGL skeleton
    '===========================================================================================================
    '                                                  INCLUDES
    '-----------------------------------------------------------------------------------------------------------
    #INCLUDE "win32api.inc"
    #INCLUDE "gl.inc"                                       ' OpenGL
    '===========================================================================================================
    
    
    '===========================================================================================================
    '                                              GLOBAL CONSTANTS
    '-----------------------------------------------------------------------------------------------------------
    %FAIL                   =           0
    %SUCCESS                =           1
    '===========================================================================================================
    
    
    '===========================================================================================================
    '                                              GLOBAL VARIABLES
    '-----------------------------------------------------------------------------------------------------------
    GLOBAL   hWnd                   AS LONG                 ' window handle
    GLOBAL   hDC                    AS LONG                 ' private GDI device context
    GLOBAL   hRC                    AS LONG                 ' permanent rendering context
    
    GLOBAL   done                   AS LONG                 ' TRUE when app is finished
    
    GLOBAL   logEnabled             AS LONG
    GLOBAL   logHandle              AS LONG
    
    GLOBAL   gfxWidth               AS LONG
    GLOBAL   gfxHeight              AS LONG
    GLOBAL   gfxDepth               AS LONG
    GLOBAL   gfxFullscreen          AS LONG
    
    GLOBAL   keys()                 AS LONG
    '===========================================================================================================
    
    
    '===========================================================================================================
    '                                           FUNCTION DECLARATIONS
    '-----------------------------------------------------------------------------------------------------------
    DECLARE SUB ResizeGL(BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
    '===========================================================================================================
    
    '===========================================================================================================
    '                                                 FUNCTIONS
    '-----------------------------------------------------------------------------------------------------------
    FUNCTION Exist(sFilename AS STRING) AS LONG
    
        ' Checks to see if a given disk file exists
    
        LOCAL    dummy              AS LONG
    
        dummy = GETATTR(sFilename)
    
        FUNCTION = (ERRCLEAR = 0)
    
    END FUNCTION
    '-----------------------------------------------------------------------------------------------------------
    SUB OpenLog(fname AS STRING)
    
        ' Attempts to either create a new log file or open the existing one
    
        IF logEnabled THEN CloseLog
    
        logHandle = FREEFILE
        OPEN fname FOR APPEND AS #logHandle
        IF ERRCLEAR THEN EXIT SUB
    
        PRINT #logHandle, STRING$(65, "=")
        PRINT #logHandle, "Log begins at " + TIME$ + " " + DATE$
        PRINT #logHandle, STRING$(65, "-")
    
        logEnabled = 1
    
    END SUB
    '-----------------------------------------------------------------------------------------------------------
    SUB WriteLog(entry AS STRING)
    
        IF logEnabled THEN PRINT #logHandle, entry
    
    END SUB
    '-----------------------------------------------------------------------------------------------------------
    SUB CloseLog()
    
        IF logEnabled THEN
            PRINT #logHandle, STRING$(65, "-")
            PRINT #logHandle, "Log ends at " + TIME$ + " " + DATE$
            PRINT #logHandle, STRING$(65, "=")
            PRINT #logHandle,
            logEnabled = 0
        END IF
    
        CLOSE #logHandle
    
    END SUB
    '-----------------------------------------------------------------------------------------------------------
    FUNCTION InitGL(BYVAL hInstance AS LONG, _
                    BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL nDepth AS LONG, _
                    BYVAL fs AS LONG) AS LONG
    
        LOCAL    szClassName        AS ASCIIZ * 256         ' class name
        LOCAL    wc                 AS WNDCLASS
        LOCAL    dmScreenSettings   AS DEVMODE
        LOCAL    pfd                AS PIXELFORMATDESCRIPTOR
        LOCAL    PixelFormat        AS LONG
    
        ' Remember our settings
        gfxWidth      = nWidth
        gfxHeight     = nHeight
        gfxDepth      = nDepth
        gfxFullscreen = fs
    
        ' Register a window class
        szClassName      = "OpenGL"
        wc.style         = %CS_DBLCLKS OR %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC
        wc.lpfnWndProc   = CODEPTR(WndProc)
        wc.cbClsExtra    = 0
        wc.cbWndExtra    = 0
        wc.hInstance     = hInstance
        wc.hIcon         = LoadIcon(0, BYVAL %IDC_ICON)
        wc.hCursor       = LoadCursor(0, BYVAL %IDC_ARROW)
        wc.hbrBackground = 0
        wc.lpszMenuName  = 0
        wc.lpszClassName = VARPTR(szClassName)
        IF RegisterClass(wc) = 0 THEN
            WriteLog "Unable to register a window class"
            EXIT FUNCTION
        END IF
    
        ' Create a new window
        hWnd = CreateWindow(szClassName, _
                            "OpenGL", _
                            %WS_POPUP OR %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS, _
                            0, 0, nWidth, nHeight, _
                            %NULL, _
                            %NULL, _
                            hInstance, _
                            BYVAL %NULL)
        IF hWnd = 0 THEN
            WriteLog "Unable to create a window"
            EXIT FUNCTION
        END IF
    
        ' Change to fullscreen mode, if necessary
        IF fs THEN
            dmScreenSettings.dmSize       = SIZEOF(dmScreenSettings)
            dmScreenSettings.dmPelsWidth  = nWidth
            dmScreenSettings.dmPelsHeight = nHeight
            dmScreenSettings.dmBitsPerPel = nDepth
            dmScreenSettings.dmFields     = %DM_PELSWIDTH OR %DM_PELSHEIGHT OR %DM_BITSPERPEL
            IF ChangeDisplaySettings(dmScreenSettings, %CDS_FULLSCREEN) <> 0 THEN
                WriteLog "WARNING -> Unable to switch to fullscreen mode"
                gfxFullscreen = 0
            END IF
        END IF
    
        ' Create an OpenGL device context
        hDC = GetDC(hWnd)
        IF hDC = 0 THEN
            WriteLog "Unable to create an OpenGL device context"
            EXIT FUNCTION
        END IF
    
        ' Get a pixel format
        pfd.nSize           = SIZEOF(PIXELFORMATDESCRIPTOR)
        pfd.nVersion        = 1
        pfd.dwFlags         = %PFD_DRAW_TO_WINDOW OR %PFD_SUPPORT_OPENGL OR %PFD_DOUBLEBUFFER
        pfd.iPixelType      = %PFD_TYPE_RGBA
        pfd.cColorBits      = nDepth                        ' set our color depth
        pfd.cRedBits        = 0
        pfd.cRedShift       = 0
        pfd.cGreenBits      = 0
        pfd.cGreenShift     = 0
        pfd.cBlueBits       = 0
        pfd.cBlueShift      = 0
        pfd.cAlphaBits      = 0
        pfd.cAlphaShift     = 0
        pfd.cAccumBits      = 0
        pfd.cAccumRedBits   = 0
        pfd.cAccumGreenBits = 0
        pfd.cAccumBlueBits  = 0
        pfd.cAccumAlphaBits = 0
        pfd.cDepthBits      = 16                            ' 16-bit depth buffer
        pfd.cStencilBits    = 8                             '  8-bit stencil buffer
        pfd.cAuxBuffers     = 0
        pfd.iLayerType      = %PFD_MAIN_PLANE
        pfd.bReserved       = 0
        pfd.dwLayerMask     = 0
        pfd.dwVisibleMask   = 0
        pfd.dwDamageMask    = 0
        PixelFormat         = ChoosePixelFormat(hDC, pfd)
        IF PixelFormat = 0 THEN
            WriteLog "Unable to find a suitable PixelFormat"
            EXIT FUNCTION
        END IF
    
        ' Set the pixel format
        IF SetPixelFormat(hDC, PixelFormat, pfd) = 0 THEN
            WriteLog "Unable to set the PixelFormat"
            EXIT FUNCTION
        END IF
    
        ' Create an OpenGL rendering context
        hRC = wglCreateContext(hDC)
        IF hRC = 0 THEN
            WriteLog "Unable to create an OpenGL rendering context"
            EXIT FUNCTION
        END IF
    
        ' Activate the OpenGL rendering context
        IF wglMakeCurrent(hDC, hRC) = 0 THEN
            Writelog "Unable to activate the OpenGL rendering context"
            EXIT FUNCTION
        END IF
    
        ShowWindow hWnd, %SW_NORMAL
        SetForegroundWindow hWnd
        SetFocus hWnd
    
        ' Clear the screen and the depth buffer
        glClearColor 0!, 0!, 0!, 0!
        glClearDepth 1!
        glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
    
        ' Set up OpenGL state variables
        glShadeModel GL_SMOOTH
    
        ' Drop OpenGL hints how to render our graphics
        glHint GL_POINT_SMOOTH_HINT, GL_NICEST
        glHint GL_LINE_SMOOTH_HINT, GL_NICEST
        glHint GL_POLYGON_SMOOTH_HINT, GL_NICEST
        glHint GL_FOG_HINT, GL_NICEST
        glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST
    
        ' Resize the OpenGL matrix
        ResizeGL nWidth, nHeight
    
        FUNCTION = %SUCCESS
    
    END FUNCTION
    '-----------------------------------------------------------------------------------------------------------
    SUB UnInitGL(BYVAL hInstance AS LONG)
    
        IF gfxFullscreen THEN
            ' Change back to the Windows desktop if fullscreen
            ChangeDisplaySettings BYVAL %NULL, 0
        END IF
    
        ' Make the current device context not current
        wglMakeCurrent %NULL, %NULL
    
        ' Release the rendering context
        IF hRC THEN
            wglDeleteContext hRC
            hRC = 0
        END IF
    
        ' Release the device context
        IF hDC THEN
            ReleaseDC hWnd, hDC
            hDC = 0
        END IF
    
        ' Destroy the window
        IF hWnd THEN
            DestroyWindow hWnd
            hWnd = 0
        END IF
    
        ' Unregister our window class
        UnregisterClass "OpenGL", hInstance
    
        WriteLog "OpenGL was successfully uninitialized"
    
    END SUB
    '-----------------------------------------------------------------------------------------------------------
    SUB ResizeGL(BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
    
       ' "Resizes" the OpenGL screen
    
        ' Prevent a divide by 0 if the window is too small
        IF nHeight = 0 THEN nHeight = 1
    
        ' Reset the current viewport and perspective transformation
        glViewport 0, 0, nWidth, nHeight
    
    END SUB
    '-----------------------------------------------------------------------------------------------------------
    FUNCTION WndProc(BYVAL hWnd AS LONG, BYVAL uMsg AS LONG, _
                     BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
    
        ' Handle any messages sent to the window by Windows
    
        SELECT CASE AS LONG uMsg
            CASE %WM_SYSCOMMAND
                IF wParam = %SC_SCREENSAVE THEN             ' disable the Windows screen saver
                    FUNCTION = 0
                END IF
            CASE %WM_CREATE
                FUNCTION = 0
            CASE %WM_CLOSE
                PostQuitMessage 0
                FUNCTION = 0
            CASE %WM_SIZE
                ResizeGL LOWRD(lParam), HIWRD(lParam)
                FUNCTION = 0
            CASE %WM_KEYDOWN
                keys(wParam) = %TRUE
                FUNCTION = 0
            CASE %WM_KEYUP
                keys(wParam) = %FALSE
                FUNCTION = 0
            CASE ELSE
                FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
        END SELECT
    
    END FUNCTION
    '-----------------------------------------------------------------------------------------------------------
    FUNCTION WINMAIN(BYVAL hInstance AS LONG, _
                     BYVAL hPrevInstance AS LONG, _
                     BYVAL lpCmdLine AS ASCIIZ PTR, _
                     BYVAL nCmdShow AS LONG) EXPORT AS LONG
    
        LOCAL    uMsg               AS TagMsg
        LOCAL    sError             AS STRING
        LOCAL    w                  AS LONG
        LOCAL    h                  AS LONG
    
        DIM keys(255)
    
        ' Open our log
        OpenLog "opengl.txt"
    
        ' Set up OpenGL fullscreen with 32-bit colors (RGBA)
        DESKTOP GET SIZE TO w, h
        IF ISFALSE InitGL(hInstance, w, h, 32, 1) THEN
            sError = "OpenGL could not be initialized!"
            GOTO FatalError
        ELSE
            WriteLog "OpenGL was successfully initialized"
        END IF
    
        done = 0
        DO UNTIL done
            ' Windows message pump
            DO WHILE PeekMessage(uMsg, %NULL, 0, 0, %PM_REMOVE)
                IF uMsg.message = %WM_QUIT THEN
                    done = %TRUE
                ELSE
                    TranslateMessage uMsg
                    DispatchMessage uMsg
                END IF
            LOOP
    
            IF keys(27) THEN done = %TRUE
    
            glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
    
            '
            ' Start program here!
            '
            |
    
            ' Flush the gfx pipeline
            glFlush
    
            ' Swap the rendered scene to the display
            SwapBuffers hDC
        LOOP
    
        UnInitGL hInstance
    
    FatalError:
    
        ' Was there an error?
        IF LEN(sError) THEN
            MSGBOX sError
            WriteLog sError
        END IF
    
        ' Close our log
        CloseLog()
    
    END FUNCTION
    '===========================================================================================================

    ------------------
Working...
X