1. ------------------------------------------------------------------------- 
  2.  --  GL.Skins - models a 'skin' which describes the surface appearance of geometry. 
  3.  -- 
  4.  --  Copyright (c) Rod Kay 2007 
  5.  --  AUSTRALIA 
  6.  --  Permission granted to use this software, without any warranty, 
  7.  --  for any purpose, provided this copyright note remains attached 
  8.  --  and unmodified if sources are distributed further. 
  9.  ------------------------------------------------------------------------- 
  10.  
  11.  --  with Ada.Text_IO; 
  12. with Ada.Unchecked_Deallocation; 
  13.  
  14. package body GL.Skins is 
  15.  
  16.    use GL.Geometry; 
  17.    use GL.Textures; 
  18.    use GL.Materials; 
  19.  
  20.    ----------------------------------------------------------------- 
  21.    -- tbd : ensure *all* skins disable *all* unneeded GL states !!!!! 
  22.    ----------------------------------------------------------------- 
  23.  
  24.    -- veneers 
  25.    -- 
  26.  
  27.    procedure Destroy (Self : in out Veneer) is 
  28.  
  29.    begin 
  30.       null; 
  31.    end Destroy; 
  32.  
  33.    procedure Free (Self  : in out p_Veneer) is 
  34.  
  35.       procedure Deallocate is new Ada.Unchecked_Deallocation (Veneer'Class, p_Veneer); 
  36.  
  37.    begin 
  38.       Destroy    (Self.all); 
  39.       Deallocate (Self); 
  40.    end Free; 
  41.  
  42.    procedure Destroy (Self  : in out Skin) is 
  43.  
  44.    begin 
  45.       null; 
  46.    end Destroy; 
  47.  
  48.    procedure Free (Self  : in out p_Skin) is 
  49.  
  50.       procedure Deallocate is new Ada.Unchecked_Deallocation (Skin'Class, p_Skin); 
  51.  
  52.    begin 
  53.       Destroy    (Self.all); 
  54.       Deallocate (Self); 
  55.    end Free; 
  56.  
  57.    procedure Set_Material (m : Materials.Material_type) is 
  58.  
  59.       use GL; 
  60.  
  61.    begin 
  62.       Material (FRONT_AND_BACK, AMBIENT,   m.ambient); 
  63.       Material (FRONT_AND_BACK, DIFFUSE,   m.diffuse); 
  64.       Material (FRONT_AND_BACK, SPECULAR,  m.specular); 
  65.       Material (FRONT_AND_BACK, EMISSION,  m.emission); 
  66.       Material (FRONT_AND_BACK, SHININESS, m.shininess); 
  67.    end Set_Material; 
  68.  
  69.    -- Skin_opaque_unlit_mono_color 
  70.    -- 
  71.  
  72.    overriding function New_Veneer (Self          : Skin_opaque_unlit_mono_color; 
  73.                                    for_Geometry  : GL.Geometry.Geometry_t'Class) return p_Veneer is (null); 
  74.  
  75.    overriding procedure Enable (Self : in out Skin_opaque_unlit_mono_color) is 
  76.  
  77.    begin 
  78.       GL.Disable              (LIGHTING); 
  79.       GL.Disable              (ALPHA_TEST); 
  80.       GL.Disable              (TEXTURE_2D); 
  81.       GL.Disable              (COLOR_MATERIAL); 
  82.       GL.Disable_Client_State (TEXTURE_COORD_ARRAY); 
  83.  
  84.       Enable (BLEND); -- See 4.1.7 Blending 
  85.       BlendFunc (sfactor => SRC_ALPHA, 
  86.                  dfactor => ONE_MINUS_SRC_ALPHA); 
  87.  
  88.       GL.Color   (Self.Color.Red,  Self.Color.Green,  Self.Color.Blue,  1.0); 
  89.    end Enable; 
  90.  
  91.    overriding function is_Transparent (Self : Skin_opaque_unlit_mono_color) return Boolean is (False); 
  92.  
  93.    -- Skin_opaque_lit_mono_color 
  94.    -- 
  95.  
  96.    overriding procedure Enable (Self : in out Veneer_opaque_lit_mono_color) is 
  97.  
  98.    begin 
  99.       GL.BindBuffer          (GL.ARRAY_BUFFER, 0);    -- disable 'vertex buffer objects' 
  100.       GL.Enable_Client_State (GL.NORMAL_ARRAY); 
  101.       GL.Normal_Pointer      (GL_DOUBLE,  0,  to_Pointer (Self.Normals (1) (0)'Unchecked_Access)); 
  102.    end Enable; 
  103.  
  104.    overriding function new_Veneer (Self         : Skin_opaque_lit_mono_color; 
  105.                                    for_Geometry : GL.Geometry.Geometry_t'Class) return p_Veneer is 
  106.      (new Veneer_opaque_lit_mono_color'(Max_Normals => vertex_Count   (for_Geometry), 
  107.                                         normals     => Vertex_Normals (for_Geometry))); 
  108.  
  109.    overriding procedure Enable (Self : in out Skin_opaque_lit_mono_color) is 
  110.  
  111.    begin 
  112.       GL.Disable            (TEXTURE_2D); 
  113.       GL.Disable            (COLOR_MATERIAL); 
  114.       GL.Disable_Client_State (TEXTURE_COORD_ARRAY); 
  115.       GL.Disable            (ALPHA_TEST); 
  116.  
  117.       GL.Enable    (LIGHTING); 
  118.       Set_Material (Self.Material); 
  119.    end Enable; 
  120.  
  121.    overriding function is_Transparent (Self : Skin_opaque_lit_mono_color) return Boolean is (is_Transparent (Self.Material)); 
  122.  
  123.    -- Skin : transparent unlit textured 
  124.    -- 
  125.  
  126.    overriding procedure Enable (Self : in out Veneer_transparent_unlit_textured) is 
  127.  
  128.    begin 
  129.       GL.BindBuffer          (GL.ARRAY_BUFFER, 0);    -- disable 'vertex buffer objects' 
  130.       GL.Enable_Client_State (GL.TEXTURE_COORD_ARRAY); 
  131.       GL.Tex_Coord_Pointer   (2,  GL_DOUBLE, 0, to_Pointer (Self.Texture_Coordinates (1).S'Unchecked_Access)); 
  132.    end Enable; 
  133.  
  134.    overriding procedure Destroy (Self  : in out Skin_transparent_unlit_textured) is 
  135.  
  136.    begin 
  137.       Destroy (Self.Texture); 
  138.    end Destroy; 
  139.  
  140.    overriding function New_Veneer (Self         : Skin_transparent_unlit_textured; 
  141.                                    for_Geometry : GL.Geometry.Geometry_t'Class) return p_Veneer is 
  142.  
  143.       the_Veneer : constant p_Veneer_transparent_unlit_textured := 
  144.         new Veneer_transparent_unlit_textured'(Num_Coordinates     => vertex_Count (for_Geometry), 
  145.                                                Texture_Coordinates => (others => (S => 0.0, T => 0.0))); 
  146.    begin 
  147.       if Self.Coordinate_Generator /= null then 
  148.          the_Veneer.all.Texture_Coordinates := To_Coordinates (Self.Coordinate_Generator.all, Vertices (for_Geometry)); 
  149.       end if; 
  150.  
  151.       return the_Veneer.all'Access; 
  152.    end New_Veneer; 
  153.  
  154.    overriding procedure Enable (Self  : in out Skin_transparent_unlit_textured) is 
  155.  
  156.    begin 
  157.       GL.Disable    (LIGHTING); 
  158.       GL.Disable    (COLOR_MATERIAL); 
  159.       GL.BindBuffer (GL.ARRAY_BUFFER, 0);    -- disable 'vertex buffer objects' 
  160.  
  161.       GL.Color     (1.0, 1.0, 1.0, 1.0); 
  162.  
  163.       GL.Enable     (ALPHA_TEST); 
  164.       GL.Alpha_Func (GREATER, 0.1); 
  165.  
  166.       Enable (Self.Texture); 
  167.    end Enable; 
  168.  
  169.    overriding function Is_Transparent (Self : Skin_transparent_unlit_textured) return Boolean is (Is_Transparent (Self.Texture)); 
  170.  
  171.    -- Skin : unlit textured vbo 
  172.    -- 
  173.  
  174.    overriding procedure Enable (Self  : in out Veneer_unlit_textured_vbo) is 
  175.  
  176.       use GL.Buffer; 
  177.  
  178.    begin 
  179.       Enable (Self.texture_Coordinates); 
  180.       GL.Tex_Coord_Pointer   (2, GL_DOUBLE, 0, null); 
  181.       GL.Enable_Client_State (GL.TEXTURE_COORD_ARRAY); 
  182.    end Enable; 
  183.  
  184.    overriding procedure Destroy (Self : in out Skin_unlit_textured_vbo) is 
  185.  
  186.    begin 
  187.       null; 
  188.    end Destroy; 
  189.  
  190.    overriding function  New_Veneer (Self         : Skin_unlit_textured_vbo; 
  191.                                     for_Geometry : GL.Geometry.Geometry_t'Class) return p_Veneer is 
  192.      (new Veneer_unlit_textured_vbo); 
  193.  
  194.    overriding procedure Enable (Self  : in out Skin_unlit_textured_vbo) is 
  195.  
  196.    begin 
  197.       GL.Disable (LIGHTING); 
  198.       GL.Disable (ALPHA_TEST); 
  199.  
  200.       Enable (Self.Texture); 
  201.    end Enable; 
  202.  
  203.    overriding function Is_Transparent (Self : Skin_unlit_textured_vbo) return Boolean is (Is_Transparent (Self.Texture)); 
  204.  
  205. end GL.Skins;