with openGL.Geometry.lit_textured, openGL.Primitive.indexed; package body openGL.Model.box.lit_textured is --------- --- Forge -- function new_Box (Size : in Vector_3; Faces : in lit_textured.Faces; texture_Details : in texture_Set.Details) return View is Self : constant View := new Item; begin Self.Faces := Faces; Self.Size := Size; Self.texture_Details_is (texture_Details); return Self; end new_Box; -------------- --- Attributes -- overriding function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; Fonts : in Font.font_id_Map_of_font) return Geometry.views is pragma unreferenced (Fonts); use Geometry.lit_textured; the_Sites : constant box.Sites := Self.vertex_Sites; the_Indices : aliased constant Indices := [1, 2, 3, 4]; function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view is use openGL.Primitive; the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry; the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices).all'Access; begin the_Geometry.Vertices_are (Vertices); the_Geometry.add (the_Primitive); return the_Geometry; end new_Face; front_Face : Geometry.lit_textured.view; rear_Face : Geometry.lit_textured.view; upper_Face : Geometry.lit_textured.view; lower_Face : Geometry.lit_textured.view; left_Face : Geometry.lit_textured.view; right_Face : Geometry.lit_textured.view; begin -- Front -- declare the_Vertices : constant Geometry.lit_textured.Vertex_array := [1 => (Site => the_Sites ( Left_Lower_Front), Normal => front_Normal, Coords => (0.0, 0.0), Shine => default_Shine), 2 => (Site => the_Sites (Right_Lower_Front), Normal => front_Normal, Coords => (1.0, 0.0), Shine => default_Shine), 3 => (Site => the_Sites (right_upper_front), Normal => front_Normal, Coords => (1.0, 1.0), Shine => default_Shine), 4 => (Site => the_Sites ( Left_Upper_Front), Normal => front_Normal, Coords => (0.0, 1.0), Shine => default_Shine)]; begin front_Face := new_Face (Vertices => the_Vertices); if Self.Faces (Front).texture_Name /= null_Asset then front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name)); front_Face.is_Transparent (now => front_Face.Texture.is_Transparent); front_Face.Model_is (Self.all'unchecked_Access); end if; end; -- Rear -- declare the_Vertices : constant Geometry.lit_textured.Vertex_array := [1 => (Site => the_Sites (Right_Lower_Rear), Normal => rear_Normal, Coords => (0.0, 0.0), Shine => default_Shine), 2 => (Site => the_Sites ( Left_Lower_Rear), Normal => rear_Normal, Coords => (1.0, 0.0), Shine => default_Shine), 3 => (Site => the_Sites ( Left_Upper_Rear), Normal => rear_Normal, Coords => (1.0, 1.0), Shine => default_Shine), 4 => (Site => the_Sites (Right_Upper_Rear), Normal => rear_Normal, Coords => (0.0, 1.0), Shine => default_Shine)]; begin rear_Face := new_Face (Vertices => the_Vertices); if Self.Faces (Rear).texture_Name /= null_Asset then rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name)); rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent); rear_Face.Model_is (Self.all'unchecked_Access); end if; end; -- Upper -- declare the_Vertices : constant Geometry.lit_textured.Vertex_array := [1 => (Site => the_Sites ( Left_Upper_Front), Normal => upper_Normal, Coords => (0.0, 0.0), Shine => default_Shine), 2 => (Site => the_Sites (Right_Upper_Front), Normal => upper_Normal, Coords => (1.0, 0.0), Shine => default_Shine), 3 => (Site => the_Sites (Right_Upper_Rear), Normal => upper_Normal, Coords => (1.0, 1.0), Shine => default_Shine), 4 => (Site => the_Sites ( Left_Upper_Rear), Normal => upper_Normal, Coords => (0.0, 1.0), Shine => default_Shine)]; begin upper_Face := new_Face (Vertices => the_Vertices); if Self.Faces (Upper).texture_Name /= null_Asset then upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name)); upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent); upper_Face.Model_is (Self.all'unchecked_Access); end if; end; -- Lower -- declare the_Vertices : constant Geometry.lit_textured.Vertex_array := [1 => (Site => the_Sites (Right_Lower_Front), Normal => lower_Normal, Coords => (0.0, 0.0), Shine => default_Shine), 2 => (Site => the_Sites ( Left_Lower_Front), Normal => lower_Normal, Coords => (1.0, 0.0), Shine => default_Shine), 3 => (Site => the_Sites ( Left_Lower_Rear), Normal => lower_Normal, Coords => (1.0, 1.0), Shine => default_Shine), 4 => (Site => the_Sites (Right_Lower_Rear), Normal => lower_Normal, Coords => (0.0, 1.0), Shine => default_Shine)]; begin lower_Face := new_Face (Vertices => the_Vertices); if Self.Faces (Lower).texture_Name /= null_Asset then lower_Face.Texture_is (Textures.fetch (Self.Faces (Lower).texture_Name)); lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent); lower_Face.Model_is (Self.all'unchecked_Access); end if; end; -- Left -- declare the_Vertices : constant Geometry.lit_textured.Vertex_array := [1 => (Site => the_Sites (Left_Lower_Rear), Normal => left_Normal, Coords => (0.0, 0.0), Shine => default_Shine), 2 => (Site => the_Sites (Left_Lower_Front), Normal => left_Normal, Coords => (1.0, 0.0), Shine => default_Shine), 3 => (Site => the_Sites (Left_Upper_Front), Normal => left_Normal, Coords => (1.0, 1.0), Shine => default_Shine), 4 => (Site => the_Sites (Left_Upper_Rear), Normal => left_Normal, Coords => (0.0, 1.0), Shine => default_Shine)]; begin left_Face := new_Face (Vertices => the_Vertices); if Self.Faces (Left).texture_Name /= null_Asset then left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name)); left_Face.is_Transparent (now => left_Face.Texture.is_Transparent); left_Face.Model_is (Self.all'unchecked_Access); end if; end; -- Right -- declare the_Vertices : constant Geometry.lit_textured.Vertex_array := [1 => (Site => the_Sites (Right_Lower_Front), Normal => right_Normal, Coords => (0.0, 0.0), Shine => default_Shine), 2 => (Site => the_Sites (Right_Lower_Rear), Normal => right_Normal, Coords => (1.0, 0.0), Shine => default_Shine), 3 => (Site => the_Sites (Right_Upper_Rear), Normal => right_Normal, Coords => (1.0, 1.0), Shine => default_Shine), 4 => (Site => the_Sites (Right_Upper_Front), Normal => right_Normal, Coords => (0.0, 1.0), Shine => default_Shine)]; begin right_Face := new_Face (Vertices => the_Vertices); if Self.Faces (Right).texture_Name /= null_Asset then right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name)); right_Face.is_Transparent (now => right_Face.Texture.is_Transparent); right_Face.Model_is (Self.all'unchecked_Access); end if; end; return [1 => front_Face.all'Access, 2 => rear_Face.all'Access, 3 => upper_Face.all'Access, 4 => lower_Face.all'Access, 5 => left_Face.all'Access, 6 => right_Face.all'Access]; end to_GL_Geometries; ------------ -- Texturing -- -- overriding -- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; -- Now : in texture_Set.fade_Level) -- is -- begin -- null; -- end Fade_is; -- -- -- -- overriding -- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level -- is -- begin -- return 0.0; -- end Fade; -- -- -- -- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; -- Now : in openGL.asset_Name) -- is -- begin -- null; -- end Texture_is; -- -- -- -- -- overriding -- function texture_Count (Self : in Item) return Natural -- is -- begin -- return 1; -- end texture_Count; end openGL.Model.box.lit_textured;