1. -- 
  2. -- Jan & Uwe R. Zimmer, Australia, July 2011 
  3. -- 
  4.  
  5. --  with Arrow_P, Cube_P, Duck_P, Plane_P; 
  6. with Spaceship_P; pragma Elaborate_All (Spaceship_P); 
  7. with Sphere_P;    pragma Elaborate_All (Sphere_P); 
  8.  
  9. with Real_Type;    use Real_Type; 
  10. with Vectors_4D;    use Vectors_4D; 
  11.  
  12. with GL; 
  13. with GL.Materials;  use GL.Materials; 
  14.  
  15. package body Models is 
  16.  
  17.    -- 
  18.  
  19.    procedure Assign_Material (Model : GLOBE_3D.p_Object_3D; Material : Material_type) is 
  20.  
  21.    begin 
  22.       for Faces in Model.all.face'Range loop 
  23.          Model.all.face (Faces).material := Material; 
  24.       end loop; 
  25.    end Assign_Material; 
  26.  
  27.    -- 
  28.  
  29.    function To_Vector_4D (V : GL.Material_Float_vector) return Vector_4D is 
  30.      (x => Real (V (0)), 
  31.       y => Real (V (1)), 
  32.       z => Real (V (2)), 
  33.       t => Real (V (3))); 
  34.  
  35.    -- 
  36.  
  37.    function To_GL (V : Vector_4D) return GL.Material_Float_vector is 
  38.      (0 => GL.C_Float (V (x)), 
  39.       1 => GL.C_Float (V (y)), 
  40.       2 => GL.C_Float (V (z)), 
  41.       3 => GL.C_Float (V (t))); 
  42.  
  43.    -- 
  44.  
  45.    subtype Ratio_T is Real range 0.0 .. 1.0; 
  46.  
  47.    function Blend_Material (Material_1, Material_2 : Material_type; Ratio : Ratio_T) return Material_type is 
  48.      (ambient   => To_GL (Ratio * To_Vector_4D (Material_1.ambient)  + (1.0 - Ratio) *  To_Vector_4D (Material_2.ambient)), 
  49.       diffuse   => To_GL (Ratio * To_Vector_4D (Material_1.diffuse)  + (1.0 - Ratio) *  To_Vector_4D (Material_2.diffuse)), 
  50.       specular  => To_GL (Ratio * To_Vector_4D (Material_1.specular) + (1.0 - Ratio) *  To_Vector_4D (Material_2.specular)), 
  51.       emission  => To_GL (Ratio * To_Vector_4D (Material_1.emission) + (1.0 - Ratio) *  To_Vector_4D (Material_2.emission)), 
  52.       shininess => GL.C_Float (Ratio * Real (Material_1.shininess) + (1.0 - Ratio) * Real (Material_2.shininess))); 
  53.  
  54.    ---------------- 
  55.    -- Initialize -- 
  56.    ---------------- 
  57.  
  58.    procedure Initialize is 
  59.  
  60.    begin 
  61.       for Model in Model_Name loop 
  62.          case Model is 
  63. --              when Arrow     => Arrow_P.Create (object => Model_Set (Model), scale  => 0.003, centre => (0.0, 0.0, 0.0)); 
  64. --              when Cube      => Cube_P.Create  (object => Model_Set (Model), scale  => 0.015, centre => (0.0, 0.0, 0.0)); 
  65. --              when Duck      => Duck_P.Create  (object => Model_Set (Model), scale  => 0.003, centre => (0.0, 0.0, 0.0)); 
  66. --              when Plane     => Plane_P.Create (object => Model_Set (Model), scale  => 0.003, centre => (0.0, 0.0, 0.0)); 
  67.             when Spaceship      => Spaceship_P.Create (Object => Model_Set (Model), Object_Scale  => 0.003, Centre => (0.0, 0.0, 0.0)); Assign_Material (Model_Set (Model), Pearl); 
  68. --              when Spaceship_Ruby => Spaceship_P.Create (object => Model_Set (Model), scale  => 0.003, centre => (0.0, 0.0, 0.0)); Assign_Material (Model_Set (Model), Ruby); 
  69.             when Sphere    => Sphere_P.Create (object => Model_Set (Model), Object_Scale  => 0.015, centre => (0.0, 0.0, 0.0)); Assign_Material (Model_Set (Model), Ruby); 
  70.          end case; 
  71.       end loop; 
  72.  
  73.       for M in Spaceship_Gradient'Range (1) loop 
  74.          for i in Spaceship_Gradient'Range (2) loop 
  75.             Spaceship_P.Create (Object => Spaceship_Gradient (M, i), Object_Scale  => 0.003, Centre => (0.0, 0.0, 0.0)); 
  76.             declare 
  77.                Ratio : constant Ratio_T := 
  78.                  ((Real (i) - Real (Spaceship_Gradient'First (2))) 
  79.                   / Real (Spaceship_Gradient'Last (2) - Spaceship_Gradient'First (2))) 
  80.                  + Ratio_T'First; 
  81.             begin 
  82.                case M is 
  83.                when G_Ruby      => Assign_Material (Spaceship_Gradient (M, i), Blend_Material (Ruby,      Pearl, Ratio)); 
  84.                when G_Turquoise => Assign_Material (Spaceship_Gradient (M, i), Blend_Material (Turquoise, Pearl, Ratio)); 
  85.                end case; 
  86.             end; 
  87.          end loop; 
  88.       end loop; 
  89.  
  90.    end Initialize; 
  91.  
  92. begin 
  93.    Initialize; 
  94. end Models;