Source file : glut-windows.adb
------------------------------------------------------------------------------
-- File: GLUT-Windows.adb
-- Description: models a GLUT window
-- Copyright (c) Gautier de Montmollin/Rod Kay 2006..2007
------------------------------------------------------------------------------
--with opengl.glx;
with GL, GL.IO, GL.Frustums, GLU, GLUT;
with GLOBE_3D.Math,
GLOBE_3D.Software_Anti_Aliasing,
GLOBE_3D.Aux;
with Actors;
with GLUT_2D; --, GLUT_Exit;
-- with Ada.Text_IO;
with Ada.Numerics; use Ada.Numerics;
with Ada.Unchecked_Conversion;
-- with Ada.Containers.Generic_Array_Sort;
with Ada.Calendar;
-- with System.Storage_Elements;
package body GLUT.Windows is
package G3D renames GLOBE_3D;
package G3DM renames G3D.Math;
deg2rad : constant := Pi / 180.0;
GLUT_Problem : exception;
-- current_Window : - for accessing the current GLUT window
-- - used by GLUT callbacks to determine the Window to which a callback event relates.
--
function current_Window return Window_view
is
use GL;
function to_Window is new Ada.Unchecked_Conversion (System.Address, GLOBE_3D.p_Window);
begin
return GLUT.Windows.Window_view (to_Window (GetWindowData));
end current_Window;
procedure Name_is (Self : in out Window; Now : in String)
is
begin
Self.Name := To_Unbounded_String (Now);
end Name_is;
function Name (Self : in Window) return String
is
begin
return To_String (Self.Name);
end Name;
function is_Closed (Self : in Window) return Boolean
is
begin
return Self.is_Closed;
end is_Closed;
procedure Prepare_default_lighting (Self : in out Window;
fact : in GL.Float)
is
use GL, G3D;
proto_light : Light_definition := (position => (0.0, 500.0, 0.0, 1.0),
ambient => (0.3, 0.3, 0.3, fact),
diffuse => (0.9, 0.9, 0.9, fact),
specular => (0.05, 0.05, 0.01, fact));
begin
Enable( LIGHTING );
G3D.Define (1, proto_light);
Self.frontal_light := proto_light;
proto_light.diffuse := (0.5, 0.9, 0.5, fact);
G3D.Define (2, proto_light);
proto_light.diffuse := (0.2, 0.0, 0.9, fact);
proto_light.specular := (1.0, 1.0, 1.0, fact);
G3D.Define (3, proto_light);
proto_light.position := (-3.0, 4.0, 10.0, 1.0);
G3D.Define (4, proto_light);
proto_light.position := (3.0, -4.0, 10.0, 1.0);
proto_light.ambient := (0.6, 0.6, 0.6, 0.1);
G3D.Define (5, proto_light);
proto_light.ambient := (0.6, 0.0, 0.0, 0.1);
G3D.Define (6, proto_light);
proto_light.ambient := (0.0, 0.6, 0.0, 0.1);
G3D.Define (7, proto_light);
proto_light.ambient := (0.0, 0.0, 0.6, 0.1);
G3D.Define (8, proto_light);
G3D.Switch_lights (True);
G3D.Switch_light (2, False);
G3D.Switch_light (3, False);
G3D.Switch_light (4, False);
G3D.Switch_light (5, False);
G3D.Switch_light (6, False);
G3D.Switch_light (7, False);
G3D.Switch_light (8, False);
end Prepare_default_lighting;
procedure Clear_modes is
use GL;
begin
Disable( BLEND );
Disable( LIGHTING );
Disable( AUTO_NORMAL );
Disable( NORMALIZE );
Disable( DEPTH_TEST );
end Clear_modes;
procedure Reset_for_3D (Self : in out Window'Class)
is
pragma Unreferenced (Self);
use GL, G3D, G3D.REF;
begin
MatrixMode (MODELVIEW); -- (tbd: still needed ?) ... The matrix generated by GLU.Perspective is multipled by the current matrix
ShadeModel (SMOOTH); -- GL's default is SMOOTH, vs FLAT
--ShadeModel (FLAT); -- GL's default is SMOOTH, vs FLAT
ClearColor (0.0, 0.0, 0.0, 0.0); -- Specifies clear values for color buffer(s)
ClearAccum (0.0, 0.0, 0.0, 0.0); -- Specifies clear values for the accumulation buffer
end Reset_for_3D;
procedure enable_Viewport_and_Perspective (Self : in out Window'Class) -- tbd: move projection matrix to 'window resize'.
is
use GL, G3D, G3D.REF;
begin
Viewport (0, 0, Self.main_size_x, Self.main_size_y);
MatrixMode (PROJECTION);
LoadIdentity;
GLU.Perspective(fovy => Self.Camera.FoVy, -- field of view angle (deg) in the y direction
aspect => Self.Camera.Aspect, -- x/y aspect ratio
zNear => Self.Camera.near_plane_Distance, -- distance from the viewer to the near clipping plane
zFar => Self.Camera.far_plane_Distance); -- distance from the viewer to the far clipping plane
Get (GL.PROJECTION_MATRIX, Self.Camera.projection_matrix (1, 1)'Unchecked_Access); -- Get the current PROJECTION matrix from OpenGL
Self.Camera.projection_matrix := G3D.Math.Transpose (Self.Camera.projection_matrix);
MatrixMode (MODELVIEW); -- The matrix generated by GLU.Perspective is multipled by the current matrix
end enable_Viewport_and_Perspective;
procedure set_Size (Self : in out Window'Class; width, height : Integer)
is
use GLOBE_3D, GL; use G3D.REF;
half_fov_max_rads : Real;
Tan_of_half_fov_max_rads : Real;
begin
Self.main_size_x := GL.Sizei (width);
Self.main_size_y := GL.Sizei (height);
Self.Camera.clipper.main_clipping.X1 := 0;
Self.Camera.clipper.main_clipping.Y1 := 0;
Self.Camera.clipper.main_clipping.X2 := width - 1;
Self.Camera.clipper.main_clipping.Y2 := height - 1;
Self.Camera.Aspect := GL.Double (Self.main_size_x) / GL.Double (Self.main_size_y);
half_fov_max_rads := 0.5 * Self.Camera.FoVy * deg2rad;
Tan_of_half_fov_max_rads := Tan (half_fov_max_rads);
Self.Camera.near_plane_Height := Self.Camera.near_plane_Distance * Tan_of_half_fov_max_rads;
Self.Camera.near_plane_Width := Self.Camera.near_plane_Height * Self.Camera.Aspect;
Self.Camera.far_plane_Height := Self.Camera.far_plane_Distance * Tan_of_half_fov_max_rads;
Self.Camera.far_plane_Width := Self.Camera.far_plane_Height * Self.Camera.Aspect;
if Self.Camera.Aspect > 1.0 then -- x side angle broader than y side angle
half_fov_max_rads := Arctan (Self.Camera.Aspect * Tan_of_half_fov_max_rads);
end if;
Self.Camera.clipper.max_dot_product := Sin (half_fov_max_rads);
end set_Size;
-- Procedures passed to GLUT:
-- Window_Resize, Keyboard, Motion, Menu, Mouse, Display
procedure Window_Resize (width, height : Integer)
is
the_Window : constant GLUT.Windows.Window_view := current_Window;
begin
the_Window.forget_mouse := 5;
set_Size (the_Window.all, width, height);
Reset_for_3D (the_Window.all);
end Window_Resize;
procedure Menu (value : Integer) is
begin
case value is
when 1 => -- GLUT.GameModeString (Full_Screen_Mode);
GLUT.FullScreen;
-- res := GLUT.EnterGameMode;
GLUT.SetCursor (GLUT.CURSOR_NONE);
current_Window.forget_mouse := 10;
current_Window.full_screen := True;
when 2 => null; --GLUT_exit;
when others => null;
end case;
end Menu;
pragma Unreferenced (Menu);
procedure Display_status (Self : in out Window;
sec : GLOBE_3D.Real)
is
use GL, G3D, G3D.Aux, G3D.REF, G3DM;
light_info : String(1..8);
begin
PushMatrix;
Disable( LIGHTING );
Disable( TEXTURE_2D );
Color( red => 0.7,
green => 0.7,
blue => 0.6);
GLUT_2D.Text_output ((1.0, 0.0, 0.0), "(x)", GLUT_2D.Times_Roman_24 );
GLUT_2D.Text_output ((0.0, 1.0, 0.0), "(y)", GLUT_2D.Times_Roman_24 );
GLUT_2D.Text_output ((0.0, 0.0, 1.0), "(z)", GLUT_2D.Times_Roman_24 );
GLUT_2D.Text_output (0, 50, Self.main_size_x, Self.main_size_y,
"Eye: " & Coords (Self.Camera.clipper.eye_position),
GLUT_2D.Helvetica_10);
GLUT_2D.Text_output (0, 60, Self.main_size_x, Self.main_size_y,
"View direction: " & Coords (Self.Camera.clipper.view_direction),
GLUT_2D.Helvetica_10);
for i in light_info'Range loop
if Is_light_switched(i) then
light_info(i):= Character'Val(Character'Pos('0')+i);
else
light_info(i):= 'x';
end if;
end loop;
GLUT_2D.Text_output (0, 70, Self.main_size_x, Self.main_size_y, "Lights: (" & light_info & ')', GLUT_2D.Helvetica_10);
if sec > 0.0 then
GLUT_2D.Text_output (0, 130, Self.main_size_x, Self.main_size_y, "FPS: " & Integer'Image(Integer(1.0/sec)), GLUT_2D.Helvetica_10);
end if;
if Self.is_capturing_Video then
GLUT_2D.Text_output (0, 150, Self.main_size_x, Self.main_size_y, "*recording*", GLUT_2D.Helvetica_10);
end if;
declare
use status_Line_Vectors;
C : status_Line_Vectors.Cursor := Self.extra_Status.First;
L : status_Line;
begin
while Has_Element (C)
loop
L := Element (C);
GLUT_2D.Text_output (L.X, L.Y,
Self.main_size_x, Self.main_size_y,
To_String (L.Text),
GLUT_2D.Helvetica_10);
Next (C);
end loop;
Self.extra_Status.Clear;
end;
PopMatrix;
end Display_status;
function Frames_per_second (Self : in Window) return Float
is
use type GL.Double;
begin
return Float (1.0 / (Self.average * 0.001));
end Frames_per_second;
procedure Graphic_display (Self : in out Window'Class;
Extras : in GLOBE_3D.Visual_array := GLOBE_3D.null_Visuals)
is
use GL, G3D;
begin
if Self.rend = null then
raise Program_Error with
"You need to define a renderer with Self.Set_renderer(My_Renderer'Access)";
else
Self.rend (Self.Objects (1 .. Self.object_Count) & Extras, Self.Camera);
end if;
if Self.show_Status then
Display_status (Self, Self.average * 0.001);
end if;
end Graphic_display;
procedure Fill_screen (Self : in out Window'Class;
Extras : in GLOBE_3D.Visual_array := GLOBE_3D.null_Visuals)
is
use GL;
procedure Display
is
begin
Graphic_display (Self, Extras);
end Display;
package SAA is new GLOBE_3D.Software_Anti_Aliasing (Display);
begin
case Self.Smoothing is
when software =>
SAA.Set_quality(SAA.Q3);
for SAA_Phase in 1..SAA.Anti_Alias_phases loop
SAA.Display_with_Anti_Aliasing(SAA_Phase);
end loop;
when hardware =>
Enable( MULTISAMPLE_ARB ); -- (if not done yet)
--ClearColor (0.0, 0.0, 0.0, 1.0); -- Specifies clear values for color buffer(s)
--ClearColor (0.15, 0.4, 0.15, 1.0); -- Specifies clear values for color buffer(s) -- tbd: make clear color user-settable
ClearColor (0.0, 0.0, 0.0, 1.0); -- Specifies clear values for color buffer(s) -- tbd: make clear color user-settable
ClearAccum (0.0, 0.0, 0.0, 0.0); -- Specifies clear values for the accumulation buffer
Graphic_display (Self, Extras);
Flush;
when none =>
Graphic_display (Self, Extras);
Flush;
end case;
GLUT.SwapBuffers;
end Fill_screen;
procedure Reset_eye (Self : in out Window'Class) is
begin
Self.Camera.clipper.eye_position := (0.0, 5.0, 4.0);
Self.Camera.world_rotation := GLOBE_3D.Id_33;
end Reset_eye;
function Image(Date: Ada.Calendar.Time) return String;
-- Proxy for Ada 2005 Ada.Calendar.Formatting.Image
procedure Main_operations (Self : access Window;
time_Step : G3D.Real;
Extras : in GLOBE_3D.Visual_array := GLOBE_3D.null_Visuals)
is
use GL, G3D, G3DM, G3D.REF, Game_control;
elaps, time_now : Integer;
gx, gy : GL.Double; -- mouse movement since last call
seconds : GL.Double; -- seconds since last image
alpha_correct : Boolean;
attenu_t, attenu_r : Real;
begin
if not Self.is_Visible
or else Self.is_Closed
then
return;
end if;
enable_Viewport_and_Perspective (Self.all); -- nb: must be done prior to setting frustum planes (when using gl.frustums.current_Planes)
-- Control of lighting
--
-- self.frontal_light.position := (GL.Float (self.Camera.Clipper.eye_Position (0)),
-- GL.Float (self.Camera.Clipper.eye_Position (1)),
-- GL.Float (self.Camera.Clipper.eye_Position (2)),
-- 1.0);
-- G3D.Define (1, self.frontal_light);
for c in n1..n8 loop
if Self.game_command (c) then
Reverse_light_switch(1 + Command'Pos(c) - Command'Pos(n1));
end if;
end loop;
-- Display screen
--
Fill_screen (Self.all, Extras);
-- Timer management
--
time_now := GLUT.Get( GLUT.ELAPSED_TIME ); -- Number of milliseconds since GLUT.Init
if Self.new_scene then
Self.new_scene := False;
elaps := 0;
else
elaps := time_now - Self.last_time;
end if;
Self.last_time := time_now;
Self.average := 0.0;
for i in reverse Self.sample'First+1 .. Self.sample'Last loop
Self.sample (i) := Self.sample (i-1);
Self.average := Self.average + Real (Self.sample (i));
end loop;
Self.sample (Self.sample'First) := elaps;
Self.average := Self.average + Real (elaps);
Self.average := Self.average / Real (Self.sample'Length);
seconds := Real (elaps) * 0.001;
attenu_t := Real'Min (0.96, Real'Max (0.04, 1.0 - seconds*4.0));
attenu_r := attenu_t ** 0.5;
-- Game control management
--
Self.game_command := no_command;
Game_control.Append_commands (size_x => Integer (Self.main_size_x),
size_y => Integer (Self.main_size_y),
warp_mouse => Self.full_screen,
c => Self.game_command,
gx => gx,
gy => gy,
keyboard => Self.Keyboard'Access,
mouse => Self.Mouse'Access);
if Self.forget_mouse > 0 then -- mouse coords disturbed by resize
gx := 0.0;
gy := 0.0;
Self.forget_mouse := Self.forget_mouse - 1;
end if;
if Self.game_command (interrupt_game) then
null; -- GLUT_exit; -- tbd: how to handle this best ?
end if;
alpha_correct:= False;
if Self.game_command (special_plus) then Self.alpha := Self.alpha + seconds; alpha_correct := True; end if;
if Self.game_command (special_minus) then Self.alpha := Self.alpha - seconds; alpha_correct := True; end if;
if alpha_correct then
if Self.alpha < 0.0 then Self.alpha := 0.0;
elsif Self.alpha > 1.0 then Self.alpha := 1.0; end if;
for Each in 1 .. Self.object_Count loop
Set_Alpha (Self.Objects (Each).all, Self.alpha);
end loop;
end if;
-- Camera/Eye - nb: camera movement is done after rendering, so camera is in a state ready for the next frame.
-- - (important for Impostors)
-- Rotating the eye
Actors.Rotation ( Self.Camera,
gc => Self.game_command,
gx => gx,
gy => gy,
unitary_change => seconds,
deceleration => attenu_r,
time_step => time_Step);
-- Moving the eye
Actors.Translation( Self.Camera,
gc => Self.game_command,
gx => gx,
gy => gy,
unitary_change => seconds,
deceleration => attenu_t,
time_step => time_Step);
if Self.game_command (n0) then
Reset_eye (Self.all);
end if;
Self.Camera.clipper.view_direction := Transpose (Self.Camera.world_rotation) * (0.0, 0.0, -1.0);
-- update camera frustum
--
MatrixMode (MODELVIEW);
Set_GL_Matrix (Self.Camera.world_rotation);
Translate (-Self.Camera.clipper.eye_position(0), -Self.Camera.clipper.eye_position(1), -Self.Camera.clipper.eye_position(2));
Self.Camera.frustum_planes := GL.Frustums.current_Planes; -- tbd: getting frustum planes from camera, might be quicker,
--set_frustum_Planes (Self.Camera); -- but 'set_frustum_Planes' seems buggy :/.
-- video management
--
if Self.game_command (video) then
if Self.is_capturing_Video then
GL.IO.Stop_capture;
Self.is_capturing_Video := False;
else
GL.IO.Start_capture (AVI_name => To_String (Self.Name) & "." & Image (Ada.Calendar.Clock) & ".avi",
frame_rate => 8); --Integer (self.Frames_per_second));
Self.is_capturing_Video := True;
end if;
end if;
if Self.is_capturing_Video then
GL.IO.Capture_frame;
end if;
-- photo management
--
if Self.game_command (photo) then
GL.IO.Screenshot (name => To_String (Self.Name) & "." & Image (Ada.Calendar.Clock) & ".bmp");
end if;
end Main_operations;
procedure Close_Window
is
begin
current_Window.is_Closed := True;
end Close_Window;
procedure update_Visibility (State : Integer)
is
begin
-- ada.text_io.put_line ("in update_Visibility callback state: " & integer'image( State));
--
-- tbd: this callback is not being called when a window is iconicised !!
current_Window.is_Visible := not ( State = GLUT.HIDDEN
or else State = GLUT.FULLY_COVERED);
end update_Visibility;
procedure Null_Display_Func
is
begin
null;
end Null_Display_Func;
procedure Start_GLUTs (Self : in out Window)
is
use GL, GLUT;
function to_Address is new Ada.Unchecked_Conversion (GLOBE_3D.p_Window, System.Address);
GLUT_options : GLUT.Unsigned := GLUT.DOUBLE or GLUT.RGBA or GLUT.ALPHA or GLUT.DEPTH;
begin
if Self.Smoothing = hardware then
GLUT_options := GLUT_options or GLUT.MULTISAMPLE;
end if;
InitDisplayMode (GLUT_options);
set_Size (Self, 500, 400);
InitWindowSize (Integer (Self.main_size_x), Integer (Self.main_size_y));
InitWindowPosition (120, 120);
Self.glut_Window := CreateWindow ("GLOBE_3D/GLUT Window");
if Self.glut_Window = 0 then
raise GLUT_Problem;
end if;
GLUT.CloseFunc (Close_Window'Access);
GLUT.ReshapeFunc (Window_Resize'Access);
GLUT.DisplayFunc (Null_Display_Func'Access);
GLUT.WindowStatusFunc (update_Visibility'Access);
GLUT.SetWindowData (to_Address (GLOBE_3D.Window'Class (Self)'Unchecked_Access));
GLUT.Devices.Initialize;
-- if CreateMenu (Menu'access) = 0 then -- tdb: deferred
-- raise GLUT_Problem;
-- end if;
-- AttachMenu( MIDDLE_BUTTON );
-- AddMenuEntry(" * Full Screen", 1);
-- AddMenuEntry("--> Exit (Esc)", 2);
end Start_GLUTs;
procedure Start_GLs (Self : in out Window)
is
use GL;
fog_colour : GL.Light_Float_Vector := (0.2,0.2,0.2,0.1);
begin
Clear_modes;
Prepare_default_lighting (Self, 0.9);
if Self.foggy then
Enable (FOG);
Fogfv (FOG_COLOR, fog_colour(0)'Unchecked_Access);
Fogf (FOG_DENSITY, 0.02);
end if;
Reset_for_3D (Self);
if Self.Smoothing = hardware then
Enable( MULTISAMPLE_ARB );
Enable( SAMPLE_COVERAGE_ARB ); -- Hope it helps switching on the AA...
end if;
end Start_GLs;
procedure initialize
is
begin
GLUT.Init;
GLUT.SetOption (GLUT.GLUT_RENDERING_CONTEXT, GLUT.GLUT_USE_CURRENT_CONTEXT);
GLUT.SetOption (GLUT.ACTION_ON_WINDOW_CLOSE, ACTION_CONTINUE_EXECUTION);
end initialize;
procedure define (Self : in out Window)
is
begin
Start_GLUTs (Self); -- Initialize the GLUT things
Start_GLs (Self); -- Initialize the (Open)GL things
Reset_eye (Self);
freshen (Self, 0.02); -- do an initial freshen, to initialise Camera, etc.
end define;
procedure destroy (Self : in out Window)
is
begin
DestroyWindow (Self.glut_Window);
end destroy;
overriding
procedure enable (Self : in out Window)
is
begin
GLUT.SetWindow (Self.glut_Window);
-- opengl.glx.glXMakeCurrent;
end enable;
procedure Set_renderer(Self: in out Window; Renderer: Renderer_Access) is
begin
Self.rend:= Renderer;
end Set_renderer;
overriding
procedure freshen (Self : in out Window;
time_Step : in G3D.Real;
Extras : in GLOBE_3D.Visual_array := GLOBE_3D.null_Visuals)
is
begin
enable (Self); -- for multi-window operation.
Main_operations (Self'Access, time_Step, Extras);
end freshen;
-- traits
--
function Smoothing (Self : in Window) return Smoothing_method
is
begin
return Self.Smoothing;
end Smoothing;
procedure Smoothing_is (Self : in out Window;
Now : in Smoothing_method)
is
begin
Self.Smoothing := Now;
end Smoothing_is;
procedure add (Self : in out Window; the_Object : in GLOBE_3D.p_Visual)
is
begin
Self.object_Count := Self.object_Count + 1;
Self.Objects (Self.object_Count) := the_Object.all'Access;
end add;
procedure rid (Self : in out Window; the_Object : in GLOBE_3D.p_Visual)
is
use G3D;
begin
for Each in 1 .. Self.object_Count loop
if Self.Objects (Each) = the_Object then
if Each /= Self.object_Count then
Self.Objects (Each .. Self.object_Count - 1) := Self.Objects (Each + 1 .. Self.object_Count);
end if;
Self.object_Count := Self.object_Count - 1;
return;
end if;
end loop;
raise no_such_Object;
end rid;
function object_Count (Self : in Window) return Natural
is
begin
return Self.object_Count;
end object_Count;
-- status display
--
procedure add_status_Line (Self : in out Window; Text : in String;
X, Y : in Integer)
is
begin
Self.extra_Status.Append (New_Item => (Text => To_Unbounded_String (Text),
X => GL.Int (X),
Y => GL.Int (Y)));
end add_status_Line;
function show_Status (Self : in Window) return Boolean
is
begin
return Self.show_Status;
end show_Status;
procedure show_Status (Self : in out Window;
Show : in Boolean := True)
is
begin
Self.show_Status := Show;
end show_Status;
-- Devices
--
function Keyboard (Self : access Window'Class) return Devices.p_Keyboard
is
begin
return Self.Keyboard'Unchecked_Access;
end Keyboard;
function Mouse (Self : access Window'Class) return Devices.p_Mouse
is
begin
return Self.Mouse'Access;
end Mouse;
-- Proxy for Ada 2005 Ada.Calendar.Formatting.Image
function Image(Date: Ada.Calendar.Time) return String
is
use Ada.Calendar;
subtype Sec_int is Long_Integer; -- must contain 86_400
m, s : Sec_int;
begin
s := Sec_int( Seconds(Date) );
m := s / 60;
declare
-- + 100: trick for obtaining 0x
sY : constant String:= Integer'Image( Year(Date));
sM : constant String:= Integer'Image( Month(Date) + 100);
sD : constant String:= Integer'Image( Day(Date) + 100);
shr: constant String:= Sec_int'Image( m / 60 + 100);
smn: constant String:= Sec_int'Image( m mod 60 + 100);
ssc: constant String:= Sec_int'Image( s mod 60 + 100);
begin
return
sY( sY'Last-3 .. sY'Last ) & '-' & -- not Year 10'000 compliant.
sM( sM'Last-1 .. sM'Last ) & '-' &
sD( sD'Last-1 .. sD'Last ) &
" " &
shr( shr'Last-1 .. shr'Last ) & '.' &
smn( smn'Last-1 .. smn'Last ) & '.' &
ssc( ssc'Last-1 .. ssc'Last );
end;
end Image;
end GLUT.Windows;
GLOBE_3D: Ada library for real-time 3D rendering.
Ada programming.