1. pragma Warnings (Off); 
  2. pragma Style_Checks (Off); 
  3.  
  4. with GLOBE_3D.Options, 
  5.      GLOBE_3D.Textures, 
  6.      GLOBE_3D.Math; 
  7.  
  8. with Ada.Exceptions; use Ada.Exceptions; 
  9. with ada.text_io;    use ada.text_io; 
  10.  
  11. with ada.unchecked_Conversion; 
  12.  
  13. with System; 
  14.  
  15. package body GLOBE_3D.tri_Mesh is 
  16.  
  17.   use GLOBE_3D.Options; 
  18.  
  19.   package G3DT renames GLOBE_3D.Textures; 
  20.   package G3DM renames GLOBE_3D.Math; 
  21.  
  22.    procedure dummy is begin null; end; 
  23.  
  24.    -- 'vertex_cache_optimise' is based on algorithm descibed here . .. http://home.comcast.net/~tom_forsyth/papers/fast_vert_cache_opt.html 
  25.    -- 
  26.    procedure vertex_cache_optimise (Vertices  : in out GL.geometry.GL_Vertex_array;   Indices  : in out GL.geometry.vertex_Id_array) 
  27.    is 
  28.       use GL, GL.Geometry; 
  29.  
  30.       --subtype vertex_Id   is Positive; 
  31.       subtype triangle_Id is positive_uInt; 
  32.  
  33.       type triangle_Indices is array (Positive range <>) of triangle_Id; 
  34.  
  35.       function Indices_Index (the_Face  : in positive_uInt;   the_Vertex  : in positive_uInt) return positive_uInt 
  36.       is 
  37.       begin 
  38.          return 3 * (the_Face - 1)  + the_Vertex; 
  39.       end; 
  40.  
  41.       function face_vertex_Id (the_Face  : in positive_uInt;   the_Vertex  : in positive_uInt) return GL.geometry.Vertex_id 
  42.       is 
  43.       begin 
  44.          return Indices (indices_Index (the_Face, the_Vertex)); 
  45.       end; 
  46.  
  47.       Max_triangles_per_vertex  : constant := 150;  -- tbd : what is a sensible size here ? 
  48.       MaxSizeVertexCache        : constant := 35; 
  49.  
  50.       type vco_Vertex is 
  51.          record 
  52.             cache_Position  : Integer   := - 1;                                    -- Its position in the modelled cache ( - 1 if it is not in the cache) 
  53.             Score           : GL.Double;                                         -- Its current score 
  54.  
  55.             Triangles          : triangle_Indices (1 .. Max_triangles_per_vertex); -- The list of triangle indices that use it, ordered so the triangle indices yet to be added are listed first, 
  56.                                                                                   -- followed by the triangle indices that have already been added to the draw list. 
  57.  
  58.             tri_Count          : Natural := 0;                                    -- tbd : should only be needed for debugging 
  59.             tri_Count_unadded  : Natural;                                         -- The number of triangles not yet added that use it 
  60.          end record; 
  61.  
  62.       function Score_of (the_Vertex  : in vco_Vertex) return GL.Double 
  63.       is 
  64.       begin 
  65.  
  66.          if the_Vertex.tri_Count_unadded = 0 then  -- No tri needs this vertex! 
  67.             return - 1.0; 
  68.          end if; 
  69.  
  70.          declare 
  71.             use globe_3d.REF; 
  72.  
  73.             CacheDecayPower    : constant := 1.5; 
  74.             LastTriScore       : constant := 0.75; 
  75.             ValenceBoostScale  : constant := 2.0; 
  76.             ValenceBoostPower  : constant := 0.5; 
  77.  
  78.             Score              : GL.Double      := 0.0; 
  79.             cache_Position     : Integer   renames the_Vertex.cache_Position; 
  80.          begin 
  81.  
  82.             if cache_Position < 0 then   -- Vertex is not in LRU cache 
  83.                null;                     -- so no score. 
  84.             else 
  85.  
  86.                if cache_Position < 3 then   -- This vertex was used in the last triangle, so it has a fixed score, whichever of the three 
  87.                   Score := LastTriScore;    -- it's in. Otherwise, you can get very different answers depending on whether you add 
  88.                                             -- the triangle 1, 2, 3 or 3, 1, 2 - which is silly. 
  89.                else 
  90.                   pragma assert (cache_Position < MaxSizeVertexCache); 
  91.  
  92.                   declare 
  93.                      Scaler  : constant := 1.0 / (MaxSizeVertexCache - 3); 
  94.                   begin 
  95.                      Score := 1.0  -  GL.Double (cache_Position - 3) * Scaler;   -- Points for being high in the cache. 
  96.                      Score := Score ** CacheDecayPower; 
  97.                   end; 
  98.                end if; 
  99.  
  100.             end if; 
  101.  
  102.             declare 
  103.                valence_Boost  : GL.Double := GL.Double (the_Vertex.tri_Count_unadded) ** ( - ValenceBoostPower); 
  104.             begin 
  105.                Score := Score  +  ValenceBoostScale * valence_Boost;   -- Bonus points for having a low number of tris still to 
  106.             end;                                                       -- use the vert, so we get rid of lone verts quickly. 
  107.  
  108.             return Score; 
  109.          end; 
  110.       end Score_of; 
  111.  
  112.       procedure rid_Triangle (in_Vertex     : in out vco_Vertex; 
  113.                               the_Triangle  : in     triangle_Id) 
  114.       is 
  115.          triangle_Found  : Boolean := False; 
  116.       begin 
  117.          for Each in 1 .. in_Vertex.tri_Count_unadded loop 
  118.  
  119.             if triangle_Found then 
  120.                in_Vertex.Triangles (Each - 1) := in_Vertex.Triangles (Each); 
  121.  
  122.             elsif in_Vertex.Triangles (Each) = the_Triangle then 
  123.                triangle_Found := True; 
  124.             end if; 
  125.  
  126.          end loop; 
  127.  
  128.          in_Vertex.tri_Count_unadded := in_Vertex.tri_Count_unadded - 1; 
  129.       end; 
  130.  
  131.       type vco_Triangle is 
  132.          record 
  133.             Added       : Boolean  := False;               -- Whether it has been added to the draw list or not 
  134.             Score       : GL.Double;                       -- the triangles score (the sum of the scores of its vertices) 
  135.          end record; 
  136.  
  137.       type vco_vertex_Array is array (Vertices'Range) of vco_Vertex; 
  138.       type access_vco_vertex_Array is access all vco_vertex_Array; 
  139.  
  140.       procedure free is new ada.unchecked_deallocation (vco_vertex_Array, access_vco_vertex_Array); 
  141.  
  142.       num_Faces      : constant positive_uInt := indices'Length / 3; 
  143.       vco_Vertices   : access_vco_vertex_Array                      := new vco_vertex_Array;   -- can be very large, so create in the heap 
  144.       vco_Triangles  : array (1 .. num_Faces)  of vco_Triangle; 
  145.  
  146.       type LRU_Cache is array (Natural range <>) of GL.geometry.vertex_Id; 
  147.  
  148.       the_LRU_Cache   : LRU_Cache (0 .. MaxSizeVertexCache - 1); 
  149.       LRU_Cache_last  : Integer  := - 1; 
  150.  
  151.       procedure add_recent_Vertices_to_LRU_Cache (v1, v2, v3  : in GL.geometry.vertex_Id) 
  152.       is 
  153.          prior_Cache  : LRU_Cache := the_LRU_Cache (0 .. LRU_Cache_last); 
  154.       begin 
  155.          the_LRU_Cache (0) := v1; 
  156.          the_LRU_Cache (1) := v2; 
  157.          the_LRU_Cache (2) := v3; 
  158.  
  159.          LRU_Cache_last := 2; 
  160.  
  161.          for Each in prior_Cache'Range loop 
  162.  
  163.             if not (prior_Cache (Each) = v1 
  164.                     or else prior_Cache (Each) = v2 
  165.                     or else prior_Cache (Each) = v3) 
  166.             then 
  167.                LRU_Cache_last                 := LRU_Cache_last + 1; 
  168.                the_LRU_Cache (LRU_Cache_last) := prior_Cache (Each); 
  169.             end if; 
  170.  
  171.          end loop; 
  172.  
  173.       end add_recent_Vertices_to_LRU_Cache; 
  174.  
  175.       function tri_Score_of (triangle_Id  : in positive_uInt) return GL.Double 
  176.       is 
  177.          use GL; 
  178.          the_Triangle  : vco_Triangle renames vco_Triangles (triangle_Id); 
  179.  
  180.          Base          : positive_uInt              := positive_uInt (triangle_Id - 1) * 3; 
  181.          v1_Id         : GL.geometry.vertex_Id renames Indices (base + 1); 
  182.          v2_Id         : GL.geometry.vertex_Id renames Indices (base + 2); 
  183.          v3_Id         : GL.geometry.vertex_Id renames Indices (base + 3); 
  184.  
  185.          Score         : GL.Double; 
  186.       begin 
  187.          Score :=         vco_Vertices (v1_Id).Score; 
  188.          Score := Score + vco_Vertices (v2_Id).Score; 
  189.          Score := Score + vco_Vertices (v3_Id).Score; 
  190.  
  191.          return Score; 
  192.       end tri_Score_of; 
  193.  
  194.       best_Triangle        : triangle_Id; 
  195.       best_Triangle_score  : GL.Double  := GL.Double'First; 
  196.  
  197.       new_face_Indices       : GL.geometry.vertex_Id_array (Indices'Range);    -- the resulting optimised triangle indices. 
  198.  --        new_face_Indices       : triangle_vertex_Indices (o.Face_Indices'Range);    -- the resulting optimised triangle indices. 
  199.  --  --      new_face_Indices_last  : Natural := new_face_Indices'first - 1; 
  200.    begin 
  201.       --put_Line ("start optimise !"); 
  202.  
  203.       -- combined pass's : - increments the counter of the number of triangles that use each vertex 
  204.       --                  - adds the triangle to the vertex's triangle list, for each vertex. 
  205.       -- 
  206.       for Each in 1 .. num_Faces loop 
  207.          declare 
  208.             procedure add_face_Vertex (which_vertex  : positive_uInt) 
  209.             is 
  210.                the_Vertex  : vco_Vertex renames vco_Vertices (Indices ((Each - 1) * 3  + which_vertex)); 
  211.             begin 
  212.                the_Vertex.tri_Count                        := the_Vertex.tri_Count + 1; 
  213.                the_Vertex.Triangles (the_Vertex.tri_Count) := triangle_Id (Each); 
  214.  
  215.                the_Vertex.tri_Count_unadded                := the_Vertex.tri_Count; 
  216.             exception 
  217.                when constraint_Error => 
  218.                   put_Line ("vco_Triangles max exceeded . .. increase Max_triangles_per_vertex !!"); 
  219.                   raise; 
  220.             end; 
  221.          begin 
  222.             add_face_Vertex (1); 
  223.             add_face_Vertex (2); 
  224.             add_face_Vertex (3); 
  225.          end; 
  226.       end loop; 
  227.  
  228.       -- calculate initial vertex scores 
  229.       -- 
  230.       for Each in vco_Vertices'Range loop 
  231.          vco_Vertices (Each).Score := Score_of (vco_Vertices (Each));   -- tbd : 'Score_of' function should probably be 'set_Score' procedure ? 
  232.       end loop; 
  233.  
  234.       -- calculate initial triangle scores 
  235.       -- 
  236.       for Each in vco_Triangles'Range loop 
  237.          vco_Triangles (Each).Score := tri_Score_of (Each);   -- tbd : 'Score_of' function should probably be 'set_Score' procedure ? 
  238.  
  239.          if vco_Triangles (Each).Score > best_Triangle_score then 
  240.             best_Triangle       := Each; 
  241.             best_Triangle_score := vco_Triangles (Each).Score; 
  242.          end if; 
  243.       end loop; 
  244.  
  245.       -- re - order all triangle indices. 
  246.       -- 
  247.       for Each in new_face_Indices'Range loop 
  248.          declare 
  249.             best_Triangle_v1  : Vertex_Id := face_vertex_Id (best_Triangle, 1); 
  250.             best_Triangle_v2  : Vertex_Id := face_vertex_Id (best_Triangle, 2); 
  251.             best_Triangle_v3  : Vertex_Id := face_vertex_Id (best_Triangle, 3); 
  252.          begin 
  253.             -- add best triangle to new draw list & remove the best triangle from each of its vertices. 
  254.             -- 
  255.             new_face_Indices (Each)             := Indices (best_Triangle); 
  256.             vco_Triangles (best_Triangle).Added := True; 
  257.  
  258.             rid_Triangle (in_vertex => vco_Vertices (best_Triangle_v1),   the_triangle => best_Triangle); 
  259.             rid_Triangle (in_vertex => vco_Vertices (best_Triangle_v2),   the_triangle => best_Triangle); 
  260.             rid_Triangle (in_vertex => vco_Vertices (best_Triangle_v3),   the_triangle => best_Triangle); 
  261.  
  262.             -- update LRU cache 
  263.             -- 
  264.             add_recent_Vertices_to_LRU_Cache (best_Triangle_v1, best_Triangle_v2, best_Triangle_v3); 
  265.  
  266.             -- update vertex cache position and calculate new score and new scores of the triangles which use the vertex. 
  267.             -- also finds new best triangle. 
  268.             -- 
  269.             best_Triangle       := triangle_Id'last; 
  270.             best_Triangle_score := GL.Double'first; 
  271.  
  272.             for Each in 0 .. LRU_Cache_last loop 
  273.                declare 
  274.                   the_Vertex  : vco_Vertex renames vco_Vertices (the_LRU_Cache (Each)); 
  275.                begin 
  276.                   the_Vertex.cache_Position := Each; 
  277.                   the_Vertex.Score          := Score_of (the_Vertex);   -- re - score the vertex 
  278.  
  279.                   for Each in 1 .. the_Vertex.tri_Count_unadded loop  -- update all unadded triangle scores, which use this vertex. 
  280.                      declare 
  281.                         tri_Id  : triangle_Id renames the_Vertex.Triangles (Each); 
  282.                      begin 
  283.                         vco_Triangles (tri_Id).Score := tri_Score_of (tri_Id);   -- re - score the triangle 
  284.  
  285.                         if vco_Triangles (tri_Id).Score > best_Triangle_score then 
  286.                            best_Triangle       := tri_Id; 
  287.                            best_Triangle_score := vco_Triangles (tri_Id).Score; 
  288.                         end if; 
  289.                      end; 
  290.                   end loop; 
  291.  
  292.                end; 
  293.             end loop; 
  294.  
  295.             LRU_Cache_last := Integer'min (LRU_Cache_last,  (MaxSizeVertexCache - 1) - 3);  -- shrink LRU_Cache, if needed. 
  296.  
  297.             if best_Triangle = triangle_Id'last then   -- no vertex in the cache has any unadded triangles 
  298.  
  299.                for Each in vco_Triangles'Range loop    -- find new best_Triangle from remaining unadded triangles 
  300.  
  301.                   if         not vco_Triangles (Each).Added 
  302.                     and then vco_Triangles (Each).Score > best_Triangle_score 
  303.                   then 
  304.                      best_Triangle       := Each; 
  305.                      best_Triangle_score := vco_Triangles (Each).Score; 
  306.                   end if; 
  307.  
  308.                end loop; 
  309.  
  310.             end if; 
  311.  
  312.          end; 
  313.       end loop; 
  314.  
  315.       pragma assert (best_Triangle = triangle_Id'last); 
  316.  
  317.       Indices := new_face_Indices; 
  318.  
  319.       -- re - order vertices & re - map triangle indices to new vertex locations. 
  320.       -- 
  321.       declare 
  322.          new_Vertices       : GL.geometry.GL_Vertex_array (Vertices'Range); 
  323.          new_Vertices_last  : vertex_Id                                := 0; 
  324.  
  325.          is_Added           : array (Vertices'Range)        of Boolean  := (others => False); 
  326.          Mapping            : array (Vertices'Range) of Vertex_Id; 
  327.       begin 
  328.  
  329.          for Each in 1 .. num_Faces loop 
  330.             declare 
  331.  
  332.                procedure add_Vertex (old_vertex_Id  : in Vertex_Id) 
  333.                is 
  334.                begin 
  335.                   if not is_Added (old_vertex_Id) then 
  336.                      new_Vertices_last                := new_Vertices_last + 1; 
  337.                      new_Vertices (new_Vertices_last) := Vertices (old_vertex_Id);    -- add the vertex 
  338.  
  339.                      Mapping  (old_vertex_Id)         := new_Vertices_last;          -- remember mapping 
  340.                      is_Added (old_vertex_Id)         := True; 
  341.                   end if; 
  342.                end add_Vertex; 
  343.  
  344.             begin 
  345.                add_Vertex (face_vertex_Id (Each, 1)); 
  346.                add_Vertex (face_vertex_Id (Each, 2)); 
  347.                add_Vertex (face_vertex_Id (Each, 3)); 
  348.             end; 
  349.          end loop; 
  350.  
  351.          Vertices := new_Vertices;                                                 -- let Object use the new re - ordered vertices. 
  352.  
  353.          for Each in 1 .. num_Faces loop 
  354.             Indices (indices_Index (Each, 1)) := Mapping (Indices (indices_Index (Each, 1)));       -- re - map each triangles Indices. 
  355.             Indices (indices_Index (Each, 2)) := Mapping (Indices (indices_Index (Each, 2))); 
  356.             Indices (indices_Index (Each, 3)) := Mapping (Indices (indices_Index (Each, 3))); 
  357.          end loop; 
  358.  
  359.       end; 
  360.  
  361.       free (vco_Vertices);        -- clean up 
  362.    end vertex_cache_optimise; 
  363.  
  364. end GLOBE_3D.tri_Mesh; 
  365.