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