1. ------------------------------------------------------------------------------ 
  2. --  File :            GLUT - Windows.adb 
  3. --  Description :     models a GLUT window 
  4. --  Copyright (c) Gautier de Montmollin/Rod Kay 2006 .. 2007 
  5. ------------------------------------------------------------------------------ 
  6.  
  7. -- with opengl.glx; 
  8.  
  9. with GL, GL.IO, GL.Frustums, GLU,  GLUT;  use GL, GL.IO, GL.Frustums, GLU,  GLUT; 
  10.  
  11. --  with GLOBE_3D; 
  12. --  with GLOBE_3D.IO; 
  13. with GLOBE_3D.Math;                       use GLOBE_3D.Math; 
  14. with GLOBE_3D.Software_Anti_Aliasing; 
  15.  
  16. with Actors; 
  17. with GLUT_2D;  --, GLUT_Exit; 
  18.  
  19. -- with Ada.Text_IO; 
  20.  
  21. with Ada.Numerics;                      use Ada.Numerics; 
  22. with Ada.Unchecked_Conversion; 
  23.  
  24. -- with Ada.Containers.Generic_Array_Sort; 
  25.  
  26. with Ada.Calendar; 
  27.  
  28. -- with System.Storage_Elements; 
  29.  
  30. package body GLUT.Windows is 
  31.  
  32.    package G3D  renames GLOBE_3D; 
  33.  
  34.    use Ada.Strings.Unbounded; 
  35.  
  36.    deg2rad       : constant := Pi / 180.0; 
  37.    GLUT_Problem  : exception; 
  38.  
  39.    -- current_Window  : - for accessing the current GLUT window 
  40.    --                  - used by GLUT callbacks to determine the Window to which a callback event relates. 
  41.    -- 
  42.    function current_Window return Window_view is 
  43.  
  44.       function to_Window is new Ada.Unchecked_Conversion (System.Address, GLOBE_3D.p_Window); 
  45.  
  46.    begin 
  47.       return GLUT.Windows.Window_view (to_Window (GetWindowData)); 
  48.    end current_Window; 
  49.  
  50.    procedure Name_is (Self : in out Window; Now  : String) is 
  51.  
  52.    begin 
  53.       Self.Name := To_Unbounded_String (Now); 
  54.    end Name_is; 
  55.  
  56.    function Name (Self : Window) return String is (To_String (Self.Name)); 
  57.  
  58.    function is_Closed (Self : Window) return Boolean is (Self.is_Closed); 
  59.  
  60.    procedure Prepare_default_lighting (Self  : in out Window; 
  61.                                        fact  :        GL.C_Float) is 
  62.  
  63.       proto_light  : G3D.Light_definition := (position => (0.0, 500.0,  0.0,  1.0), 
  64.                                               ambient  => (0.3,   0.3,  0.3,  fact), 
  65.                                               diffuse  => (0.9,   0.9,  0.9,  fact), 
  66.                                               specular => (0.05,  0.05, 0.01, fact)); 
  67.    begin 
  68.       GL.Enable (GL.LIGHTING); 
  69.  
  70.       G3D.Define (1, proto_light); 
  71.       Self.frontal_light   := proto_light; 
  72.  
  73.       proto_light.diffuse  := (0.5, 0.9, 0.5, fact); 
  74.       G3D.Define (2, proto_light); 
  75.  
  76.       proto_light.diffuse  := (0.2, 0.0, 0.9, fact); 
  77.       proto_light.specular := (1.0, 1.0, 1.0, fact); 
  78.       G3D.Define (3, proto_light); 
  79.  
  80.       proto_light.position := (-3.0, 4.0, 10.0, 1.0); 
  81.       G3D.Define (4, proto_light); 
  82.  
  83.       proto_light.position := (3.0, -4.0, 10.0, 1.0); 
  84.       proto_light.ambient  := (0.6, 0.6, 0.6, 0.1); 
  85.       G3D.Define (5, proto_light); 
  86.  
  87.       proto_light.ambient  := (0.6, 0.0, 0.0, 0.1); 
  88.       G3D.Define (6, proto_light); 
  89.  
  90.       proto_light.ambient  := (0.0, 0.6, 0.0, 0.1); 
  91.       G3D.Define (7, proto_light); 
  92.  
  93.       proto_light.ambient  := (0.0, 0.0, 0.6, 0.1); 
  94.       G3D.Define (8, proto_light); 
  95.  
  96.       G3D.Switch_lights (True); 
  97.  
  98.       G3D.Switch_light (2, False); 
  99.       G3D.Switch_light (3, False); 
  100.       G3D.Switch_light (4, False); 
  101.       G3D.Switch_light (5, False); 
  102.       G3D.Switch_light (6, False); 
  103.       G3D.Switch_light (7, False); 
  104.       G3D.Switch_light (8, False); 
  105.  
  106.    end Prepare_default_lighting; 
  107.  
  108.    procedure Clear_modes is 
  109.  
  110.    begin 
  111.       Disable (BLEND); 
  112.       Disable (LIGHTING); 
  113.       Disable (AUTO_NORMAL); 
  114.       Disable (NORMALIZE); 
  115.       Disable (DEPTH_TEST); 
  116.    end Clear_modes; 
  117.  
  118.    procedure Reset_for_3D (Self : in out Window'Class) is 
  119.  
  120.    begin 
  121.       pragma Unreferenced (Self); 
  122.       MatrixMode (MODELVIEW);    -- (tbd : still needed ?) . .. The matrix generated by GLU.Perspective is multipled by the current matrix 
  123.       ShadeModel (SMOOTH);       -- GL's default is SMOOTH, vs FLAT 
  124.       -- ShadeModel (FLAT);       -- GL's default is SMOOTH, vs FLAT 
  125.  
  126.       ClearColor (0.0, 0.0, 0.0, 0.0);    -- Specifies clear values for color buffer (s) 
  127.       ClearAccum (0.0, 0.0, 0.0, 0.0);    -- Specifies clear values for the accumulation buffer 
  128.    end Reset_for_3D; 
  129.  
  130.    procedure enable_Viewport_and_Perspective (Self : in out Window'Class) is  -- tbd : move projection matrix to 'window resize'. 
  131.  
  132.    begin 
  133.       Viewport (0,  0, Self.main_size_x, Self.main_size_y); 
  134.  
  135.       MatrixMode (PROJECTION); 
  136.       LoadIdentity; 
  137.  
  138.       GLU.Perspective (fovy   => Self.Camera.FOVy,                    -- field of view angle (deg) in the y direction 
  139.                        aspect => Self.Camera.Aspect,                  -- x/y aspect ratio 
  140.                        zNear  => Self.Camera.near_plane_Distance,     -- distance from the viewer to the near clipping plane 
  141.                        zFar   => Self.Camera.far_plane_Distance);     -- distance from the viewer to the far clipping plane 
  142.  
  143.       Get (GL.PROJECTION_MATRIX,  Self.Camera.Projection_Matrix (1, 1)'Unchecked_Access);   -- Get the current PROJECTION matrix from OpenGL 
  144.  
  145.       Self.Camera.Projection_Matrix := Transpose (Self.Camera.Projection_Matrix); 
  146.  
  147.       MatrixMode (MODELVIEW);    -- The matrix generated by GLU.Perspective is multipled by the current matrix 
  148.    end enable_Viewport_and_Perspective; 
  149.  
  150.    procedure set_Size (Self : in out Window'Class;  width, height : Integer) is 
  151.  
  152.       use G3D; 
  153.       use REF; 
  154.  
  155.       half_fov_max_rads         : Real; 
  156.       Tan_of_half_fov_max_rads  : Real; 
  157.  
  158.    begin 
  159.       Self.main_size_x  := GL.Sizei (width); 
  160.       Self.main_size_y  := GL.Sizei (height); 
  161.  
  162.       Self.Camera.Clipper.main_clipping.X1 := 0; 
  163.       Self.Camera.Clipper.main_clipping.Y1 := 0; 
  164.       Self.Camera.Clipper.main_clipping.X2 := width - 1; 
  165.       Self.Camera.Clipper.main_clipping.Y2 := height - 1; 
  166.  
  167.       Self.Camera.Aspect := GL.Double (Self.main_size_x) / GL.Double (Self.main_size_y); 
  168.       half_fov_max_rads        := 0.5 * Self.Camera.FOVy * deg2rad; 
  169.  
  170.       Tan_of_half_fov_max_rads := Tan (half_fov_max_rads); 
  171.  
  172.       Self.Camera.near_plane_Height := Self.Camera.near_plane_Distance * Tan_of_half_fov_max_rads; 
  173.       Self.Camera.near_plane_Width  := Self.Camera.near_plane_Height   * Self.Camera.Aspect; 
  174.  
  175.       Self.Camera.far_plane_Height  := Self.Camera.far_plane_Distance * Tan_of_half_fov_max_rads; 
  176.       Self.Camera.far_plane_Width   := Self.Camera.far_plane_Height   * Self.Camera.Aspect; 
  177.  
  178.       if Self.Camera.Aspect > 1.0 then -- x side angle broader than y side angle 
  179.          half_fov_max_rads := Arctan (Self.Camera.Aspect * Tan_of_half_fov_max_rads); 
  180.       end if; 
  181.  
  182.       Self.Camera.Clipper.max_dot_product := Sin (half_fov_max_rads); 
  183.  
  184.    end set_Size; 
  185.  
  186.    -- Procedures passed to GLUT: 
  187.    --   Window_Resize, Keyboard, Motion, Menu, Mouse, Display 
  188.  
  189.    procedure Window_Resize (width, height  : Integer) is 
  190.  
  191.       the_Window  : constant GLUT.Windows.Window_view := current_Window; 
  192.  
  193.    begin 
  194.       the_Window.all.forget_mouse := 5; 
  195.       set_Size     (the_Window.all,  width, height); 
  196.       Reset_for_3D (the_Window.all); 
  197.    end Window_Resize; 
  198.  
  199.    procedure Menu (value  : Integer) is 
  200.  
  201.    begin 
  202.       case value is 
  203.          when 1 => -- GLUT.GameModeString (Full_Screen_Mode); 
  204.             GLUT.FullScreen; 
  205.             -- res := GLUT.EnterGameMode; 
  206.             GLUT.SetCursor (GLUT.CURSOR_NONE); 
  207.             current_Window.all.forget_mouse := 10; 
  208.             current_Window.all.full_screen  := True; 
  209.          when 2 => null; -- GLUT_exit; 
  210.          when others => null; 
  211.       end case; 
  212.    end Menu; 
  213.    pragma Unreferenced (Menu); 
  214.  
  215.    procedure Display_status (Self  : in out Window; 
  216.                              sec   : GLOBE_3D.Real) is 
  217.  
  218.       use G3D, G3D.REF; 
  219.  
  220.       light_info  : String (1 .. 8); 
  221.  
  222.    begin 
  223.       PushMatrix; 
  224.  
  225.       Disable (LIGHTING); 
  226.       Disable (TEXTURE_2D); 
  227.  
  228.       Color (red   => 0.7, 
  229.              green => 0.7, 
  230.              blue  => 0.6); 
  231.  
  232.       GLUT_2D.Text_output ((1.0, 0.0, 0.0),  " (x)",  GLUT_2D.Times_Roman_24); 
  233.       GLUT_2D.Text_output ((0.0, 1.0, 0.0),  " (y)",  GLUT_2D.Times_Roman_24); 
  234.       GLUT_2D.Text_output ((0.0, 0.0, 1.0),  " (z)",  GLUT_2D.Times_Roman_24); 
  235.  
  236.       GLUT_2D.Text_output (0,  50,  Self.main_size_x,  Self.main_size_y, 
  237.                            "Eye : " & Coords (Self.Camera.Clipper.Eye_Position), 
  238.                            GLUT_2D.Helvetica_10); 
  239.  
  240.       GLUT_2D.Text_output (0,  60,  Self.main_size_x,  Self.main_size_y, 
  241.                            "View direction : " & Coords (Self.Camera.Clipper.view_direction), 
  242.                            GLUT_2D.Helvetica_10); 
  243.  
  244.       for i in light_info'Range loop 
  245.  
  246.          if Is_light_switched (i) then 
  247.             light_info (i) := Character'Val (Character'Pos ('0') + i); 
  248.          else 
  249.             light_info (i) := 'x'; 
  250.          end if; 
  251.       end loop; 
  252.  
  253.       GLUT_2D.Text_output (0, 70, Self.main_size_x, Self.main_size_y, "Lights : (" & light_info & ')', GLUT_2D.Helvetica_10); 
  254.  
  255.       if sec > 0.0 then 
  256.          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); 
  257.       end if; 
  258.  
  259.       if Self.is_capturing_Video then 
  260.          GLUT_2D.Text_output (0, 150, Self.main_size_x, Self.main_size_y, "*recording*", GLUT_2D.Helvetica_10); 
  261.       end if; 
  262.  
  263.       PopMatrix; 
  264.  
  265.    end Display_status; 
  266.  
  267.    function Frames_per_second (Self : Window) return Float is (Float (1.0 / (Self.Average * 0.001))); 
  268.  
  269.    procedure Graphic_display (Self    : in out Window'Class; 
  270.                               Extras  :        GLOBE_3D.Visual_array := GLOBE_3D.null_Visuals) is 
  271.  
  272.       use G3D; 
  273.  
  274.    begin 
  275.       G3D.render (Self.Objects (1 .. Self.object_Count) & Extras, Self.Camera); 
  276.  
  277.       if Self.Show_Status then 
  278.          Display_status (Self,  Self.Average * 0.001); 
  279.       end if; 
  280.    end Graphic_display; 
  281.  
  282.    procedure Fill_screen (Self    : in out Window'Class; 
  283.                           Extras  :        GLOBE_3D.Visual_array := GLOBE_3D.null_Visuals) is 
  284.  
  285.       procedure Display is 
  286.  
  287.       begin 
  288.          Graphic_display (Self, Extras); 
  289.       end Display; 
  290.  
  291.       package SAA is new GLOBE_3D.Software_Anti_Aliasing (Display); 
  292.    begin 
  293.  
  294.       case Self.Smoothing is 
  295.  
  296.          when Software => 
  297.             SAA.Set_Quality (SAA.Q3); 
  298.             for SAA_Phase in 1 .. SAA.Anti_Alias_phases loop 
  299.                SAA.Display_with_Anti_Aliasing (SAA_Phase); 
  300.             end loop; 
  301.  
  302.          when Hardware => 
  303.             Enable (MULTISAMPLE_ARB); -- (if not done yet) 
  304.  
  305.             -- ClearColor (0.0, 0.0, 0.0, 1.0);    -- Specifies clear values for color buffer (s) 
  306.             -- ClearColor (0.15, 0.4, 0.15, 1.0);    -- Specifies clear values for color buffer (s)  -- tbd : make clear color user - settable 
  307.             ClearColor (0.0, 0.0, 0.0, 1.0);    -- Specifies clear values for color buffer (s)  -- tbd : make clear color user - settable 
  308.             ClearAccum (0.0,  0.0, 0.0,  0.0);    -- Specifies clear values for the accumulation buffer 
  309.  
  310.             Graphic_display (Self, Extras); 
  311.             Flush; 
  312.  
  313.          when None => 
  314.             Graphic_display (Self, Extras); 
  315.             Flush; 
  316.       end case; 
  317.  
  318.       GLUT.SwapBuffers; 
  319.    end Fill_screen; 
  320.  
  321.    procedure Reset_eye  (Self  : in out Window'Class) is 
  322.  
  323.    begin 
  324.       Self.Camera.Clipper.Eye_Position := (0.0,  5.0,  4.0); 
  325.       Self.Camera.World_Rotation       := GLOBE_3D.Id_33; 
  326.    end Reset_eye; 
  327.  
  328.    function Image (Date : Ada.Calendar.Time) return String; 
  329.    -- Proxy for Ada 2005 Ada.Calendar.Formatting.Image 
  330.  
  331.    procedure Main_Operations (Self       : access Window; 
  332.                               time_Step  :        G3D.Real; 
  333.                               Extras     :        GLOBE_3D.Visual_array := GLOBE_3D.null_Visuals) is 
  334.  
  335.       use G3D, G3D.REF, Game_Control; 
  336.  
  337.       elaps, time_now     : Integer; 
  338.       gx,    gy           : GL.Double;   -- mouse movement since last call 
  339.       seconds             : GL.Double;   -- seconds since last image 
  340.       alpha_correct       : Boolean; 
  341.       attenu_t, attenu_r  : Real; 
  342.  
  343.    begin 
  344.       if not Self.all.is_Visible or else Self.all.is_Closed then 
  345.          return; 
  346.       end if; 
  347.  
  348.       enable_Viewport_and_Perspective (Self.all);   -- nb : must be done prior to setting frustum planes (when using GL.frustums.current_Planes) 
  349.  
  350.       -- Control of lighting 
  351.       -- 
  352.       --        self.frontal_light.position := (GL.Float (self.Camera.Clipper.eye_Position (0)), 
  353.       --                                              GL.Float (self.Camera.Clipper.eye_Position (1)), 
  354.       --                                              GL.Float (self.Camera.Clipper.eye_Position (2)), 
  355.       --                                              1.0); 
  356.       --        G3D.Define (1, self.frontal_light); 
  357.  
  358.       for c in n1 .. n8 loop 
  359.          if Self.all.game_command (c) then 
  360.             Reverse_light_switch (1 + Command'Pos (c) - Command'Pos (n1)); 
  361.          end if; 
  362.       end loop; 
  363.  
  364.       -- Display screen 
  365.       -- 
  366.       Fill_screen (Self.all, Extras); 
  367.  
  368.       -- Timer management 
  369.       -- 
  370.       time_now := GLUT.Get (GLUT.ELAPSED_TIME);   -- Number of milliseconds since GLUT.Init 
  371.  
  372.       if Self.all.new_scene then 
  373.          Self.all.new_scene := False; 
  374.          elaps          := 0; 
  375.       else 
  376.          elaps          := time_now - Self.all.last_time; 
  377.       end if; 
  378.  
  379.       Self.all.last_time := time_now; 
  380.       Self.all.Average   := 0.0; 
  381.  
  382.       for i in reverse Self.all.sample'First + 1 .. Self.all.sample'Last loop 
  383.          Self.all.sample (i) := Self.all.sample (i - 1); 
  384.          Self.all.Average    := Self.all.Average + Real (Self.all.sample (i)); 
  385.       end loop; 
  386.  
  387.       Self.all.sample (Self.all.sample'First) := elaps; 
  388.  
  389.       Self.all.Average := Self.all.Average + Real (elaps); 
  390.       Self.all.Average := Self.all.Average / Real (Self.all.sample'Length); 
  391.  
  392.       seconds  := Real (elaps) * 0.001; 
  393.       attenu_t := Real'Min (0.96, Real'Max (0.04,  1.0 - seconds*4.0)); 
  394.       attenu_r := attenu_t ** 0.5; 
  395.  
  396.       -- Game control management 
  397.       -- 
  398.       Self.all.game_command := no_command; 
  399.  
  400.       Game_Control.Append_Commands (size_x     => Integer (Self.all.main_size_x), 
  401.                                     size_y     => Integer (Self.all.main_size_y), 
  402.                                     warp_mouse => Self.all.full_screen, 
  403.                                     c          => Self.all.game_command, 
  404.                                     gx         => gx, 
  405.                                     gy         => gy, 
  406.                                     Keyboard   => Self.all.Keyboard'Access, 
  407.                                     Mouse      => Self.all.Mouse'Access); 
  408.  
  409.       if Self.all.forget_mouse > 0 then -- mouse coords disturbed by resize 
  410.          gx := 0.0; 
  411.          gy := 0.0; 
  412.          Self.all.forget_mouse := Self.all.forget_mouse - 1; 
  413.       end if; 
  414.  
  415.       if Self.all.game_command (interrupt_game) then 
  416.          null; -- GLUT_exit;                     -- tbd : how to handle this best ? 
  417.       end if; 
  418.  
  419.       alpha_correct := False; 
  420.  
  421.       if Self.all.game_command (special_plus)  then 
  422.          Self.all.Alpha := Self.all.Alpha + seconds; alpha_correct := True; 
  423.       end if; 
  424.       if Self.all.game_command (special_minus) then 
  425.          Self.all.Alpha := Self.all.Alpha - seconds; alpha_correct := True; 
  426.       end if; 
  427.  
  428.       if alpha_correct then 
  429.          if    Self.all.Alpha < 0.0 then 
  430.             Self.all.Alpha := 0.0; 
  431.          elsif Self.all.Alpha > 1.0 then 
  432.             Self.all.Alpha := 1.0; 
  433.          end if; 
  434.  
  435.          for Each in 1 .. Self.all.object_Count loop 
  436.             set_Alpha (Self.all.Objects (Each).all,  Self.all.Alpha); 
  437.          end loop; 
  438.       end if; 
  439.  
  440.       -- Camera/Eye - nb : camera movement is done after rendering, so camera is in a state ready for the next frame. 
  441.       --            -     (important for Impostors) 
  442.  
  443.       -- Rotating the eye 
  444.  
  445.       Actors.Rotation (Self.all.Camera, 
  446.                        gc => Self.all.game_command, 
  447.                        gx => gx, 
  448.                        gy => gy, 
  449.                        unitary_change => seconds, 
  450.                        deceleration   => attenu_r, 
  451.                        time_step      => time_Step); 
  452.  
  453.       -- Moving the eye 
  454.  
  455.       Actors.Translation (Self.all.Camera, 
  456.                           gc => Self.all.game_command, 
  457.                           gx => gx, 
  458.                           gy => gy, 
  459.                           unitary_change     => seconds, 
  460.                           deceleration       => attenu_t, 
  461.                           time_step          => time_Step); 
  462.  
  463.       if Self.all.game_command (n0) then 
  464.          Reset_eye (Self.all); 
  465.       end if; 
  466.  
  467.       Self.all.Camera.Clipper.view_direction := Transpose (Self.all.Camera.World_Rotation) * (0.0, 0.0, -1.0); 
  468.  
  469.       -- update camera frustum 
  470.       -- 
  471.       MatrixMode    (MODELVIEW); 
  472.       Set_GL_Matrix (Self.all.Camera.World_Rotation); 
  473.       Translate     (-Self.all.Camera.Clipper.Eye_Position (0), -Self.all.Camera.Clipper.Eye_Position (1), -Self.all.Camera.Clipper.Eye_Position (2)); 
  474.  
  475.       Self.all.Camera.frustum_Planes := GL.Frustums.Current_Planes;  -- tbd : getting frustum planes from camera, might be quicker, 
  476.       -- set_frustum_Planes (Self.Camera);                        --      but 'set_frustum_Planes' seems buggy :/. 
  477.  
  478.       -- video management 
  479.       -- 
  480.       if Self.all.game_command (video) then 
  481.          if Self.all.is_capturing_Video then 
  482.             GL.IO.Stop_Capture; 
  483.             Self.all.is_capturing_Video := False; 
  484.          else 
  485.             GL.IO.Start_Capture (AVI_Name   => To_String (Self.all.Name) & "." & Image (Ada.Calendar.Clock) & ".avi", 
  486.                                  frame_rate => 8); -- Integer (self.Frames_per_second)); 
  487.             Self.all.is_capturing_Video := True; 
  488.          end if; 
  489.       end if; 
  490.  
  491.       if Self.all.is_capturing_Video then 
  492.          GL.IO.Capture_Frame; 
  493.       end if; 
  494.  
  495.       -- photo management 
  496.       -- 
  497.       if Self.all.game_command (photo) then 
  498.          GL.IO.Screenshot (Name => To_String (Self.all.Name) & "." & Image (Ada.Calendar.Clock) & ".bmp"); 
  499.       end if; 
  500.  
  501.    end Main_Operations; 
  502.  
  503.    procedure Close_Window is 
  504.  
  505.    begin 
  506.       current_Window.all.is_Closed := True; 
  507.    end Close_Window; 
  508.  
  509.    procedure Update_Visibility (State  : Integer) is 
  510.  
  511.    begin 
  512.       --      ada.text_io.put_line ("in update_Visibility callback state : " & integer'image (State)); 
  513.       -- 
  514.       -- tbd : this callback is not being called when a window is iconicised !! 
  515.  
  516.       current_Window.all.is_Visible := not (State = GLUT.HIDDEN or else State = GLUT.FULLY_COVERED); 
  517.    end Update_Visibility; 
  518.  
  519.    procedure Start_GLUTs (Self  : in out Window) is 
  520.  
  521.       use GLUT; 
  522.  
  523.       function to_Address is new Ada.Unchecked_Conversion (GLOBE_3D.p_Window, System.Address); 
  524.  
  525.       GLUT_options : GLUT.Unsigned := GLUT.DOUBLE or GLUT.RGBA or GLUT.ALPHA or GLUT.DEPTH; 
  526.  
  527.    begin 
  528.       if Self.Smoothing = Hardware then 
  529.          GLUT_options := GLUT_options or GLUT.MULTISAMPLE; 
  530.       end if; 
  531.  
  532.       InitDisplayMode (GLUT_options); 
  533.  
  534.       set_Size (Self,  500, 400); 
  535.  
  536.       InitWindowSize     (Integer (Self.main_size_x),  Integer (Self.main_size_y)); 
  537.       InitWindowPosition (120, 120); 
  538.  
  539.       Self.glut_Window := CreateWindow ("GLOBE_3D/GLUT Window"); 
  540.  
  541.       if Self.glut_Window = 0 then 
  542.          raise GLUT_Problem; 
  543.       end if; 
  544.  
  545.       GLUT.CloseFunc        (Close_Window'Access); 
  546.       GLUT.ReshapeFunc      (Window_Resize'Access); 
  547.       GLUT.WindowStatusFunc (Update_Visibility'Access); 
  548.       GLUT.SetWindowData    (to_Address (GLOBE_3D.Window'Class (Self)'Unchecked_Access)); 
  549.  
  550.       GLUT.Devices.Initialize; 
  551.  
  552.       --        if CreateMenu (Menu'Access) = 0 then         -- tdb : deferred 
  553.       --           raise GLUT_Problem; 
  554.       --        end if; 
  555.  
  556.       --      AttachMenu (MIDDLE_BUTTON); 
  557.  
  558.       --      AddMenuEntry (" * Full Screen", 1); 
  559.       --      AddMenuEntry ("--> Exit (Esc)", 2); 
  560.  
  561.    end Start_GLUTs; 
  562.  
  563.    procedure Start_GLs (Self  : in out Window) is 
  564.  
  565.       fog_colour  : GL.Light_Float_vector := (0.2, 0.2, 0.2, 0.1); 
  566.  
  567.    begin 
  568.  
  569.       Clear_modes; 
  570.       Prepare_default_lighting (Self, 0.9); 
  571.  
  572.       if Self.foggy then 
  573.          Enable (FOG); 
  574.          Fogfv  (FOG_COLOR,   fog_colour (0)'Unchecked_Access); 
  575.          Fogf   (FOG_DENSITY, 0.02); 
  576.       end if; 
  577.  
  578.       Reset_for_3D (Self); 
  579.  
  580.       if Self.Smoothing = Hardware then 
  581.          Enable (MULTISAMPLE_ARB); 
  582.          Enable (SAMPLE_COVERAGE_ARB); -- Hope it helps switching on the AA .. . 
  583.       end if; 
  584.  
  585.    end Start_GLs; 
  586.  
  587.    procedure Initialize is 
  588.  
  589.    begin 
  590.       GLUT.Init; 
  591.       GLUT.SetOption (GLUT.GLUT_RENDERING_CONTEXT, GLUT.GLUT_USE_CURRENT_CONTEXT); 
  592.       GLUT.SetOption (GLUT.ACTION_ON_WINDOW_CLOSE, ACTION_CONTINUE_EXECUTION); 
  593.    end Initialize; 
  594.  
  595.    procedure Define (Self  : in out Window) is 
  596.  
  597.    begin 
  598.       Start_GLUTs (Self);    -- Initialize the GLUT things 
  599.       Start_GLs   (Self);    -- Initialize the (Open)GL things 
  600.       Reset_eye   (Self); 
  601.  
  602.       Freshen     (Self, 0.02);    -- do an initial freshen, to initialise Camera, etc. 
  603.    end Define; 
  604.  
  605.    procedure Destroy (Self  : in out Window) is 
  606.  
  607.    begin 
  608.       DestroyWindow (Self.glut_Window); 
  609.    end Destroy; 
  610.  
  611.    overriding procedure Enable (Self  : in out Window) is 
  612.  
  613.    begin 
  614.       GLUT.SetWindow (Self.glut_Window); 
  615.       --      opengl.glx.glXMakeCurrent; 
  616.    end Enable; 
  617.  
  618.    overriding procedure Freshen (Self      : in out Window; 
  619.                                  time_Step :        G3D.Real; 
  620.                                  Extras    :        GLOBE_3D.Visual_array := GLOBE_3D.null_Visuals) is 
  621.  
  622.    begin 
  623.       Enable (Self);  -- for multi - window operation. 
  624.       Main_Operations (Self'Access, time_Step, Extras); 
  625.    end Freshen; 
  626.  
  627.    -- traits 
  628.    -- 
  629.  
  630.    function Smoothing (Self : Window) return Smoothing_method is (Self.Smoothing); 
  631.  
  632.    procedure Smoothing_is (Self : in out Window; 
  633.                            Now  :        Smoothing_method) is 
  634.  
  635.    begin 
  636.       Self.Smoothing := Now; 
  637.    end Smoothing_is; 
  638.  
  639.    procedure Add (Self : in out Window; the_Object : GLOBE_3D.p_Visual) is 
  640.  
  641.    begin 
  642.       Self.object_Count                := Self.object_Count + 1; 
  643.       Self.Objects (Self.object_Count) := the_Object.all'Access; 
  644.    end Add; 
  645.  
  646.    procedure Rid (Self : in out Window; the_Object : GLOBE_3D.p_Visual) is 
  647.  
  648.       use G3D; 
  649.  
  650.    begin 
  651.       for Each in 1 .. Self.object_Count loop 
  652.  
  653.          if Self.Objects (Each) = the_Object then 
  654.  
  655.             if Each /= Self.object_Count then 
  656.                Self.Objects (Each .. Self.object_Count - 1) := Self.Objects (Each + 1 .. Self.object_Count); 
  657.             end if; 
  658.  
  659.             Self.object_Count := Self.object_Count - 1; 
  660.             return; 
  661.          end if; 
  662.  
  663.       end loop; 
  664.  
  665.       raise no_such_Object; 
  666.    end Rid; 
  667.  
  668.    function Object_Count (Self : Window) return Natural is (Self.object_Count); 
  669.  
  670.    -- status display 
  671.    -- 
  672.  
  673.    function  Show_Status (Self : Window) return Boolean is (Self.Show_Status); 
  674.  
  675.    procedure Show_Status (Self  : in out Window; 
  676.                           Show  :        Boolean := True) is 
  677.  
  678.    begin 
  679.       Self.Show_Status := Show; 
  680.    end Show_Status; 
  681.  
  682.    -- Devices 
  683.    -- 
  684.  
  685.    function Keyboard (Self : access Window'Class) return Devices.p_Keyboard is (Self.all.Keyboard'Access); 
  686.  
  687.    function Mouse (Self : access Window'Class) return Devices.p_Mouse is (Self.all.Mouse'Access); 
  688.  
  689.    -- Proxy for Ada 2005 Ada.Calendar.Formatting.Image 
  690.    function Image (Date : Ada.Calendar.Time) return String is 
  691.  
  692.       use Ada.Calendar; 
  693.  
  694.       subtype Sec_int is Long_Integer; -- must contain 86_400 
  695.  
  696.       m, s  : Sec_int; 
  697.  
  698.    begin 
  699.       s := Sec_int (Seconds (Date)); 
  700.       m := s / 60; 
  701.  
  702.       declare 
  703.          -- + 100 : trick for obtaining 0x 
  704.          sY  : constant String := Integer'Image (Year (Date)); 
  705.          sM  : constant String := Integer'Image (Month (Date) + 100); 
  706.          sD  : constant String := Integer'Image (Day (Date)  + 100); 
  707.          shr : constant String := Sec_int'Image (m  /  60 + 100); 
  708.          smn : constant String := Sec_int'Image (m mod 60 + 100); 
  709.          ssc : constant String := Sec_int'Image (s mod 60 + 100); 
  710.  
  711.       begin 
  712.          return 
  713.            sY (sY'Last - 3 .. sY'Last) & '-' &  -- not Year 10'000 compliant. 
  714.            sM (sM'Last - 1 .. sM'Last) & '-' & 
  715.            sD (sD'Last - 1 .. sD'Last) & 
  716.            " " & 
  717.            shr (shr'Last - 1 .. shr'Last) & '.' & 
  718.            smn (smn'Last - 1 .. smn'Last) & '.' & 
  719.            ssc (ssc'Last - 1 .. ssc'Last); 
  720.       end; 
  721.    end Image; 
  722.  
  723. end GLUT.Windows;