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 Demo:

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

  • OpenGL Demo:

    more opengl eye-candy!

    move the mouse, and these multi-colored "hyperthreads" follow on top of a moving star field.
    hypnotic...

    please post any questions, or comments at the following thread: http://www.powerbasic.com/support/pb...ad.php?t=19891

    two parts: application, and include.

    main application source code:
    Code:
    '--------------------------------------------------------------------------------------------
    '--------------------------------------------------------------------------------------------
    ' powerbasic v7.x opengl demo: "hyperthreads"
    ' by scott martindale [email protected]
    ' april 30, 2003
    '
    ' ported from pascal code written by jan horn <http://www.sulaco.co.za/>
    '
    '--------------------------------------------------------------------------------------------
    '--------------------------------------------------------------------------------------------
    ' keyboard commands:  |
    '---------------------'
    ' thread "spread": ....................... 1-9,0
    ' increase/decrease number of threads: ... +/-
    ' line smoothing: ........................ [tab]
    '
    '--------------------------------------------------------------------------------------------
    ' notes:              |
    '---------------------'
    ' ** compiles with both pb-win(7.x), and pb-cc(3.x), though executables compiled with pb-cc
    '    are slightly larger in size.
    '
    ' ** the "threads" will begin to pull away from the mouse-cursor slightly as you move towards
    '    the edge of the window. i know about it, but in this case, isn't a big-enough of a deal
    '    to mess with (imho). use showcursor %false to hide the cursor all together.
    '
    '--------------------------------------------------------------------------------------------
    ' metastatements:     |
    '---------------------'
        #compile exe
        #dim all
        %usemacros = 1
    
        #include "win32api.inc"
        #include "openglthreads.inc"
    
    '--------------------------------------------------------------------------------------------
    ' user defined types           |
    '------------------------------'
        type svertex
            x as glfloat
            y as glfloat
            z as glfloat
        end type
    
    '--------------------------------------------------------------------------------------------
    ' macros              |
    '---------------------'
        macro fps_timer    = 1
        macro fps_interval = 500
        macro radians      = 00.01745329251994330
        macro threadlength = 100
        macro maxthreads   = 127
        macro starcount    = 255
    
       'streamlined messagebox wrapper to allow source compatability with both pb-win & pb-cc
        macro glerrorbox(text)
            macrotemp lptext, lpcaption
            dim lptext as asciiz * 33, lpcaption as asciiz * 25
            lptext = ltrim$(left$(text,32))+chr$(0)
            lpcaption = "opengl error"
            messagebox(%null,lptext,lpcaption,&h00000010&)
        end macro
    
       'the "drawing" part of the program
        macro gldraw
            macrotemp i, j, p, r, g, b
            dim i&, j&, p as svertex, r!, g!, b!
            glclear gl_color_buffer_bit or gl_depth_buffer_bit  'clear the screen and the depth buffer
            glloadidentity                                      'reset the view
            gltranslatef(0, 0, -7)
            glrotatef(90,1,0,0)
    
           'update the thread positions
                p.x = (xcoord/80!) -4.96!'mouse x
                p.y = -1.9!
                p.z = (ycoord/80!) -3.6! 'mouse y
                for i = 0 to threadcnt
                    threads(i, 0) = p
                next i
                for j = 0 to threadcnt
                    for i = threadlength to 1 step -1
                        threads(j, i).x = (threads(j,i-1).x*2! + threads(j,i).x)/2.9! + randm(j).x*rndval
                        threads(j, i).y = (threads(j,i-1).y*2! + threads(j,i).y)/2.9! + randm(j).y*rndval
                        threads(j, i).z = (threads(j,i-1).z*2! + threads(j,i).z)/2.9! + randm(j).z*rndval
                    next i
                next j
    
           'draw the threads
                for i = 0 to threadcnt-1
                    glbegin gl_line_strip
                        for j = 0 to threadlength
                           'generate thread color
                                r = 0.3!*(0.3!+sin(elapsedtime/1300!-i/50!))*(1!-j/threadlength)
                                g = 0.3!*(0.3!+sin(elapsedtime/700! -i/45!))*(1!-j/threadlength)
                                b = 0.3!*(0.3!+cos(elapsedtime/1000!-i/60!))*(1!-j/threadlength)
                                glcolor3f(r, g, b)
                                glvertex3fv varptr(threads(i,j))
                        next j
                    glend
                next i
    
           'draw the stars
                for i = 0 to starcount
                    glbegin gl_line_strip
                        glcolor3f((stars(i,0).y/5!), (stars(i, 0).y/5!), (stars(i, 0).y/5!))
                        glvertex3fv varptr(stars(i, 0))
                        glcolor3f(0,0,0)
                        glvertex3fv varptr(stars(i, 1))
                        stars(i,1) = stars(i,0)
                        stars(i,0).y = stars(i,0).y + ssp(i)
                        if stars(i,0).y >= 10 then
                            ssp(i) = rnd(0,100)/1000!
                            stars(i,0).x = (rnd(0,200)-100!)/100!
                            stars(i,0).y = 0
                            stars(i,0).z = (rnd(0,200)-100!)/100!
                            stars(i,1) = stars(i,0)
                        end if
                    glend
                next i
        end macro
        
       'set-up, and dimension global arrayed variables etc.
        macro initializeglobals
            dim g_hdc as global dword, fpscount as global dword, elapsedtime as global dword,_
                xcoord as global long, ycoord as global long, smoothing as global long,_
                rndval as global glfloat, stars(0 to starcount, 0 to 1) as global svertex,_
                threads(0 to maxthreads, 0 to threadlength) as global svertex,_
                randm(0 to maxthreads) as global svertex, ssp(0 to starcount) as global glfloat,_
                threadcnt as global long
    
            randomize timer
            threadcnt = 49
            smoothing = %false
            rndval    = 0.15!
            for i = 0 to starcount
                ssp(i) = rnd(0,100)/1000!
            next i
           'pre-calculate fixed random values
            for i = 0 to maxthreads
                randm(i).x = (rnd(0,200)-100!)/1000!
                randm(i).y = (rnd(0,200)-100!)/1000!
                randm(i).z = (rnd(0,200)-100!)/1000!
            next i
        end macro
    
    '--------------------------------------------------------------------------------------------
    'forward declarations:|
    '---------------------'
        declare sub setuppixelformat(hdc as dword)
    
    '--------------------------------------------------------------------------------------------
    'winmain function:    |
    '---------------------'
     function winmain (byval hinstance     as dword, _
                       byval hprevinstance as dword, _
                       byval lpcmdline     as asciiz ptr, _
                       byval icmdshow      as long) as long
    
       'if compiled with pb_cc, hide the console window
        #if %def(%pb_cc32)
             showwindow conshndl, %sw_hide
        #endif
    
        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)
        wce.style         = %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_cross)
        wce.hbrbackground = %null
        wce.lpszmenuname  = %null
        wce.lpszclassname = varptr(classname)
        wce.hiconsm       = loadicon(hinstance, byval %idi_application)
    
        if isfalse(registerclassex(wce)) then
            glerrorbox("unable to register window class.")
            exit function
        end if
    
      'create a window using the registered class
            hwnd = createwindowex(%ws_ex_appwindow or _                ' extended style
                              %ws_ex_windowedge,_
                              classname,_                              ' window class name
                              "powerbasic opengl demo: "+_             ' window caption
                              $dq+"hyperthreads"+$dq,_
                              %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
                glerrorbox("unable to create window")
                exit function
            end if
            
            initializeglobals
      '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.0                   'black background
            glcleardepth 1.0                                  'depth buffer setup
            gldisable gl_depth_test                           'enables depth testing
            glblendfunc gl_one, gl_one
            glenable gl_blend
            glhint gl_perspective_correction_hint, gl_nicest  'really nice perspective calculations
            glenable gl_texture_2d
            gllinewidth 2
    
            demostart = gettickcount
    
      'main message loop:
            do
                if peekmessage(msg, hwnd, 0, 0, %pm_noremove) then
                    if getmessage(msg, hwnd, 0, 0) then
                        translatemessage msg
                        dispatchmessage  msg
                        else
                            exit do
                    end if
    
                    else
                       'display "threads"...
                            incr fpscount
                            lasttime = elapsedtime
                            elapsedtime = gettickcount - demostart
                            elapsedtime = (lasttime+elapsedtime)\2
                            gldraw
                            glflush
                            swapbuffers g_hdc
                end if
            loop
    
        function = msg.wparam
    end function
    
    
    '--------------------------------------------------------------------------------------------
    'wndproc function:    |
    '---------------------'
     function wndproc (byval hwnd as dword, byval wmsg as dword, _
                       byval wparam as long, byval lparam as long)as long
    
        static hdc      as dword
        static hrc      as dword
    
        select case wmsg
    
        case %wm_activate
            if hiwrd(wparam) then
                function = 0
                exit function
            end if
    
        case %wm_create
            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
                case %vk_execute
                    if threadcnt < maxthreads then
                        incr threadcnt
                    end if
                    function = 0
                    exit function
                case &h3d
                    if threadcnt < maxthreads then
                        incr threadcnt
                    end if
                    function = 0
                    exit function
                case %vk_insert
                    if threadcnt > 1 then
                        decr threadcnt
                    end if
                    function = 0
                    exit function
                case %vk_tab
                    smoothing = not(smoothing)
                    if smoothing then
                        glenable  gl_line_smooth
                    else
                        gldisable gl_line_smooth
                    end if
                    function = 0
                    exit function
                case %vk_1
                    rndval = 0.02!
                    function = 0
                    exit function
                case %vk_2
                    rndval = 0.07!
                    function = 0
                    exit function
                case %vk_3
                    rndval = 0.15!
                    function = 0
                    exit function
                case %vk_4
                    rndval = 0.30!
                    function = 0
                    exit function
                case %vk_5
                    rndval = 0.40!
                    function = 0
                    exit function
                case %vk_6
                    rndval = 0.50!
                    function = 0
                    exit function
                case %vk_7
                    rndval = 0.60!
                    function = 0
                    exit function
                case %vk_8
                    rndval = 0.70!
                    function = 0
                    exit function
                case %vk_9
                    rndval = 0.80!
                    function = 0
                    exit function
                case %vk_0
                    rndval = 0.90!
                    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
            glloadidentity
            gluperspective(45.0, csng(lowrd(lparam)/hiwrd(lparam)), 1.0, 100.0)
            glmatrixmode gl_modelview
            glloadidentity
            function = 0
            exit function
    
        case %wm_mousemove
            xcoord = lowrd(lparam)
            ycoord = hiwrd(lparam)
    
        case %wm_timer
            if wparam >= fps_timer then
                fpscount = (fpscount*1000/fps_interval)
                setwindowtext hwnd, "powerbasic opengl demo: "+$dq+"hyperthreads"+$dq+_
                                    "   ["+ltrim$(str$(fpscount))+" fps]   "+_
                                    "[threads:"+str$(threadcnt+1)+"]"
                reset fpscount
                function = 0
            end if
    
        case else
            function = defwindowproc(hwnd, wmsg, wparam, lparam)
    
        end select
    
    end function
    
    '--------------------------------------------------------------------------------------------
      sub setuppixelformat(hdc as dword)
          local  npixelformat  as long
    
          static pfd as pixelformatdescriptor
               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)
    end sub
    '--------------------------------------------------------------------------------------------
    '--------------------------------------------------------------------------------------------
    ...and the include...
    Code:
    'hyperthreads.inc
        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_one                              = 1
        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
        macro gl_blend                            = &h0be2
        macro gl_line_strip                       = &h0003
        macro gl_line_smooth                      = &h0b20
    
        declare sub glbegin lib "opengl32.dll" alias "glbegin" (byval mode as glenum)
        declare sub glblendfunc lib "opengl32.dll" alias "glblendfunc" (byval sfactor as glenum, _
                    byval dfactor 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 gllinewidth lib "opengl32.dll" alias "gllinewidth" (byval nwidth as glfloat)
        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 glvertex3fv lib "opengl32.dll" alias "glvertex3fv" (byval v as any)
        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
    enjoy!

    ------------------
    scott martindale
    [email protected]



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