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

PB 7.x OpenGL Demo-- "Flying Tortilla"

  • Filter
  • Time
  • Show
Clear All
new posts

  • PB 7.x OpenGL Demo-- "Flying Tortilla"

    first off, sorry for the name; i couldn't come up with a better one
    to describe what "it" looks like, so the it kinda' stuck...

    anyway, instead of having to utilize the full opengl includes pb has
    been gracious enough to post for me in the downloads section, and for
    easier reading, i've made a smaller include file (posted first),
    then the main app code.

    if you have any questions, or comments, please respond in the
    corresponding thread started in the "programming" forum.

    thanks, and enjoy!

    scott martindale
    [email protected]

        macro glenum     = dword   '32-bit unsigned
        macro glboolean  = byte    '8-bit  unsigned
        macro glbitfield = dword   '32-bit unsigned
        macro glbyte     = byte    '8-bit  signed
        macro glshort    = integer '16-bit signed
        macro glint      = long    '32-bit signed
        macro glubyte    = byte    '8-bit  unsigned
        macro glushort   = word    '16-bit unsigned
        macro gluint     = dword   '32-bit unsigned
        macro glsizei    = long    '32-bit signed
        macro glfloat    = single  'single precision float
        macro glclampf   = single  'single precision float in [0,1]
        macro gldouble   = double  'double precision float
        macro glclampd   = double  'double precision float in [0,1]
        macro glvoid     = any     'no real need, but why not...
        macro gl_smooth                           = &h1d01
        macro gl_depth_test                       = &h0b71
        macro gl_less                             = &h0201
        macro gl_nicest                           = &h1102
        macro gl_perspective_correction_hint      = &h0c50
        macro gl_texture_2d                       = &h0de1
        macro gl_triangle_strip                   = &h0005
        macro gl_modelview                        = &h1700
        macro gl_projection                       = &h1701
        macro gl_color_buffer_bit                 = &h00004000
        macro gl_depth_buffer_bit                 = &h00000100
        declare sub glbegin lib "opengl32.dll" alias "glbegin" (byval mode as glenum)
        declare sub glclear lib "opengl32.dll" alias "glclear" (byval mask as glbitfield)
        declare sub glclearcolor lib "opengl32.dll" alias "glclearcolor" (byval red as glclampf, _
                    byval green as glclampf, byval blue as glclampf, byval alpha as glclampf)
        declare sub glcleardepth lib "opengl32.dll" alias "glcleardepth" (byval depth as glclampd)
        declare sub glcolor3f lib "opengl32.dll" alias "glcolor3f" (byval red as glfloat, _
                    byval green as glfloat, byval blue as glfloat)
        declare sub gldepthfunc lib "opengl32.dll" alias "gldepthfunc" (byval func as glenum)
        declare sub gldisable lib "opengl32.dll" alias "gldisable" (byval cap as glenum)
        declare sub glenable lib "opengl32.dll" alias "glenable" (byval cap as glenum)
        declare sub glend lib "opengl32.dll" alias "glend"
        declare sub glflush lib "opengl32.dll" alias "glflush"
        declare sub glhint lib "opengl32.dll" alias "glhint" (byval ntarget as glenum, byval mode as glenum)
        declare sub glloadidentity lib "opengl32.dll" alias "glloadidentity"
        declare sub glmatrixmode lib "opengl32.dll" alias "glmatrixmode" (byval mode as glenum)
        declare sub glrotatef lib "opengl32.dll" alias "glrotatef" (byval angle as glfloat, _
                    byval x as glfloat, byval y as glfloat, byval z as glfloat)
        declare sub glshademodel lib "opengl32.dll" alias "glshademodel" (byval mode as glenum)
        declare sub gltranslatef lib "opengl32.dll" alias "gltranslatef" (byval x as glfloat, _
                    byval y as glfloat, byval z as glfloat)
        declare sub glvertex3f lib "opengl32.dll" alias "glvertex3f" (byval x as glfloat, _
                    byval y as glfloat, byval z as glfloat)
        declare sub glviewport lib "opengl32.dll" alias "glviewport" (byval x as glint, _
                    byval y as glint, byval nwidth as glsizei, byval height as glsizei)
        declare sub glfrustum lib "opengl32.dll" alias "glfrustum" (byval nleft as gldouble, _
                    byval nright as gldouble, byval bottom as gldouble, byval top as gldouble, _
                    byval znear as gldouble, byval zfar as gldouble)
    ' gluperspective
        macro gluperspective(fovy, naspect, znear, zfar)
            macrotemp xmin, xmax, ymin, ymax
            dim xmin as double : dim xmax as double
            dim ymin as double : dim ymax as double
            ymax = znear * tan((fovy * 3.14159265358979#)/360#)
            ymin = -ymax
            xmin = ymin * naspect
            xmax = ymax * naspect
            glfrustum xmin, xmax, ymin, ymax, znear, zfar
        end macro
    ' end of include file

    [this message has been edited by scott j. martindale (edited april 22, 2003).]
    Scott Martindale
    [email protected]

  • #2
    ...and here's the main source code...
    ' PowerBASIC v7.0x OpenGL Demo: "Flying Tortilla"
    ' by Scott Martindale [email protected]
    ' April 23, 2003
    ' Based on code from Jan Horn <>
        #COMPILE EXE
        #DIM ALL
        %USEMACROS = 1
        #INCLUDE "OpenGLTortilla.INC"
        GLOBAL g_HDC          AS DWORD
        GLOBAL FPSCount       AS DWORD
        GLOBAL ElapsedTime    AS DWORD
    ' MACROS:             |
        MACRO FPS_TIMER    = 1
        MACRO FPS_INTERVAL = 1000
        MACRO RADIANS      = 00.01745329251994330
    'Forward Declarations:|
     DECLARE SUB SetupPixelFormat(hDC AS DWORD)
    'WINMAIN Function:    |
                       BYVAL hPrevInstance AS DWORD, _
                       BYVAL lpCmdLine     AS ASCIIZ PTR, _
                       BYVAL iCmdShow      AS LONG) AS LONG
        LOCAL msg       AS tagMsg
        LOCAL wce       AS WndClassEx
        LOCAL ClassName AS ASCIIZ * 80
        LOCAL hWnd      AS DWORD
        DIM S!, R!, G!, B!, I&, DemoStart???, LastTime???
        ClassName         = "PowerBasic OpenGL"
        wce.cbSize        = SIZEOF(wce)         = %CS_HREDRAW OR %CS_VREDRAW
        wce.lpfnWndProc   = CODEPTR(WndProc)
        wce.cbClsExtra    = 0
        wce.cbWndExtra    = 0
        wce.hInstance     = hInstance
        wce.hIcon         = LoadIcon(hInstance, "PBGL_EXAMPLE")
        wce.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
        wce.hbrBackground = %NULL
        wce.lpszMenuName  = %NULL
        wce.lpszClassName = VARPTR(ClassName)
        wce.hIconSm       = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)
        IF ISFALSE(RegisterClassEx(wce)) THEN
            MSGBOX "Unable to Register Window Class."
            EXIT FUNCTION
        END IF
      'Create a window using the registered class
            hWnd = CreateWindowEx(%WS_EX_APPWINDOW OR _                 ' extended style
                              ClassName,_                               ' window class name
                              "PowerBASIC OpenGL",_                     ' window caption
                              %WS_OVERLAPPEDWINDOW OR _                 ' window style
                              %WS_VISIBLE OR %WS_SYSMENU OR _
                              %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS,_
                              100, 100,_                                ' initial x, y position
                              800, 600,_                                ' initial x, y size
                              %NULL, _                                  ' parent window handle
                              %NULL, _                                  ' window menu handle
                              hInstance, _                              ' program instance handle
                              BYVAL %NULL)                              ' creation parameters
            IF hWnd = 0 THEN
                MSGBOX "Unable to create window"
                EXIT FUNCTION
            END IF
      'Display the window on the screen, and set window's OpenGL attributes
            SetTimer hWnd, FPS_TIMER, FPS_INTERVAL, 0
            ShowWindow hWnd, iCmdShow
            UpdateWindow hWnd
            SetForegroundWindow hWnd
            SetFocus hWnd
            glShadeModel GL_SMOOTH                            'Enable Smooth Shading
            glClearColor 0.0, 0.0, 0.0, 0.5                   'Black Background
            glClearDepth 1.0                                  'Depth Buffer Setup
            glEnable GL_DEPTH_TEST                            'Enables Depth Testing
            glDepthFunc GL_LESS                               'The Type Of Depth Testing To Do
            glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST  'Really Nice Perspective Calculations
            glEnable GL_TEXTURE_2D
            DemoStart = GetTickCount
      'Main message loop:
                IF PeekMessage(msg, hWnd, 0, 0, %PM_NOREMOVE) THEN
                    IF GetMessage(msg, hWnd, 0, 0) THEN
                        TranslateMessage msg
                        DispatchMessage  msg
                            EXIT DO
                    END IF
                       'Display "Tortilla"...
                            INCR FPSCount
                            LastTime = ElapsedTime
                            ElapsedTime = GetTickCount - DemoStart
                            ElapsedTime = (LastTime+ElapsedTime)\2
                            glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
                            glTranslatef 0,0,-4!
                            glRotatef ElapsedTime/40!, 1!, 1!, 1!
                            glDisable GL_TEXTURE_2D
                            glBegin GL_TRIANGLE_STRIP
                                FOR I = 0 TO 72
                                    S = 0.5!+SIN(ElapsedTime/465!)*0.2!+COS(ElapsedTime/657!)*0.1!
                                    R = 0.5!+SIN(ElapsedTime/100!+I/1.6!)*0.5!
                                    G = 0.5!+SIN(ElapsedTime/200!+720!+I/1.6!)*0.5!
                                    B = 0.5!+SIN(ElapsedTime/100!+720!+I/1.6!)*0.5!
                                    glColor3f R,G,B
                                    glVertex3f SIN(RADIANS*I*5!)*S,_
                                    glColor3f B,G,R
                                    glVertex3f SIN(RADIANS*I*5!)*S*2!,_
                                NEXT I
                            glEnd '(GL_TRIANGLE_STRIP)
                            SwapBuffers g_HDC
                END IF
        FUNCTION = msg.wParam
    'WndProc Function:    |
                       BYVAL wParam AS LONG, BYVAL lParam AS LONG)AS LONG
        STATIC hDC      AS DWORD
        STATIC hRC      AS DWORD
        SELECT CASE wMsg
            IF HIWRD(wParam) THEN
                FUNCTION = 0
                EXIT FUNCTION
            END IF
            hDC   = GetDC(hWnd)
            g_hDC = hDC
            CALL SetupPixelFormat(hDC)
            hRC = wglCreateContext(hDC)
            wglMakeCurrent hDC, hRC
            FUNCTION = 0
            EXIT FUNCTION
        CASE %WM_CLOSE
            wglMakeCurrent hDC, %NULL
            wglDeleteContext hDC
            PostQuitMessage 0
            FUNCTION = 0
            EXIT FUNCTION
        CASE %WM_CHAR
            SELECT CASE wParam
                CASE %VK_ESCAPE
                    PostQuitMessage 0
                    FUNCTION = 0
                    EXIT FUNCTION
            END SELECT
        CASE %WM_SIZE
           'Reset the viewport to new dimensions
            IF HIWRD(lParam) < 1 THEN lParam = (lParam OR &h00010000)
            glViewport 0, 0, CLNG(LOWRD(lParam)), CLNG(HIWRD(lParam))
            glMatrixMode GL_PROJECTION
            gluPerspective(45.0, CSNG(LOWRD(lParam)/HIWRD(lParam)), 1.0, 1000.0)
            glMatrixMode GL_MODELVIEW
            FUNCTION = 0
            EXIT FUNCTION
        CASE %WM_TIMER
            IF wParam >= FPS_TIMER THEN
                FPSCount = (FPSCount*1000/FPS_INTERVAL)
                SetWindowText hWnd, "PowerBASIC OpenGL"+"   ["+LTRIM$(STR$(FPSCount))+" FPS]"
                RESET FPSCount
                FUNCTION = 0
            END IF
        CASE ELSE
            FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
        END SELECT
      SUB SetupPixelFormat(hDC AS DWORD)
          LOCAL  nPixelFormat  AS LONG
               pfd.nSize           = SIZEOF(PIXELFORMATDESCRIPTOR) 'Size of UDT structure
               pfd.nVersion        = 1                             'Version. Always set to 1.
               pfd.dwFlags         = %PFD_DRAW_TO_WINDOW OR _      'Support Window
                                     %PFD_SUPPORT_OPENGL OR _      'Support OpenGL
                                     %PFD_DOUBLEBUFFER             'Support Double Buffering
               pfd.iPixelType      = %PFD_TYPE_RGBA                'Red, Green, Blue, & Alpha Mode
               pfd.cColorBits      = 32                            '32-Bit Color Mode
               pfd.cRedBits        = %NULL                         'Ignore Color and Shift Bits...
               pfd.cRedShift       = %NULL                         '...
               pfd.cGreenBits      = %NULL                         '...
               pfd.cGreenShift     = %NULL                         '...
               pfd.cBlueBits       = %NULL                         '...
               pfd.cBlueShift      = %NULL                         '...
               pfd.cAlphaBits      = %NULL                         'No Alpha Buffer
               pfd.cAlphaShift     = %NULL                         'Ignore Shift Bit.
               pfd.cAccumBits      = %NULL                         'No Accumulation Buffer
               pfd.cAccumRedBits   = %NULL                         'Ignore Accumulation Bits...
               pfd.cAccumGreenBits = %NULL                         '...
               pfd.cAccumBlueBits  = %NULL                         '...
               pfd.cAccumAlphaBits = %NULL                         '... Good Cereal!   
               pfd.cDepthBits      = 16                            '16-bit z-buffer depth
               pfd.cStencilBits    = %NULL                         'No Stencil Buffer
               pfd.cAuxBuffers     = %NULL                         'No Auxiliary Buffer
               pfd.iLayerType      = %PFD_MAIN_PLANE               'Main Drawing Plane
               pfd.bReserved       = %NULL                         'Reserved
               pfd.dwLayerMask     = %NULL                         'Ignore Layer Masks...
               pfd.dwVisibleMask   = %NULL                         '...
               pfd.dwDamageMask    = %NULL                         '...
       'Choose best matching pixel format, return index.
            nPixelFormat = ChoosePixelFormat(hDC, pfd)
       'Set pixel format to device context.
            CALL SetPixelFormat(hDC, nPixelFormat, pfd)
    [This message has been edited by Scott J. Martindale (edited April 23, 2003).]
    Scott Martindale
    [email protected]