-- -- Author : Pascal Obry -- -- This is a sample program to show some OpenGL features. -- -- It compile fine under GNAT 3.04a. You must add the following -- libraries : OPENGL32.LIB GLU32.LIB GLAUX.LIB -- with Win32.Gl; with Win32.Glu; with Win32.Glaux; with Interfaces.C; with Interfaces.C.Strings; procedure OGLDouble is use Win32.Gl; use Win32.Glu; use Win32.Glaux; use Interfaces; Window_Name : aliased C.Char_Array := C.To_C ("Double Buffering"); Res : Glenum; -- callbacks must be defined with the Stdcall Convention procedure SpinDisplay; pragma Convention (Stdcall, SpinDisplay); procedure StartIdleFunc (Event : access AUX_EVENTREC); pragma Convention (Stdcall, StartIdleFunc); procedure StopIdleFunc (Event : access AUX_EVENTREC); pragma Convention (Stdcall, StopIdleFunc); procedure MyReshape (W, H : in Glsizei); pragma Convention (Stdcall, MyReshape); procedure Display; pragma Convention (Stdcall, Display); -- here start the definition of the gl scene. Spin : Glfloat := 0.0; procedure MyInit is begin GlClearColor (0.0, 0.0, 0.0, 0.0); GlColor3f (1.0, 1.0, 1.0); GlShadeModel (GL_FLAT); end MyInit; procedure MyReshape (W, H : in Glsizei) is LH : Gldouble := Gldouble (H); LW : Gldouble := Gldouble (W); begin if H = 0 then LH := 1.0; end if; GlViewPort (0, 0, Glsizei (LW), Glsizei (LH)); GlMatrixMode (GL_PROJECTION); GlLoadIdentity; if LW <= LH then GlOrtho (-50.0, 50.0, -50.0 * LH/LW, 50.0 * LH/LW, -1.0, 1.0); else GlOrtho (-50.0 * LW/LH, 50.0 * LW/LH, -50.0, 50.0, -1.0, 1.0); end if; GlMatrixMode (GL_MODELVIEW); GlLoadIdentity; end MyReshape; procedure Display is begin GlClear (GL_COLOR_BUFFER_BIT); GlPushMatrix; GlRotatef (Spin, 0.3, 1.0, 0.0); GlRectf (-25.0, -25.0, 25.0, 25.0); GlPopMatrix; GlFlush; AuxSwapBuffers; end Display; procedure SpinDisplay is begin Spin := Spin + 2.0; if Spin > 360.0 then Spin := Spin - 360.0; end if; Display; end SpinDisplay; procedure StartIdleFunc (Event : access AUX_EVENTREC) is begin AuxIdleFunc (SpinDisplay'Unrestricted_Access); end StartIdleFunc; procedure StopIdleFunc (Event : access AUX_EVENTREC) is begin AuxIdleFunc (null); end StopIdleFunc; begin AuxInitDisplayMode (AUX_DOUBLE + AUX_RGB); AuxInitPosition (0, 0, 500, 500); Res := AuxInitWindow (Window_Name (Window_Name'First)'Unchecked_Access); MyInit; AuxReshapeFunc (MyReshape'Unrestricted_Access); AuxIdleFunc (SpinDisplay'Unrestricted_Access); AuxMouseFunc (AUX_LEFTBUTTON, AUX_MOUSEDOWN, StartIdleFunc'Unrestricted_Access); AuxMouseFunc (AUX_RIGHTBUTTON, AUX_MOUSEDOWN, StopIdleFunc'Unrestricted_Access); Auxmainloop (Display'Unrestricted_Access); end OGLDouble;