-- ----------------------------------------------------------------- -- -- -- -- This is free software; you can redistribute it and/or -- -- modify it under the terms of the GNU General Public -- -- License as published by the Free Software Foundation; either -- -- version 2 of the License, or (at your option) any later version. -- -- -- -- This software is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- -- General Public License for more details. -- -- -- -- You should have received a copy of the GNU General Public -- -- License along with this library; if not, write to the -- -- Free Software Foundation, Inc., 59 Temple Place - Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- -- ----------------------------------------------------------------- -- -- ----------------------------------------------------------------- -- -- This is a translation, to the Ada programming language, of the -- -- original C test files written by Sam Lantinga - www.libsdl.org -- -- translation made by Antonio F. Vargas - www.adapower.net/~avargas -- -- ----------------------------------------------------------------- -- with Ada.Text_IO; use Ada.Text_IO; with Ada.Float_Text_IO; use Ada.Float_Text_IO; with GNAT.OS_Lib; with SDL.Video; with SDL.Keysym; with SDL.Keyboard; with SDL.Active; with SDL.Types; use SDL.Types; with SDL.Timer; with SDL.Error; with gl_h; use gl_h; with glu_h; use glu_h; with AdaGL; use AdaGL; package body TestGL_Sprogs is use type C.unsigned; use type C.int; use type C.C_float; package Ks renames SDL.Keysym; use type Ks.Key; use type Ks.SDLMod; package Kb renames SDL.Keyboard; package A renames SDL.Active; use type A.Active_State; package T renames SDL.Timer; package Er renames SDL.Error; use type V.Surface_Flags; use type V.GrabMode; use type V.Surface_ptr; -- ====================================== procedure HotKey_ToggleFullScreen is screen : V.Surface_ptr; begin screen := V.GetVideoSurface; if V.WM_ToggleFullScreen (screen) /= 0 then Put ("Toggle fullscreen mode - now "); if (screen.flags and V.FULLSCREEN) /= 0 then Put_Line (" fullscreen"); else Put_Line ("windowed"); end if; else Put_Line ("Unable to toggle fullscreen mode"); end if; end HotKey_ToggleFullScreen; -- ============================================= procedure HotKey_ToggleGrab is mode : V.GrabMode; begin Put_Line ("Ctrl-G: toggling input grab!"); mode := V.WM_GrabInput (V.GRAB_QUERY); if mode = V.GRAB_ON then Put_Line ("Grab was on"); else Put_Line ("Grab was off"); end if; if mode /= 0 then mode := 0; else mode := 1; end if; mode := V.WM_GrabInput (mode); if mode = V.GRAB_ON then Put_Line ("Grab is now on"); else Put_Line ("Grab is now off"); end if; end HotKey_ToggleGrab; -- ====================================== procedure HotKey_Iconify is begin Put_Line ("Ctrl-Z: iconifying window!"); V.WM_IconifyWindow; end HotKey_Iconify; -- ====================================== procedure HandleEvent (Result : out Boolean; event : in out Ev.Event) is done : Boolean := False; begin case event.the_type is when Ev.ISACTIVEEVENT => -- See what happened Put ("App"); if event.active.gain /= 0 then Put ("gained "); else Put ("lost "); end if; if (event.active.state and A.APPACTIVE) /= 0 then Put ("active "); elsif (event.active.state and A.APPMOUSEFOCUS) /= 0 then Put ("mouse "); elsif (event.active.state and A.APPINPUTFOCUS) /= 0 then Put ("input "); end if; Put_Line ("focus"); when Ev.KEYDOWN => if event.key.keysym.sym = Ks.K_ESCAPE then done := True; end if; if (event.key.keysym.sym = Ks.K_g) and ((event.key.keysym.the_mod and Ks.KMOD_CTRL) /= 0) then HotKey_ToggleGrab; end if; if (event.key.keysym.sym = Ks.K_z) and ((event.key.keysym.the_mod and Ks.KMOD_CTRL) /= 0) then HotKey_Iconify; end if; if (event.key.keysym.sym = Ks.K_RETURN) and ((event.key.keysym.the_mod and Ks.KMOD_ALT) /= 0) then HotKey_ToggleFullScreen; end if; Put_Line ("key '" & CS.Value (Kb.GetKeyName (event.key.keysym.sym)) & "' pressed"); when Ev.QUIT => done := True; when others => null; end case; Result := done; end HandleEvent; -- ====================================== image : V.Surface_ptr := null; x : C.int := 0; y : C.int := 0; delta_x : C.int := 1; delta_y : C.int := 1; last_moved : Uint32 := 0; -- ====================================== procedure DrawSDLLogo is dst : V.Rect; screen : V.Surface_ptr; begin if image = null then declare temp : V.Surface_ptr; begin temp := V.LoadBMP (CS.New_String ("icon.bmp")); if temp = null then return; end if; image := V.CreateRGBSurface ( V.SWSURFACE, temp.w, temp.h, 32, -- BYTEORDER = LIL_ENDIAN 16#000000FF#, 16#0000FF00#, 16#00FF0000#, 16#FF000000# -- BYTEORDER /= LILL_ENDIAN -- 16#FF000000#, -- 16#00FF0000#, -- 16#0000FF00#, -- 16#000000FF# ); if image /= null then V.BlitSurface (temp, null, image, null); end if; V.FreeSurface (temp); if image = null then return; end if; end; end if; screen := V.GetVideoSurface; -- show the image on the screen dst := (Sint16 (x), Sint16 (y), Uint16 (image.w), Uint16 (image.h)); -- -- Move it around -- Note that we do not clear the old position. This is because we -- perform a glClear() which clears the framebuffer and then only -- update the new area. -- Note that you can also achieve interesting effects by modifying -- the screen surface alpha channel. It's set to 255 by default.. if T.GetTicks - last_moved > 100 then x := x + delta_x; if x < 0 then x := 0; delta_x := -delta_x; elsif x + image.w > screen.w then x := screen.w - image.w; delta_x := -delta_x; end if; y := y + delta_y; if y < 0 then y := 0; delta_y := -delta_y; elsif y + image.h > screen.h then y := screen.h - image.h; delta_y := -delta_y; end if; V.BlitSurface (image, null, screen, dst); end if; V.Update_Rect (screen, dst); end DrawSDLLogo; -- ====================================== procedure RunGLTest (video_flags : in out V.Surface_Flags; logo : Boolean; slowly : Boolean; bppixel : C.int; gamma : C.C_float) is bpp : C.int := bppixel; type rgb_size_Array is array (0 .. 2) of C.int; pragma Convention (C, rgb_size_Array); rgb_size: rgb_size_Array; w : C.int := 800; -- 1024; -- 640; h : C.int := 600; -- 768; -- 480; done : Boolean := False; frames : C.int; start_time, this_time : Uint32; type Colors_Array is array (0 .. 7) of Three_GLfloat_Vector; color : Colors_Array := ((1.0, 1.0, 0.0), (1.0, 0.0, 0.0), (0.0, 0.0, 0.0), (0.0, 1.0, 0.0), (0.0, 1.0, 1.0), (1.0, 1.0, 1.0), (1.0, 0.0, 1.0), (0.0, 0.0, 1.0)); type Vertices_Array is array (0 .. 7) of Three_GLfloat_Vector; cube : Vertices_Array := (( 0.5, 0.5, -0.5), ( 0.5, -0.5, -0.5), (-0.5, -0.5, -0.5), (-0.5, 0.5, -0.5), (-0.5, 0.5, 0.5), ( 0.5, 0.5, 0.5), ( 0.5, -0.5, 0.5), (-0.5, -0.5, 0.5)); value : aliased C.int; use type C.char; Poll_Event_Result : C.int; begin if SDL.Init (SDL.INIT_VIDEO) < 0 then Put_Line ("Couldn't initialize SDl: " & Er.Get_Error); GNAT.OS_Lib.OS_Exit (1); end if; -- See if we should detect the display depth if bpp = 0 then if V.GetVideoInfo.vfmt.BitsPerPixel <= 8 then bpp := 8; else bpp := 16; -- More doesn seem to work end if; end if; -- set the flags we want to use for setting the video mode if logo then video_flags := video_flags or V.OPENGLBLIT; else video_flags := video_flags or V.OPENGL; end if; -- if CL.Argument_Count > 0 then -- if CL.Argument (1) = "-fullscreen" then -- video_flags := video_flags or V.FULLSCREEN; -- end if; -- end if; -- Initilize the display case bpp is when 8 => rgb_size := (2, 3, 3); when 15 | 16 => rgb_size := (5, 5, 5); when others => rgb_size := (8, 8, 8); end case; V.GL_SetAttribute (V.GL_RED_SIZE, rgb_size (0)); V.GL_SetAttribute (V.GL_GREEN_SIZE, rgb_size (1)); V.GL_SetAttribute (V.GL_BLUE_SIZE, rgb_size (2)); V.GL_SetAttribute (V.GL_DEPTH_SIZE, 16); V.GL_SetAttribute (V.GL_DOUBLEBUFFER, 1); if V.SetVideoMode (w, h, bpp, video_flags) = null then Put_Line ("Couldn't set GL mode: " & Er.Get_Error); SDL.SDL_Quit; GNAT.OS_Lib.OS_Exit (1); end if; New_Line; Put_Line ("Vendor :" & glGetString (GL_VENDOR)); Put_Line ("Renderer :" & glGetString (GL_RENDERER)); Put_Line ("Version :" & glGetString (GL_VERSION)); Put_Line ("Extensions :" & glGetString (GL_EXTENSIONS)); New_Line; V.GL_GetAttribute (V.GL_RED_SIZE, value); Put_Line ("GL_RED_SIZE: requested " & C.int'Image (rgb_size (0)) & ", got" & C.int'Image (value)); V.GL_GetAttribute (V.GL_GREEN_SIZE, value); Put_Line ("GL_GREEN_SIZE: requested " & C.int'Image (rgb_size (1)) & ", got" & C.int'Image (value)); V.GL_GetAttribute (V.GL_BLUE_SIZE, value); Put_Line ("GL_BLUE_SIZE: requested " & C.int'Image (rgb_size (2)) & ", got" & C.int'Image (value)); V.GL_GetAttribute (V.GL_DEPTH_SIZE, value); Put_Line ("GL_DEPTH_SIZE: requested " & C.int'Image (bpp) & ", got" & C.int'Image (value)); V.GL_GetAttribute (V.GL_DOUBLEBUFFER, value); Put_Line ("GL_DOUBLEBUFFER_SIZE: requested 1, got" & C.int'Image (value)); -- Set the window manager title bar V.WM_SetCaption (CS.New_String ("SDL GL test"), CS.New_String ("testgl")); -- Set the gamma for the window if gamma /= 0.0 then V.SetGamma (gamma, gamma, gamma); end if; glViewport (0, 0, GLsizei (w), GLsizei (h)); glMatrixMode (GL_PROJECTION); glLoadIdentity; glOrtho (-2.0, 2.0, -2.0, 2.0, -20.0, 20.0); glMatrixMode (GL_MODELVIEW); glLoadIdentity; glEnable (GL_DEPTH_TEST); glDepthFunc (GL_LESS); glShadeModel (GL_SMOOTH); -- Loop until done start_time := T.GetTicks; frames := 0; while not done loop declare gl_error : GLenum; sdl_error : CS.chars_ptr; event : Ev.Event; begin -- Do our drawing, too glClearColor (0.0, 0.0, 0.0, 1.0); glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); glBegin (GL_QUADS); -- SHADED_CUBE glColor3fv (color (0)); glVertex3fv (cube (0)); glColor3fv (color (1)); glVertex3fv (cube (1)); glColor3fv (color (2)); glVertex3fv (cube (2)); glColor3fv (color (3)); glVertex3fv (cube (3)); glColor3fv (color (3)); glVertex3fv (cube (3)); glColor3fv (color (4)); glVertex3fv (cube (4)); glColor3fv (color (7)); glVertex3fv (cube (7)); glColor3fv (color (2)); glVertex3fv (cube (2)); glColor3fv (color (0)); glVertex3fv (cube (0)); glColor3fv (color (5)); glVertex3fv (cube (5)); glColor3fv (color (6)); glVertex3fv (cube (6)); glColor3fv (color (1)); glVertex3fv (cube (1)); glColor3fv (color (5)); glVertex3fv (cube (5)); glColor3fv (color (4)); glVertex3fv (cube (4)); glColor3fv (color (7)); glVertex3fv (cube (7)); glColor3fv (color (6)); glVertex3fv (cube (6)); glColor3fv (color (5)); glVertex3fv (cube (5)); glColor3fv (color (0)); glVertex3fv (cube (0)); glColor3fv (color (3)); glVertex3fv (cube (3)); glColor3fv (color (4)); glVertex3fv (cube (4)); glColor3fv (color (6)); glVertex3fv (cube (6)); glColor3fv (color (1)); glVertex3fv (cube (1)); glColor3fv (color (2)); glVertex3fv (cube (2)); glColor3fv (color (7)); glVertex3fv (cube (7)); -- FLAT CUBE -- glColor3f(1.0, 0.0, 0.0); -- glVertex3fv(cube (0)); -- glVertex3fv(cube (1)); -- glVertex3fv(cube (2)); -- glVertex3fv(cube (3)); -- glColor3f(0.0, 1.0, 0.0); -- glVertex3fv(cube (3)); -- glVertex3fv(cube (4)); -- glVertex3fv(cube (7)); -- glVertex3fv(cube (2)); -- glColor3f(0.0, 0.0, 1.0); -- glVertex3fv(cube (0)); -- glVertex3fv(cube (5)); -- glVertex3fv(cube (6)); -- glVertex3fv(cube (1)); -- glColor3f(0.0, 1.0, 1.0); -- glVertex3fv(cube (5)); -- glVertex3fv(cube (4)); -- glVertex3fv(cube (7)); -- glVertex3fv(cube (6)); -- glColor3f(1.0, 1.0, 0.0); -- glVertex3fv(cube (5)); -- glVertex3fv(cube (0)); -- glVertex3fv(cube (3)); -- glVertex3fv(cube (4)); -- glColor3f(1.0, 0.0, 1.0); -- glVertex3fv(cube (6)); -- glVertex3fv(cube (1)); -- glVertex3fv(cube (2)); -- glVertex3fv(cube (7)); -- END CUBE glEnd; glMatrixMode (GL_MODELVIEW); glRotatef (5.0, 1.0, 1.0, 1.0); -- Draw 2D logo onto the 3D display if logo then DrawSDLLogo; end if; V.GL_SwapBuffers; -- Check for errors conditions gl_error := glGetError; if gl_error /= GL_NO_ERROR then Put_Line ("testgl: SDL error '" & GLenum'Image(gl_error)); end if; sdl_error := Er.GetError; if CS.Value (sdl_error)(0) /= C.nul then Put_Line ("testgl: SDL error '" & CS.Value (sdl_error)); Er.ClearError; end if; -- Allow the user what's happening if slowly then T.SDL_Delay (20); end if; -- Check if there's a pending event loop Ev.PollEventVP (Poll_Event_Result, event); exit when Poll_Event_Result = 0; HandleEvent (done, event); end loop; frames := frames + 1; end; end loop; -- Print out the frames per second this_time := T.GetTicks; if this_time /= start_time then Put ((Float (frames) / Float (this_time - start_time)) * 1000.0, 3, 2, 0); Put_Line (" FPS"); end if; -- Destroy our GL context, etc SDL.SDL_Quit; end RunGLTest; -- ====================================== end TestGL_Sprogs;