with openGL.Geometry.textured, openGL.Texture, openGL.IO, openGL.Primitive.indexed; package body openGL.Model.capsule.textured is --------- --- Forge -- function new_Capsule (Radius : in Real; Height : in Real; texture_Details : in texture_Set.Details; Image : in asset_Name := null_Asset) return View is Self : constant View := new Item; begin Self.Radius := Radius; Self.Height := Height; Self.Image := Image; Self.texture_Details_is (texture_Details); return Self; end new_Capsule; -------------- --- 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 (Textures, Fonts); use --Geometry, Geometry.textured, real_Functions; Length : constant Real := Self.Height; Radius : constant Real := Self.Radius; quality_Level : constant Index_t := 4; sides_Count : constant Index_t := Index_t (quality_Level * 4); -- Number of sides to the cylinder (divisible by 4): type Edge is -- A 'shaft' edge. record Fore : Site; Aft : Site; end record; type Edges is array (Index_t range 1 .. sides_Count) of Edge; type arch_Edges is array (Index_t range 1 .. quality_Level) of Sites (1 .. sides_Count); tmp, nx, ny, nz, start_nx, start_ny : Real; a : constant Real := Pi * 2.0 / Real (sides_Count); ca : constant Real := Cos (a); sa : constant Real := Sin (a); L : constant Real := Length * 0.5; the_Edges : Edges; the_shaft_Geometry : constant Geometry.textured.view := Geometry.textured.new_Geometry; cap_1_Geometry : Geometry.textured.view; cap_2_Geometry : Geometry.textured.view; begin -- Define capsule shaft, -- declare vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge. indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle. the_Vertices : aliased Geometry.textured.Vertex_array := (1 .. vertex_Count => <>); the_Indices : aliased Indices := (1 .. indices_Count => <>); begin ny := 1.0; nz := 0.0; -- Normal vector = (0.0, ny, nz) -- Set vertices. -- declare S : Real := 0.0; S_delta : constant Real := 1.0 / Real (sides_Count); i : Index_t := 1; begin for Each in 1 .. Index_t (Edges'Length) loop the_Edges (Each).Fore (1) := ny * Radius; the_Edges (Each).Fore (2) := nz * Radius; the_Edges (Each).Fore (3) := L; the_Edges (Each).Aft (1) := ny * Radius; the_Edges (Each).Aft (2) := nz * Radius; the_Edges (Each).Aft (3) := -L; -- Rotate ny, nz. -- tmp := ca * ny - sa * nz; nz := sa * ny + ca * nz; ny := tmp; the_Vertices (i).Site := the_Edges (Each).Fore; the_Vertices (i).Coords := (s => S, t => 1.0); i := i + 1; the_Vertices (i).Site := the_Edges (Each).Aft; the_Vertices (i).Coords := (s => S, t => 0.0); i := i + 1; S := S + S_delta; end loop; the_Vertices (i).Site := the_Edges (1).Fore; the_Vertices (i).Coords := (s => S, t => 1.0); i := i + 1; the_Vertices (i).Site := the_Edges (1).Aft; the_Vertices (i).Coords := (s => S, t => 0.0); end; -- Set indices. -- declare i : long_Index_t := 1; Start : Index_t := 1; begin for Each in 1 .. long_Index_t (sides_Count) loop the_Indices (i) := Start; i := i + 1; the_Indices (i) := Start + 1; i := i + 1; the_Indices (i) := Start + 2; i := i + 1; the_Indices (i) := Start + 1; i := i + 1; the_Indices (i) := Start + 3; i := i + 1; the_Indices (i) := Start + 2; i := i + 1; Start := Start + 2; end loop; end; if Self.Image /= null_Asset then set_Texture: declare use Texture; the_Image : constant Image := IO.to_Image (Self.Image); the_Texture : constant Texture.object := Forge.to_Texture (the_Image); begin the_shaft_Geometry.Texture_is (the_Texture); end set_Texture; end if; Vertices_are (the_shaft_Geometry.all, the_Vertices); declare the_Primitive : constant Primitive.indexed.view := Primitive.indexed.new_Primitive (primitive.Triangles, the_Indices); begin the_shaft_Geometry.add (Primitive.view (the_Primitive)); end; end; declare function new_Cap (is_Fore : Boolean) return Geometry.textured.view is cap_Geometry : constant Geometry.textured.view := Geometry.textured.new_Geometry; hoop_Count : constant Index_t := quality_Level; vertex_Count : constant Index_t := Index_t (Edges'Length * hoop_Count + 1); -- A vertex for each edge of each hoop, + 1 for the pole. indices_Count : constant long_Index_t := long_Index_t ( (hoop_count - 1) * sides_Count * 2 * 3 -- For each hoop, 2 triangles per side with 3 vertices per triangle + sides_Count * 3); -- plus the extra indices for the pole triangles. the_Vertices : aliased Geometry.textured.Vertex_array := (1 .. vertex_Count => <>); the_Indices : aliased Indices := (1 .. indices_Count => <>); the_arch_Edges : arch_Edges; i : Index_t := 1; pole_Site : constant Site := (if is_Fore then (0.0, 0.0, L + Radius) else (0.0, 0.0, -L - Radius)); Degrees_90 : constant := Pi / 2.0; Degrees_360 : constant := Pi * 2.0; latitude_Count : constant := hoop_Count + 1; longitude_Count : constant := Edges'Length; latitude_Spacing : constant Real := Degrees_90 / Real (latitude_Count - 1); longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count); a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords. begin if not is_Fore then a := Degrees_360; end if; -- Set the vertices. -- start_nx := 0.0; start_ny := 1.0; for each_Hoop in 1 .. quality_Level loop -- Get n=start_n. -- nx := start_nx; ny := start_ny; nz := 0.0; for Each in 1 .. sides_Count loop the_arch_Edges (each_Hoop) (Each) (1) := ny * Radius; the_arch_Edges (each_Hoop) (Each) (2) := nz * Radius; the_arch_Edges (each_Hoop) (Each) (3) := (if is_Fore then nx * Radius + L else nx * Radius - L); -- Rotate ny, nz. -- tmp := ca * ny - sa * nz; nz := sa * ny + ca * nz; ny := tmp; the_Vertices (i).Site := the_arch_Edges (each_Hoop) (Each); the_Vertices (i).Coords := (s => a / Degrees_360, t => b / Degrees_90); i := i + 1; a := (if is_Fore then a + longitude_Spacing else a - longitude_Spacing); end loop; declare tmp : constant Real := start_nx; begin if is_Fore then start_nx := ca * start_nx + sa * start_ny; start_ny := -sa * tmp + ca * start_ny; else start_nx := ca * start_nx - sa * start_ny; start_ny := sa * tmp + ca * start_ny; end if; end; a := (if is_Fore then 0.0 else Degrees_360); b := b + latitude_Spacing; end loop; -- Add pole vertex. -- the_Vertices (i).Site := pole_Site; the_Vertices (i).Coords := (s => 0.5, t => 1.0); -- Set indices. -- declare i : long_Index_t := 1; Start : Index_t := 1; hoop_Start : Index_t := 1; pole_Index : constant Index_t := vertex_Count; begin for each_Hoop in 1 .. quality_Level loop for Each in 1 .. sides_Count loop declare function next_hoop_Vertex return Index_t is begin if Each = sides_Count then return hoop_Start; else return Start + 1; end if; end next_hoop_Vertex; begin if each_Hoop = quality_Level then if is_Fore then the_Indices (i) := Start; i := i + 1; the_Indices (i) := next_hoop_Vertex; i := i + 1; the_Indices (i) := pole_Index; i := i + 1; else the_Indices (i) := Start; i := i + 1; the_Indices (i) := pole_Index; i := i + 1; the_Indices (i) := next_hoop_Vertex; i := i + 1; end if; else declare v1 : constant Index_t := Start; v2 : constant Index_t := next_hoop_Vertex; v3 : constant Index_t := v1 + sides_Count; v4 : constant Index_t := v2 + sides_Count; begin if is_Fore then the_Indices (i) := v1; i := i + 1; the_Indices (i) := v2; i := i + 1; the_Indices (i) := v3; i := i + 1; the_Indices (i) := v2; i := i + 1; the_Indices (i) := v4; i := i + 1; the_Indices (i) := v3; i := i + 1; else the_Indices (i) := v1; i := i + 1; the_Indices (i) := v3; i := i + 1; the_Indices (i) := v2; i := i + 1; the_Indices (i) := v2; i := i + 1; the_Indices (i) := v3; i := i + 1; the_Indices (i) := v4; i := i + 1; end if; end; end if; Start := Start + 1; end; end loop; hoop_Start := hoop_Start + sides_Count; end loop; if Self.Image /= null_Asset then set_the_Texture: declare use Texture; the_Image : constant Image := IO.to_Image (Self.Image); the_Texture : constant Texture.object := Forge.to_Texture (the_Image); begin cap_Geometry.Texture_is (the_Texture); end set_the_Texture; end if; Vertices_are (cap_Geometry.all, the_Vertices); declare the_Primitive : constant Primitive.indexed.view := Primitive.indexed.new_Primitive (Primitive.Triangles, the_Indices); begin cap_Geometry.add (Primitive.view (the_Primitive)); end; end; return cap_Geometry; end new_Cap; begin cap_1_Geometry := new_Cap (is_Fore => True); cap_2_Geometry := new_Cap (is_Fore => False); end; the_shaft_Geometry.Model_is (Self.all'unchecked_Access); cap_1_Geometry .Model_is (Self.all'unchecked_Access); cap_2_Geometry .Model_is (Self.all'unchecked_Access); return (1 => the_shaft_Geometry.all'Access, 2 => cap_1_Geometry.all'Access, 3 => cap_2_Geometry.all'Access); end to_GL_Geometries; end openGL.Model.capsule.textured;