1. -- 
  2. -- Jan & Uwe R. Zimmer, Australia, July 2011 
  3. -- 
  4.  
  5. with Ada.Numerics;                      use Ada.Numerics; 
  6. with GL; 
  7. --  with GL.Materials; 
  8. with GLOBE_3D; 
  9. with GLOBE_3D.Math;                     use GLOBE_3D.Math; 
  10. with GLOBE_3D.Stars_sky;                pragma Elaborate_All (GLOBE_3D.Stars_sky); 
  11. with GLU; 
  12. with GLUT; 
  13. with GLUT_2D; 
  14. with Graphics_Configuration;            use Graphics_Configuration; 
  15. with Graphics_Setup;                    use Graphics_Setup; 
  16. with Vectors_2D_N;                      use Vectors_2D_N; 
  17.  
  18. package body Graphics_OpenGL is 
  19.  
  20.    use Real_Elementary_Functions; 
  21.  
  22.    package Stars is new GLOBE_3D.Stars_sky (No_of_Stars => Number_Of_Stars, 
  23.                                             far_side    => Distance_of_Stars); 
  24.  
  25.    --------------------------- 
  26.    -- To GL Rotation Matrix -- 
  27.    --------------------------- 
  28.  
  29.    function To_GL_Rotation (Quat_Rotation : Quaternion_Rotation) return GLOBE_3D.Matrix_33 is 
  30.  
  31.       Rotation_Matrix : constant Matrix_3D := To_Matrix_3D_OpenGL (Roll  (Quat_Rotation), 
  32.                                                                    Pitch (Quat_Rotation), 
  33.                                                                    Yaw   (Quat_Rotation)); 
  34.       GL_Matrix : GLOBE_3D.Matrix_33; 
  35.  
  36.    begin 
  37.       for Column in 1 .. 3 loop 
  38.          for Row in 1 .. 3 loop 
  39.             GL_Matrix (Column, Row) := GL.Double (Rotation_Matrix (Column, Row)); 
  40.          end loop; 
  41.       end loop; 
  42.       return GL_Matrix; 
  43.    end To_GL_Rotation; 
  44.  
  45.    ----------------------- 
  46.    -- To GL Vector Type -- 
  47.    ----------------------- 
  48.  
  49.    function To_GL_Vector (In_Vector : Vector_3D) return GLOBE_3D.Vector_3D is 
  50.      (0 => GL.Double (In_Vector (x)), 
  51.       1 => GL.Double (In_Vector (y)), 
  52.       2 => GL.Double (In_Vector (z))); 
  53.  
  54.    -- 
  55.    -- 
  56.    -- 
  57.  
  58.    function To_GL_Material_Float_vector (Colour : RGBA_Colour) return GL.Material_Float_vector is 
  59.      (0 => GL.C_Float (Colour (Red)), 
  60.       1 => GL.C_Float (Colour (Green)), 
  61.       2 => GL.C_Float (Colour (Blue)), 
  62.       3 => GL.C_Float (Colour (Alpha))); 
  63.  
  64.    -- 
  65.  
  66.    procedure Set_Material (Material : Materials) is 
  67.  
  68.    begin 
  69.       GL.Disable (GL.COLOR_MATERIAL); 
  70.       GL.Material (GL.FRONT_AND_BACK, GL.AMBIENT,   To_GL_Material_Float_vector (Material.Ambient)); 
  71.       GL.Material (GL.FRONT_AND_BACK, GL.DIFFUSE,   To_GL_Material_Float_vector (Material.Diffuse)); 
  72.       GL.Material (GL.FRONT_AND_BACK, GL.SPECULAR,  To_GL_Material_Float_vector (Material.Specular)); 
  73.       GL.Material (GL.FRONT_AND_BACK, GL.EMISSION,  To_GL_Material_Float_vector (Material.Emission)); 
  74.       GL.Material (GL.FRONT_AND_BACK, GL.SHININESS, GL.C_Float (Material.Shininess)); 
  75.    end Set_Material; 
  76.  
  77.    procedure Set_Colour   (Colour   : RGB_Colour) is 
  78.  
  79.    begin 
  80.       null; 
  81.    end Set_Colour; 
  82.  
  83.    procedure Set_Colour   (Colour   : RGBA_Colour) is 
  84.  
  85.    begin 
  86.       GL.Disable (GL.LIGHTING); 
  87.       GL.Enable  (GL.COLOR_MATERIAL); 
  88.       GL.ColorMaterial (GL.FRONT_AND_BACK, GL.AMBIENT_AND_DIFFUSE); 
  89.       GL.Color (red   => GL.Double (Colour (Red)), 
  90.                 green => GL.Double (Colour (Green)), 
  91.                 blue  => GL.Double (Colour (Blue)), 
  92.                 alpha => GL.Double (Colour (Alpha))); 
  93.    end Set_Colour; 
  94.  
  95.    ---------------- 
  96.    -- Set_Camera -- 
  97.    ---------------- 
  98.  
  99.    procedure Position_Camera (Cam_Position : GLOBE_3D.Vector_3D; 
  100.                               Cam_Rotation : GLOBE_3D.Matrix_33; 
  101.                               Cam_Offset   : GLOBE_3D.Vector_3D) is 
  102.  
  103.    begin 
  104.       GL.Clear  (GL.DEPTH_BUFFER_BIT); 
  105.       GL.Clear  (GL.COLOR_BUFFER_BIT); 
  106.  
  107.       GL.Disable    (GL.LIGHTING); 
  108.       GL.Enable     (GL.DEPTH_TEST); 
  109.       GL.MatrixMode (GL.MODELVIEW); 
  110.  
  111.       GL.LoadIdentity; 
  112.       GL.Translate       (-Cam_Offset); 
  113.       Multiply_GL_Matrix (Cam_Rotation); 
  114.       GL.Translate       (-Cam_Position); 
  115.  
  116.       Stars.Display               (Cam_Rotation); 
  117.  
  118.       GL.Enable   (GL.LIGHTING); 
  119.       GL.Enable   (GL.CULL_FACE); 
  120.       GL.CullFace (GL.BACK); 
  121.    end Position_Camera; 
  122.  
  123.    -- 
  124.  
  125. --     procedure Position_Camera (Cam_Position : Vector_3D; 
  126. --                                Cam_Rotation : Quaternion_Rotation; 
  127. --                                Cam_Offset   : Vector_3D := Zero_Vector) is 
  128. -- 
  129. --     begin 
  130. --        Position_Camera (To_GL_Vector   (Cam_Position), 
  131. --                         To_GL_Rotation (Cam_Rotation), 
  132. --                         To_GL_Vector   (Cam_Offset)); 
  133. --     end Position_Camera; 
  134.  
  135.    -- 
  136.  
  137.    procedure Position_Camera (C : Camera := Cam) is 
  138.  
  139.    begin 
  140.       Position_Camera (To_GL_Vector   (C.Position + C.Scene_Offset), 
  141.                        To_GL_Rotation (C.Rotation), 
  142.                        To_GL_Vector   (C.Object_Offset)); 
  143.    end Position_Camera; 
  144.  
  145.    -- 
  146.  
  147.    ---------- 
  148.    -- Draw -- 
  149.    ---------- 
  150.    procedure Draw (Draw_Object : GLOBE_3D.p_Object_3D) is 
  151.  
  152.    begin 
  153.       GL.PushMatrix; 
  154.       GLOBE_3D.Display (Draw_Object.all, Eye.Clipper); 
  155.       GL.PopMatrix; 
  156.    end Draw; 
  157.    ------------------------------------ 
  158.    -- Alternative Draw Input Options -- 
  159.    ------------------------------------ 
  160.    procedure Draw (Draw_Object        : GLOBE_3D.p_Object_3D; 
  161.                    In_Object_Position : GLOBE_3D.Vector_3D; 
  162.                    In_Object_Rotation : GLOBE_3D.Matrix_33) is 
  163.    begin 
  164.       Draw_Object.all.Centre   := In_Object_Position; 
  165.       Draw_Object.all.rotation := In_Object_Rotation; 
  166.       Draw (Draw_Object); 
  167.    end Draw; 
  168.  
  169.    procedure Draw (Draw_Object : GLOBE_3D.p_Object_3D; 
  170.                    In_Object_Position : Vector_3D; 
  171.                    In_Object_Rotation : Quaternion_Rotation) is 
  172.    begin 
  173.       Draw (Draw_Object, 
  174.             To_GL_Vector   (In_Object_Position), 
  175.             To_GL_Rotation (In_Object_Rotation)); 
  176.    end Draw; 
  177.  
  178.    -- 
  179.    -- 
  180.    -- 
  181.  
  182.    procedure Draw_Lines (Points : Points_3D) is 
  183.  
  184.    begin 
  185.       GL.GL_Begin (GL.LINES); 
  186.       GL.Vertex (To_GL_Vector (Points (Points'First))); 
  187.       for i in Points'First + 1 .. Points'Last loop 
  188.          GL.Vertex (To_GL_Vector (Points (i))); 
  189.       end loop; 
  190.       GL.GL_End; 
  191.    end Draw_Lines; 
  192.  
  193.    procedure Draw_Line  (Line : Line_3D; Line_Radius : Real) is 
  194.  
  195.       Cyl_Slices  : constant GL.Int    := 10; 
  196.       Cyl_Stacks  : constant GL.Int    := 1; 
  197.       Rad_to_Deg  : constant Real      := 360.0 / (2.0 * Pi); 
  198.       Cylinder    : constant Vector_3D := (0.0, 0.0, 1.0); 
  199.       Line_Vector : constant Vector_3D := Line (Line'Last) - Line (Line'First); 
  200.       Radius      : constant Vector_3D := Cylinder * Line_Vector; 
  201.       Tilt_Angle  : constant Real      := Rad_to_Deg * Angle_Between (Cylinder, Line_Vector); 
  202.  
  203.       Quadratic : constant GLU.GLUquadricObjPtr := GLU.NewQuadric; 
  204.  
  205.    begin 
  206.       GL.PushMatrix; 
  207.       GL.Translate (To_GL_Vector (Line (Line'First))); 
  208.       GL.Rotate    (GL.Double (Tilt_Angle), GL.Double (Radius (x)), GL.Double (Radius (y)), GL.Double (Radius (z))); 
  209.       GLU.QuadricOrientation (Quadratic, GLU.GLU_OUTSIDE); 
  210.       GLU.Cylinder (Quadratic, 
  211.                     GL.Double (Line_Radius), 
  212.                     GL.Double (Line_Radius), 
  213.                     GL.Double (abs (Line_Vector)), 
  214.                     Cyl_Slices, 
  215.                     Cyl_Stacks); 
  216.       GLU.QuadricOrientation (Quadratic, GLU.GLU_INSIDE); 
  217.       GLU.Disk (Quadratic, 0.0, GL.Double (Line_Radius), Cyl_Slices, Cyl_Stacks); 
  218.       GL.Translate (To_GL_Vector (Line_Vector)); 
  219.       GLU.QuadricOrientation (Quadratic, GLU.GLU_OUTSIDE); 
  220.       GLU.Disk (Quadratic, 0.0, GL.Double (Line_Radius), Cyl_Slices, Cyl_Stacks); 
  221.       GL.PopMatrix; 
  222.       GLU.DeleteQuadric (Quadratic); 
  223.    end Draw_Line; 
  224.  
  225.    -- 
  226.  
  227.    function Scale_RGB (In_Colour : RGBA_Colour; Scale : Colour_Component_Range) return RGBA_Colour is 
  228.      (Red   => In_Colour (Red)   * Scale, 
  229.       Green => In_Colour (Green) * Scale, 
  230.       Blue  => In_Colour (Blue)  * Scale, 
  231.       Alpha => In_Colour (Alpha)); 
  232.  
  233.    -- 
  234.  
  235.    procedure Draw_Laser (Line_Start, Line_End     : Vector_3D; 
  236.                          Beam_Radius, Aura_Radius : Real; 
  237.                          Beam_Colour              : RGBA_Colour) is 
  238.  
  239.       Rendering_Steps : constant Positive               := 5; 
  240.       Max_Alpha       : constant Colour_Component_Range := 1.0; 
  241.       Min_Alpha       : constant Colour_Component_Range := 0.1; 
  242.  
  243.       Laser_Material : constant Materials := 
  244.         (Ambient   => (Red => 0.00, Green => 0.00, Blue => 0.00, Alpha => 1.00), 
  245.          Diffuse   => (Red => 0.59, Green => 0.67, Blue => 0.73, Alpha => 1.00), 
  246.          Specular  => (Red => 0.90, Green => 0.90, Blue => 0.90, Alpha => 1.00), 
  247.          Emission  => Beam_Colour, 
  248.          Shininess => 100.0); 
  249.  
  250.       Beam_Material : Materials := Laser_Material; 
  251.  
  252.       Radius     : Real                   := Beam_Radius; 
  253.       Beam_Alpha : Colour_Component_Range := 1.0; 
  254.  
  255.    begin 
  256.       for Steps in 0 .. Rendering_Steps loop 
  257.          Beam_Alpha := Max_Alpha   - (Real (Steps) / Real (Rendering_Steps))**(1.0/2.0) * (Max_Alpha   - Min_Alpha); 
  258.          Radius     := Beam_Radius + (Real (Steps) / Real (Rendering_Steps))            * (Aura_Radius - Beam_Radius); 
  259.  
  260.          Beam_Material.Diffuse  := (Scale_RGB (Laser_Material.Diffuse,  Beam_Alpha)); 
  261.          Beam_Material.Specular := (Scale_RGB (Laser_Material.Specular, Beam_Alpha)); 
  262.          Beam_Material.Emission := (Scale_RGB (Laser_Material.Emission, Beam_Alpha)); 
  263.  
  264.          Beam_Material.Ambient  (Alpha) := Beam_Alpha; 
  265.          Beam_Material.Diffuse  (Alpha) := Beam_Alpha; 
  266.          Beam_Material.Specular (Alpha) := Beam_Alpha; 
  267.          Beam_Material.Emission (Alpha) := Beam_Alpha; 
  268.  
  269.          Set_Material (Beam_Material); 
  270.          Draw_Line ((Line_Start, Line_End), Radius); 
  271.       end loop; 
  272.    end Draw_Laser; 
  273.  
  274.    -- 
  275.  
  276.    package body Cursor_Management is 
  277.  
  278.       function Cursor return Point_2D is (Cursor_Pos); 
  279.  
  280.       -- 
  281.  
  282.       procedure Home is 
  283.  
  284.       begin 
  285.          Cursor_Pos := Home_Pos; 
  286.       end Home; 
  287.  
  288.       -- 
  289.  
  290.       procedure Line_Feed is 
  291.  
  292.       begin 
  293.          Cursor_Pos := (x => Home_Pos (x), y => Cursor_Pos (y) + Leading); 
  294.       end Line_Feed; 
  295.  
  296.       -- 
  297.  
  298.       procedure Paragraph_Feed is 
  299.  
  300.       begin 
  301.          Cursor_Pos := (x => Home_Pos (x), y => Cursor_Pos (y) + Paragraph_Spacing); 
  302.       end Paragraph_Feed; 
  303.  
  304.       -- 
  305.  
  306.       procedure Indend (Set_x : Natural) is 
  307.  
  308.       begin 
  309.          Cursor_Pos (x) := Set_x; 
  310.       end Indend; 
  311.  
  312.    end Cursor_Management; 
  313.  
  314.    procedure Text_2D (S : String; C : Point_2D := Cursor_Management.Cursor) is 
  315.  
  316.    begin 
  317.       GLUT_2D.Text_output (GL.Int (C (x)), 
  318.                            GL.Int (C (y)), 
  319.                            GL.Sizei (GLUT.Get (GLUT.WINDOW_WIDTH)), 
  320.                            GL.Sizei (GLUT.Get (GLUT.WINDOW_HEIGHT)), 
  321.                            S, 
  322.                            Screen_Font); 
  323.    end Text_2D; 
  324.  
  325.    -- 
  326.  
  327.    procedure Text_3D (S : String; P : Vector_3D) is 
  328.  
  329.    begin 
  330.       GLUT_2D.Text_output (To_GL_Vector (P), 
  331.                            S, 
  332.                            Screen_Font); 
  333.    end Text_3D; 
  334.  
  335.    ------------------ 
  336.    -- Show Drawing -- 
  337.    ------------------ 
  338.  
  339.    procedure Show_Drawing is 
  340.    begin 
  341.       GLUT.SwapBuffers; 
  342.    end Show_Drawing; 
  343.  
  344.    ------------------- 
  345.    -- Resize Window -- 
  346.    ------------------- 
  347.  
  348.    procedure Resize_Window  (Size : Size_2D) is 
  349.    begin 
  350.       GLUT.ReshapeWindow (Width  => Size (x), Height => Size (y)); 
  351.       Window_Resize (Size (x), Size (y)); 
  352.    end Resize_Window; 
  353.  
  354.    ----------------- 
  355.    -- Move Window -- 
  356.    ----------------- 
  357.  
  358.    procedure Move_Window (Position : Point_2D) is 
  359.    begin 
  360.       GLUT.PositionWindow (Position (x), Position (y)); 
  361.    end Move_Window; 
  362.  
  363.    ----------------- 
  364.    -- Full Screen -- 
  365.    ----------------- 
  366.  
  367.    package body Full_Screen_Mode is 
  368.       procedure Change_Full_Screen is 
  369.  
  370.       begin 
  371.          case Full_Screen_State is 
  372.          when False => 
  373.             Memoried_Viewer_Size := ((x => GLUT.Get (GLUT.WINDOW_WIDTH), 
  374.                                       y => GLUT.Get (GLUT.WINDOW_HEIGHT))); 
  375.             Memoried_Viewer_Position := ((x => GLUT.Get (GLUT.WINDOW_X), 
  376.                                           y => GLUT.Get (GLUT.WINDOW_Y))); 
  377.             GLUT.FullScreen; 
  378.             Window_Resize (Size_x => GLUT.Get (GLUT.WINDOW_WIDTH), 
  379.                            Size_y => GLUT.Get (GLUT.WINDOW_HEIGHT)); 
  380.             GLUT.SetCursor (GLUT.CURSOR_NONE); 
  381.  
  382.          when True => 
  383.             Resize_Window (Memoried_Viewer_Size); 
  384.             Move_Window   (Memoried_Viewer_Position); 
  385.             GLUT.SetCursor (GLUT.CURSOR_INHERIT); 
  386.          end case; 
  387.          Full_Screen_State := not Full_Screen_State; 
  388.       end Change_Full_Screen; 
  389.    end Full_Screen_Mode; 
  390.  
  391. end Graphics_OpenGL;