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