As a reference point for people who are in the same position I was before, here is a working basic routine .
#include once "gl/gl.bi"
#include once "gl/glu.bi"
#include once "gl/glext.bi"
#include once "crt.bi"
#include once "windows.bi"
'DEVMODE bug, found the cure here --> http://www.freebasic.net/forum/viewtopic.php?t=5659&highlight=devmode
'Will be corrected by Victor in the next freebasic update
#undef DEVMODE
Type DEVMODE
dmDeviceName As Zstring * CCHDEVICENAME
dmSpecVersion As WORD
dmDriverVersion As WORD
dmSize As WORD
dmDriverExtra As WORD
dmFields As DWORD
dmOrientation As Short
dmPaperSize As Short
dmPaperLength As Short
dmPaperWidth As Short
dmScale As Short
dmCopies As Short
dmDefaultSource As Short
dmPrintQuality As Short
dmColor As Short
dmDuplex As Short
dmYResolution As Short
dmTTOption As Short
dmCollate As Short
dmFormName As Zstring * CCHFORMNAME
dmLogPixels As WORD
dmBitsPerPel As DWORD
dmPelsWidth As DWORD
dmPelsHeight As DWORD
dmDisplayFlags As DWORD
dmDisplayFrequency As DWORD
dmICMMethod As DWORD
dmICMIntent As DWORD
dmMediaType As DWORD
dmDitherType As DWORD
dmReserved1 As DWORD
dmReserved2 As DWORD
dmPanningWidth As DWORD
dmPanningHeight As DWORD
End Type
'Win Main
Declare Function WinMain ( byval hInstance as HINSTANCE, _
byval hPrevInstance as HINSTANCE, _
szCmdLine as string, _
byval iCmdShow as integer ) as integer
'
' Entry point
'
end WinMain( GetModuleHandle( null ), null, Command$, SW_NORMAL )
'app window procedure
Declare Function WndProc( byval hWnd as HWND, _
byval message as UINT, _
byval wParam as WPARAM, _
byval lParam as LPARAM ) as LRESULT
'window creation helper
Declare Function MakeWindow(byval iWidth as integer, _
byval iHeight as integer, _
byval hInstance as HINSTANCE) as integer
Declare Sub ChangeScreenResolution (byval wwidth as integer, byval hheight as integer, byval bitsPerPixel as integer)
'OpenGL Draw sub
Declare Sub glDraw()
'OpenGL Init
Declare Sub glInit()
'Application name
Const szAppName = "FreeBasic - OpenGL Framework"
'app window handle
Dim Shared hWndWin as HWND
'app hdc
Dim Shared hdcWin as HDC
'Window resolution
const XRES = 800
const YRES = 600
dim SHARED LightAmbient(0 to 3) as single => {0.9, 0.9, 0.9,0.15} '' Ambient Light is 20% white
dim SHARED LightDiffuse(0 to 3) as single => {0.4, 0.4, 0.4,0.6} '' Diffuse Light is white
dim SHARED LightPosition(0 to 2) as single =>{0.0, 2.0, 10. } '' Position is somewhat in front of screen
DIM SHARED Material(0 to 3) AS SINGLE => {0.5, 0.5, 0.8,0.8} :' WHITE
DIM SHARED MaterialRED(0 to 3) AS SINGLE => {1.0, 0.0, 0.0,0.8} :' WHITE
DIM SHARED MaterialBLU(0 to 3) AS SINGLE => {0.0, 0.0, 1.0,0.8} :' WHITE
DIM SHARED AS INTEGER QOBJ
DIM SHARED AS INTEGER LP
DECLARE SUB DRAWVERTBAR(BYVAL PSX AS DOUBLE, BYVAL PSY AS DOUBLE, BYVAL PSZ AS DOUBLE)
' ----------------------------------
' name: WndProc
' desc: Processes windows messages
'
' ----------------------------------
function WndProc ( byval hWnd as HWND, _
byval message as UINT, _
byval wParam as WPARAM, _
byval lParam as LPARAM ) as LRESULT
'
' Process messages
'
select case( message )
'
' Key pressed
'
case WM_KEYDOWN
if( lobyte( wParam ) = 27 ) then
PostMessage( hWnd, WM_CLOSE, 0, 0 )
end if
'
' Window was closed
'
case WM_DESTROY
PostQuitMessage( 0 )
exit function
end select
'
' Message doesn't concern us, send it to the default handler
' and get result
'
function = DefWindowProc( hWnd, message, wParam, lParam )
end function
' ---------------------------------------
' name: WinMain
' desc: A win2 gui program entry point
'
' ---------------------------------------
function WinMain ( byval hInstance as HINSTANCE, _
byval hPrevInstance as HINSTANCE, _
szCmdLine as string, _
byval iCmdShow as integer ) as integer
dim wMsg as MSG
' get module instance
hInstance = GetModuleHandle(NULL)
'Create our skinned window
if MakeWindow(XRES,YRES,hInstance) = 0 then
MessageBox(NULL, "Failed to create window", szAppName, MB_ICONERROR )
return -1
end if
ShowWindow( hWndWin, iCmdShow )
UpdateWindow( hWndWin )
'Get window device context
hdcWin = GetDC(hWndWin)
'Initialize OGL window
dim pfd as PIXELFORMATDESCRIPTOR
pfd.nSize = sizeof(PIXELFORMATDESCRIPTOR)
pfd.nVersion = 1
pfd.dwFlags = PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER
pfd.dwLayerMask = PFD_MAIN_PLANE
pfd.iPixelType = PFD_TYPE_RGBA
pfd.cColorBits = 32
pfd.cDepthBits = 32
SetPixelFormat ( hdcWin, ChoosePixelFormat ( hdcWin, @pfd) , @pfd )
wglMakeCurrent ( hdcWin, wglCreateContext(hdcWin) )
'Call opengl init
glInit()
'
' Process windows messages
'
while(wMsg.message <> WM_QUIT)
if (PeekMessage (@wMsg,NULL,0,0,PM_REMOVE) <> 0) then
DispatchMessage(@wMsg)
else
glDraw()
SwapBuffers (hdcWin)
end if
wend
' Ends a process and all its threads.
ExitProcess(0)
end function
'Change The Screen Resolution
sub ChangeScreenResolution (byval wwidth as integer, byval hheight as integer, byval bitsPerPixel as integer)
dim dmScreenSettings as DEVMODE
ZeroMemory(@dmScreenSettings, sizeof (DEVMODE))
dmScreenSettings.dmSize = sizeof(DEVMODE)
dmScreenSettings.dmPelsWidth = wwidth
dmScreenSettings.dmPelsHeight = hheight
dmScreenSettings.dmBitsPerPel = bitsPerPixel
dmScreenSettings.dmFields = DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT
if (ChangeDisplaySettings (cast(LPDEVMODE,@dmScreenSettings), CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL) then
MessageBox(NULL,"Change Display Error!", szAppName,MB_OK or MB_ICONEXCLAMATION)
end -1
end if
end sub
' ------------------------------------------------------------------------
' Window creation function.
' ------------------------------------------------------------------------
Function MakeWindow(byval iWidth as integer, _
byval iHeight as integer, _
byval hInstance as HINSTANCE) as integer
function = 0
' our window class
dim wndWc as WNDCLASS
dim windowStyle as DWORD
dim windowExtendedStyle as DWORD
dim rc as RECT
' ---------------------------------------------------------
' fill window class members
' ---------------------------------------------------------
wndWc.style = CS_OWNDC
wndWc.lpfnWndProc = @WndProc
wndWc.cbClsExtra = 0
wndWc.cbWndExtra = 0
wndWc.hInstance = GetModuleHandle(NULL)
wndWc.hIcon = NULL
wndWc.hCursor = LoadCursor(0, IDC_ARROW)
wndWc.hIcon = LoadIcon(hInstance, IDI_APPLICATION) ' Load our normal icon
wndWc.hbrBackground = GetStockObject(BLACK_BRUSH)
wndWc.lpszMenuName = NULL
wndWc.lpszClassName = strptr( szAppName )
' register class
if( RegisterClass( @wndWc ) = FALSE ) then
MessageBox(NULL, "Failed to register Window Class!", szAppName, MB_ICONERROR )
exit function
end if
rc.left = 0
rc.top = 0
rc.right = XRES
rc.bottom = YRES
'Setup video mode window - Windowed / Fullscreen
dim winmode as integer
if( MessageBox(NULL,"Full Screen ?", "Screen Mode",MB_YESNO or MB_ICONQUESTION) = IDYES ) then
winmode = 0
else
winmode = 1
end if
if (winmode = 0) then
windowStyle = WS_POPUP or WS_VISIBLE
windowExtendedStyle = WS_EX_TOPMOST
ChangeScreenResolution (XRES, YRES, 32)
else
windowStyle = WS_SYSMENU or WS_POPUP or WS_VISIBLE or WS_MINIMIZEBOX
windowExtendedStyle = WS_EX_APPWINDOW
'Center window
rc.left = (GetSystemMetrics(SM_CXSCREEN) - XRES) / 2
rc.top = (GetSystemMetrics(SM_CYSCREEN) - YRES) / 2
end if
' create the window
hWndWin = CreateWindowEx(windowExtendedStyle, _
wndWc.lpszClassName, _
szAppName, _
windowStyle, _
rc.left, _
rc.top, _
rc.right, _
rc.bottom, _
HWND_DESKTOP, 0, _
GetModuleHandle(NULL), 0)
ShowCursor(false)
' return result
if (hWndWin) then
return 1
else
return 0
end if
end function
sub glInit()
QOBJ=GLUNEWQUADRIC
GLUQUADRICNORMALS (QOBJ,GLU_SMOOTH)
GLVIEWPORT 0, 50, XRES, YRES-80 '' Reset The Current Viewport
GLMATRIXMODE GL_PROJECTION '' Select The Projection Matrix
GLLOADIDENTITY
GLUPERSPECTIVE 45.0, XRES / YRES, .1, 100.0 '' Calculate The Aspect Ratio Of The Window
GLMATRIXMODE GL_MODELVIEW '' Select The Modelview Matrix
GLLOADIDENTITY '' Reset The Modelview Matrix
GLSHADEMODEL GL_SMOOTH '' Enable Smooth Shading
GLCLEARCOLOR 0.0, 0.00, 0.00,0.0
GLCLEARDEPTH 1.0 '' Depth Buffer Setup
GLENABLE GL_DEPTH_TEST '' Enables Depth Testing
GLDEPTHFUNC GL_LEQUAL '' The Type Of Depth Testing To Do
GLHINT GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST '' Really Nice Perspective Calculations
GLENABLE (GL_CULL_FACE)
GLCULLFACE(GL_BACK)
GLENABLE GL_BLEND
GLBLENDFUNC(GL_ONE_MINUS_CONSTANT_ALPHA,GL_SRC_ALPHA)
GLLINEWIDTH 1
GLENABLE GL_SMOOTH
glLightfv( GL_LIGHT1, GL_AMBIENT, @LightAmbient(0)) '' Load Light-Parameters Into GL_LIGHT1
glLightfv( GL_LIGHT1, GL_DIFFUSE, @LightDiffuse(0))
glLightfv( GL_LIGHT1, GL_POSITION, @LightPosition(0))
glEnable(GL_LIGHTING)
glEnable(GL_LIGHT1)
GLFOGF(GL_FOG_DENSITY,0.5)
GLFOGF(GL_FOG_START, 1.0)
GLFOGF(GL_FOG_END, 40.0)
GLENABLE (GL_FOG)
GLLINEWIDTH 1
GLLOADIDENTITY
end sub
sub glDraw()
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT)
GLLOADIDENTITY
GLDISABLE GL_BLEND
FOR LP=-50 TO -3 STEP 1
DRAWVERTBAR((LP*.05)*SIN(((TIMER*20)+LP)*.1)+(LP*.01)*COS(((TIMER*50)+LP)*.2),-.15,LP/5)
NEXT
GLDISABLE GL_DEPTHTEST
GLBEGIN GL_LINES
GLMATERIALFV (GL_FRONT,GL_AMBIENT_AND_DIFFUSE,@MaterialRED(0))
GLVERTEX3F -.3,-.2065,-.5
GLMATERIALFV (GL_FRONT,GL_AMBIENT_AND_DIFFUSE,@MaterialBLU(0))
GLVERTEX3F .3,-.2065,-.5
GLMATERIALFV (GL_FRONT,GL_AMBIENT_AND_DIFFUSE,@MaterialBLU(0))
GLVERTEX3F -.3,.165,-.5
GLMATERIALFV (GL_FRONT,GL_AMBIENT_AND_DIFFUSE,@MaterialRED(0))
GLVERTEX3F .3,.165,-.5
GLEND
GLENABLE GL_DEPTHTEST
GLENABLE GL_BLEND
end sub
SUB DRAWVERTBAR(BYVAL PSX AS DOUBLE, BYVAL PSY AS DOUBLE, BYVAL PSZ AS DOUBLE)
GLPUSHMATRIX
GLLOADIDENTITY
glTranslatef PSX, PSY, PSZ
glRotatef( 90, 1.0, 0.0, 0.0)
glRotatef( 0, 0.0, 1.0, 0.0)
glRotatef( TIMER*100, 0.0, 0.0, 1.0)
GLMATERIALFV (GL_FRONT,GL_AMBIENT_AND_DIFFUSE,@Material(0))
GLUCYLINDER(QOBJ,.1,.1,10,20,1)
glRotatef( 0, 1.0, 0.0, 0.0)
glRotatef( 180, 0.0, 1.0, 0.0)
glRotatef( 0, 0.0, 0.0, 1.0)
GLUDISK(QOBJ,0,.1,20,1)
GLPOPMATRIX
END SUB
