1. pragma Warnings (Off); 
  2. pragma Style_Checks (Off); 
  3.  
  4. with Ada.Exceptions;                    use Ada.Exceptions; 
  5. with Ada.Strings.Fixed;                 use Ada.Strings, Ada.Strings.Fixed; 
  6. with Ada.Strings.Unbounded;             use Ada.Strings.Unbounded; 
  7.  -- with Ada.Characters.Handling;           use Ada.Characters.Handling; 
  8. with Ada.Unchecked_Conversion; 
  9.  
  10. with UnZip.Streams; 
  11. with Float_portable_binary_transfer; 
  12. pragma Elaborate_All (Float_portable_binary_transfer); 
  13.  
  14. with GLOBE_3D.Textures; 
  15. with GL.IO; 
  16.  
  17. package body GLOBE_3D.IO is 
  18.  
  19.   ------------------------------------------------ 
  20.   -- Common, internal definitions, routines, .. . -- 
  21.   ------------------------------------------------ 
  22.  
  23.   stop_type : constant Character := 
  24.     Character'Val (26); -- Ctrl - Z to stop typing a binary file 
  25.  
  26.   signature_obj : constant String := 
  27.     "GLOBE_3D 3D Binary Object File (" & object_extension & "). " & 
  28.     "Format version : 2 - Apr - 2008." & stop_type; 
  29.  
  30.   signature_bsp : constant String := 
  31.     "GLOBE_3D Binary Space Partition File (" & BSP_extension & "). " & 
  32.     "Format version : 2 - Apr - 2008." & stop_type; 
  33.  
  34.   subtype U8 is GL.Ubyte; 
  35.   type U16 is mod 2 ** 16;  for U16'Size use 16; 
  36.   type U32 is mod 2 ** 32;  for U32'Size use 32; 
  37.  
  38.   type I16 is range -2 ** 15 .. 2 ** 15 - 1; for I16'Size use 16; 
  39.   type I32 is range -2 ** 31 .. 2 ** 31 - 1; for I32'Size use 32; 
  40.  
  41.   f_scaling : constant := 2.0**24; 
  42.   package FFBT is 
  43.     new Float_portable_binary_transfer (GL.C_Float, I32, I16, True, f_scaling); 
  44.   use FFBT; 
  45.   d_scaling : constant := 2.0**27; -- 53/2=26.5 
  46.   package DFBT is 
  47.     new Float_portable_binary_transfer (GL.Double, I32, I16, True, d_scaling); 
  48.   use DFBT; 
  49.  
  50.   function Cvt is new Ada.Unchecked_Conversion (I16, U16); 
  51.   function Cvt is new Ada.Unchecked_Conversion (I32, U32); 
  52.   function Cvt is new Ada.Unchecked_Conversion (U16, I16); 
  53.   function Cvt is new Ada.Unchecked_Conversion (U32, I32); 
  54.  
  55.   generic 
  56.     type Number is mod <>; 
  57.   procedure Read_Intel_x86_number (sb : in out GL.IO.Input_buffer; n : out Number); 
  58.  
  59.   procedure Read_Intel_x86_number (sb : in out GL.IO.Input_buffer; n : out Number) is 
  60.     b : U8; 
  61.     m : Number := 1; 
  62.     bytes : constant Integer := Number'Size / 8; 
  63.   begin 
  64.     n := 0; 
  65.     for i in 1 .. bytes loop 
  66.       GL.IO.Get_Byte (sb, b); 
  67.       n := n + m * Number (b); 
  68.       m := m * 256; 
  69.     end loop; 
  70.   end Read_Intel_x86_number; 
  71.  
  72.   procedure Read_Double ( 
  73.     sb : in out GL.IO.Input_buffer; 
  74.     n : out GL.Double 
  75. ) is 
  76.     procedure Read_Intel is new Read_Intel_x86_number (U16); 
  77.     procedure Read_Intel is new Read_Intel_x86_number (U32); 
  78.     m1, m2 : U32; e : U16; 
  79.   begin 
  80.     Read_Intel (sb, m1); 
  81.     Read_Intel (sb, m2); 
  82.     Read_Intel (sb, e); 
  83.     Merge (Cvt (m1), Cvt (m2), Cvt (e), n); 
  84.     -- Double is stored in two parts due to the absence of 
  85.     -- 64 - bit integers on certain compilers (e.g. OA 8.2) 
  86.   end Read_Double; 
  87.  
  88.   generic 
  89.     s : Ada.Streams.Stream_IO.Stream_Access; 
  90.     type Number is mod <>; 
  91.   procedure Write_Intel_x86_number (n : in Number); 
  92.  
  93.   procedure Write_Intel_x86_number (n : in Number) is 
  94.     m : Number := n; 
  95.     bytes : constant Integer := Number'Size/8; 
  96.   begin 
  97.     for i in 1 .. bytes loop 
  98.       U8'Write (s, U8 (m mod 256)); 
  99.       m := m / 256; 
  100.     end loop; 
  101.   end Write_Intel_x86_number; 
  102.  
  103.   procedure Write_Double ( 
  104.     s : Ada.Streams.Stream_IO.Stream_Access; 
  105.     n : in GL.Double) 
  106.   is 
  107.     procedure Write_Intel is new Write_Intel_x86_number (s, U16); 
  108.     procedure Write_Intel is new Write_Intel_x86_number (s, U32); 
  109.     m1, m2 : I32; e : I16; 
  110.   begin 
  111.     Split (n, m1, m2, e); 
  112.     -- Double is stored in two parts due to the absence of 
  113.     -- 64 - bit integers on certain compilers (e.g. OA 8.2) 
  114.     Write_Intel (Cvt (m1)); 
  115.     Write_Intel (Cvt (m2)); 
  116.     Write_Intel (Cvt (e)); 
  117.   end Write_Double; 
  118.  
  119.   procedure Write_String ( 
  120.     s   : in  Ada.Streams.Stream_IO.Stream_Access; 
  121.     str : in  String 
  122. ) 
  123.   is 
  124.     tstr : constant String := Trim (str, Right); 
  125.   begin 
  126.     U8'Write (s, tstr'Length); 
  127.     String'Write (s, tstr); 
  128.   end Write_String; 
  129.  
  130.   procedure Read_String ( 
  131.     sb : in out GL.IO.Input_buffer; 
  132.     str : out String 
  133. ) 
  134.   is 
  135.     l8 : U8; 
  136.     l : Natural; 
  137.   begin 
  138.     GL.IO.Get_Byte (sb, l8); 
  139.     l := Natural (l8); 
  140.     if l > str'Length then 
  141.       raise Constraint_Error; 
  142.     end if; 
  143.     for i in str'First .. str'First + l - 1 loop 
  144.       GL.IO.Get_Byte (sb, l8); 
  145.       str (i) := Character'Val (l8); 
  146.     end loop; 
  147.     str (str'First + l .. str'Last) := (others => ' '); 
  148.   end Read_String; 
  149.  
  150.   ------------------- 
  151.   -- Object_3D I/O -- 
  152.   ------------------- 
  153.  
  154.   procedure Read ( 
  155.     s : in  Ada.Streams.Stream_IO.Stream_Access; 
  156.     o : out p_Object_3D 
  157. ) 
  158.   is 
  159.  
  160.     buf : GL.IO.Input_buffer; 
  161.  
  162.     procedure Read_Intel is new Read_Intel_x86_number (U16); 
  163.     procedure Read_Intel is new Read_Intel_x86_number (U32); 
  164.  
  165.     procedure Read_Float (n : out GL.C_Float) is 
  166.       m : U32; e : U16; 
  167.     begin 
  168.       Read_Intel (buf, m); 
  169.       Read_Intel (buf, e); 
  170.       Merge (Cvt (m), Cvt (e), n); 
  171.     end Read_Float; 
  172.  
  173.     procedure Read_Material_Float_vector (mfv : out GL.Material_Float_vector) is 
  174.     begin 
  175.       for i in mfv'Range loop 
  176.         Read_Float (mfv (i)); 
  177.       end loop; 
  178.     end Read_Material_Float_vector; 
  179.  
  180.     procedure Read_Point_3D (p : out Point_3D) is 
  181.     begin 
  182.       for i in p'Range loop 
  183.         Read_Double (buf, p (i)); 
  184.       end loop; 
  185.     end Read_Point_3D; 
  186.  
  187.     procedure Read_Map_idx_pair_array (m : out Map_idx_pair_array) is 
  188.     begin 
  189.       for i in m'Range loop 
  190.         Read_Double (buf, m (i).U); 
  191.         Read_Double (buf, m (i).V); 
  192.       end loop; 
  193.     end Read_Map_idx_pair_array; 
  194.  
  195.     v8 : U8; 
  196.     v32, mp32, mf32 : U32; 
  197.  
  198.     procedure Read_face (face : out Face_type; face_invar : in out Face_invariant_type) is 
  199.     begin 
  200.       -- 1/ Points 
  201.       for i in face.p'Range loop 
  202.         Read_Intel (buf, v32); 
  203.         face.p (i) := Integer (v32); 
  204.       end loop; 
  205.       -- 2/ Portal connection : object name is stored; 
  206.       --    access must be found later 
  207.       Read_String (buf, face_invar.connect_name); 
  208.       -- 3/ Skin 
  209.       GL.IO.Get_Byte (buf, v8); 
  210.       face.skin := Skin_Type'Val (v8); 
  211.       -- 4/ Mirror 
  212.       GL.IO.Get_Byte (buf, v8); 
  213.       face.mirror := Boolean'Val (v8); 
  214.       -- 5/ Alpha 
  215.       Read_Double (buf, face.alpha); 
  216.       -- 6/ Colour 
  217.       case face.skin is 
  218.         when colour_only | coloured_texture => 
  219.           Read_Double (buf, face.colour.red); 
  220.           Read_Double (buf, face.colour.green); 
  221.           Read_Double (buf, face.colour.blue); 
  222.         when others => 
  223.           null; 
  224.       end case; 
  225.       -- 7/ Material 
  226.       case face.skin is 
  227.         when material_only | material_texture => 
  228.           Read_Material_Float_vector (face.material.ambient); 
  229.           Read_Material_Float_vector (face.material.diffuse); 
  230.           Read_Material_Float_vector (face.material.specular); 
  231.           Read_Material_Float_vector (face.material.emission); 
  232.           Read_Float (face.material.shininess); 
  233.         when others => 
  234.           null; 
  235.       end case; 
  236.       -- 8/ Texture : texture name is stored; 
  237.       --    id must be found later 
  238.       Read_String (buf, face_invar.texture_name); 
  239.       GL.IO.Get_Byte (buf, v8); 
  240.       face.whole_texture := Boolean'Val (v8); 
  241.       GL.IO.Get_Byte (buf, v8); 
  242.       face.repeat_U := Positive'Val (v8); 
  243.       GL.IO.Get_Byte (buf, v8); 
  244.       face.repeat_V := Positive'Val (v8); 
  245.       if not face.whole_texture then 
  246.         Read_Map_idx_pair_array (face.texture_edge_map); 
  247.       end if; 
  248.     end Read_face; 
  249.     test_signature : String (signature_obj'Range); 
  250.     ID : Ident; 
  251.   begin 
  252.     String'Read (s, test_signature); 
  253.     if test_signature /= signature_obj then 
  254.       raise Bad_data_format; 
  255.     end if; 
  256.     GL.IO.Attach_Stream (b => buf, stm => s); 
  257.     Read_String (buf, ID); 
  258.     -- Read the object's dimensions, create object, read its contents 
  259.     Read_Intel (buf, mp32); 
  260.     Read_Intel (buf, mf32); 
  261.     o := new Object_3D (Integer (mp32), Integer (mf32)); 
  262.     o.ID := ID; 
  263.     for p in o.Point'Range loop 
  264.       Read_Point_3D (o.Point (p)); 
  265.     end loop; 
  266.     for f in o.face'Range loop 
  267.       Read_face (o.face (f), o.face_invariant (f)); 
  268.     end loop; 
  269.     Read_Point_3D (o.Centre); 
  270.     for i in Matrix_33'Range (1) loop 
  271.       for j in Matrix_33'Range (2) loop 
  272.         Read_Double (buf, o.rotation (i, j)); 
  273.       end loop; 
  274.     end loop; 
  275.     -- !! sub - objects : skipped !! 
  276.     -- Main operation done! 
  277.   end Read; 
  278.  
  279.   procedure Write ( 
  280.     s : in  Ada.Streams.Stream_IO.Stream_Access; 
  281.     o : in  Object_3D 
  282. ) 
  283.   is 
  284.  
  285.     procedure Write_Intel is new Write_Intel_x86_number (s, U16); 
  286.     procedure Write_Intel is new Write_Intel_x86_number (s, U32); 
  287.  
  288.     procedure Write_Float (n : in GL.C_Float) is 
  289.       m : I32; e : I16; 
  290.     begin 
  291.       Split (n, m, e); 
  292.       Write_Intel (Cvt (m)); 
  293.       Write_Intel (Cvt (e)); 
  294.     end Write_Float; 
  295.  
  296.     procedure Write_Material_Float_vector (mfv : in GL.Material_Float_vector) is 
  297.     begin 
  298.       for i in mfv'Range loop 
  299.         Write_Float (mfv (i)); 
  300.       end loop; 
  301.     end Write_Material_Float_vector; 
  302.  
  303.     procedure Write_Point_3D (p : in Point_3D) is 
  304.     begin 
  305.       for i in p'Range loop 
  306.         Write_Double (s, p (i)); 
  307.       end loop; 
  308.     end Write_Point_3D; 
  309.  
  310.     procedure Write_Map_idx_pair_array (m : in Map_idx_pair_array) is 
  311.     begin 
  312.       for i in m'Range loop 
  313.         Write_Double (s, m (i).U); 
  314.         Write_Double (s, m (i).V); 
  315.       end loop; 
  316.     end Write_Map_idx_pair_array; 
  317.  
  318.     procedure Write_face (face : Face_type; face_invar : Face_invariant_type) is 
  319.     begin 
  320.       -- 1/ Points 
  321.       for i in face.p'Range loop 
  322.         Write_Intel (U32 (face.p (i))); 
  323.       end loop; 
  324.       -- 2/ Portal connection : object name is stored 
  325.       if face.connecting = null then 
  326.         Write_String (s, empty); 
  327.       else 
  328.         Write_String (s, face.connecting.ID); 
  329.       end if; 
  330.       -- 3/ Skin 
  331.       U8'Write (s, Skin_Type'Pos (face.skin)); 
  332.       -- 4/ Mirror 
  333.       U8'Write (s, Boolean'Pos (face.mirror)); 
  334.       -- 5/ Alpha 
  335.       Write_Double (s, face.alpha); 
  336.       -- 6/ Colour 
  337.       case face.skin is 
  338.         when colour_only | coloured_texture => 
  339.           Write_Double (s, face.colour.red); 
  340.           Write_Double (s, face.colour.green); 
  341.           Write_Double (s, face.colour.blue); 
  342.         when others => 
  343.           null; 
  344.       end case; 
  345.       -- 7/ Material 
  346.       case face.skin is 
  347.         when material_only | material_texture => 
  348.           Write_Material_Float_vector (face.material.ambient); 
  349.           Write_Material_Float_vector (face.material.diffuse); 
  350.           Write_Material_Float_vector (face.material.specular); 
  351.           Write_Material_Float_vector (face.material.emission); 
  352.           Write_Float (face.material.shininess); 
  353.         when others => 
  354.           null; 
  355.       end case; 
  356.       -- 8/ Texture : texture name is stored 
  357.       if face.texture = null_image then 
  358.         -- Maybe a texture name has been given with Texture_name_hint, 
  359.         -- but was not yet attached to a GL ID number through Rebuild_Links 
  360.         Write_String (s, face_invar.texture_name); 
  361.       else 
  362.         -- Usual way : We can get the texture name associated to the 
  363.         -- GL ID number; name is stored by GLOBE_3D.Textures. 
  364.         Write_String (s, Textures.Texture_name (face.texture, False)); 
  365.       end if; 
  366.       U8'Write (s, Boolean'Pos (face.whole_texture)); 
  367.       U8'Write (s, Positive'Pos (face.repeat_U)); 
  368.       U8'Write (s, Positive'Pos (face.repeat_V)); 
  369.       if not face.whole_texture then 
  370.         Write_Map_idx_pair_array (face.texture_edge_map); 
  371.       end if; 
  372.     end Write_face; 
  373.  
  374.   begin 
  375.     String'Write (s, signature_obj); 
  376.     Write_String (s, o.ID); 
  377.     Write_Intel (U32 (o.Max_points)); 
  378.     Write_Intel (U32 (o.Max_faces)); 
  379.     for p in o.Point'Range loop 
  380.       Write_Point_3D (o.Point (p)); 
  381.     end loop; 
  382.     for f in o.face'Range loop 
  383.       Write_face (o.face (f), o.face_invariant (f)); 
  384.     end loop; 
  385.     Write_Point_3D (o.Centre); 
  386.     for i in Matrix_33'Range (1) loop 
  387.       for j in Matrix_33'Range (2) loop 
  388.         Write_Double (s, o.rotation (i, j)); 
  389.       end loop; 
  390.     end loop; 
  391.     -- !! sub - objects : skipped !! 
  392.     -- Main operation done! 
  393.   end Write; 
  394.  
  395.   generic 
  396.     type Anything is private; 
  397.     extension : String; 
  398.     animal : String; 
  399.     with procedure Read ( 
  400.       s : in  Ada.Streams.Stream_IO.Stream_Access; 
  401.       a : out Anything 
  402. ); 
  403.   procedure Load_generic (name_in_resource : String; a : out Anything); 
  404.  
  405.   procedure Load_generic (name_in_resource : String; a : out Anything) is 
  406.     name_ext : constant String := name_in_resource & extension; 
  407.  
  408.     procedure Try (zif : in out Zip.Zip_info; name : String) is 
  409.       use UnZip.Streams; 
  410.       fobj : Zipped_File_Type; 
  411.     begin -- Try 
  412.       Load_if_needed (zif, name); 
  413.       Open (fobj, zif, name_ext); 
  414.       Read (Stream (fobj), a); 
  415.       Close (fobj); 
  416.     exception 
  417.       when Zip.File_name_not_found => 
  418.         raise; 
  419.       when e:others => 
  420.         Raise_Exception ( 
  421.           Exception_Identity (e), 
  422.           Exception_Message (e) & " on " & animal & " : " & name_ext 
  423. ); 
  424.     end Try; 
  425.   begin 
  426.     begin 
  427.       Try (zif_level, To_String (level_data_name)); 
  428.     exception 
  429.       when Zip.File_name_not_found | 
  430.            Zip.Zip_file_open_Error => 
  431.         -- Not found in level - specific pack 
  432.         Try (zif_global, To_String (global_data_name)); 
  433.     end; 
  434.   exception 
  435.     when Zip.File_name_not_found | 
  436.          Zip.Zip_file_open_Error => 
  437.       -- Never found - neither in level, nor in global pack 
  438.       Raise_Exception ( 
  439.         Missing_object'Identity, 
  440.         animal & " not found in any data resource pack : " & name_in_resource 
  441. ); 
  442.   end Load_generic; 
  443.  
  444.   procedure Load_Internal is 
  445.     new Load_generic ( 
  446.       Anything  => p_Object_3D, 
  447.       extension => object_extension, 
  448.       animal    => "object", 
  449.       Read      => Read 
  450. ); 
  451.  
  452.   procedure Load (name_in_resource : String; o : out p_Object_3D) 
  453.   renames Load_Internal; 
  454.  
  455.   procedure Load_file (file_name : String; o : out p_Object_3D) is 
  456.     use Ada.Streams.Stream_IO; 
  457.     f : File_Type; 
  458.   begin 
  459.     Open (f, in_file, file_name); 
  460.     Read (Stream (f), o); 
  461.     Close (f); 
  462.   end Load_file; 
  463.  
  464.   procedure Save_file (file_name : String; o : in Object_3D'Class) is 
  465.     use Ada.Streams.Stream_IO; 
  466.     f : File_Type; 
  467.   begin 
  468.     Create (f, out_file, file_name); 
  469.     Write (Stream (f), Object_3D (o)); 
  470.     -- ^ endian - proof and floating - point hardware neutral; 
  471.     --   using stream attribute would be machine - specific. 
  472.     Close (f); 
  473.   end Save_file; 
  474.  
  475.   procedure Save_file (o : in Object_3D'Class) is 
  476.   begin 
  477.     Save_file (Trim (o.ID, Right) & object_extension, o); 
  478.   end Save_file; 
  479.  
  480.   ------------- 
  481.   -- BSP I/O -- 
  482.   ------------- 
  483.  
  484.   -- Write a BSP tree to a stream 
  485.  
  486.   procedure Write ( 
  487.     s : in  Ada.Streams.Stream_IO.Stream_Access; 
  488.     tree : in BSP.p_BSP_node 
  489. ) 
  490.   is 
  491.     procedure Write_Intel is new Write_Intel_x86_number (s, U32); 
  492.     use BSP; 
  493.  
  494.     n : Natural := 0; 
  495.  
  496.     procedure Numbering (node : p_BSP_node) is 
  497.     begin 
  498.       if node /= null then 
  499.         n := n + 1; 
  500.         node.node_id := n; 
  501.         Numbering (node.front_child); 
  502.         Numbering (node.back_child); 
  503.       end if; 
  504.     end Numbering; 
  505.  
  506.     procedure Save_node (node : p_BSP_node) is 
  507.     begin 
  508.       if node /= null then 
  509.         Write_Intel (U32 (node.node_id)); 
  510.         if node.front_child = null then 
  511.           Write_Intel (U32' (0)); 
  512.           if node.front_leaf = null then 
  513.             Write_String (s, empty); 
  514.           else 
  515.             Write_String (s, node.front_leaf.ID); 
  516.           end if; 
  517.         else 
  518.           Write_Intel (U32 (node.front_child.node_id)); 
  519.         end if; 
  520.         if node.back_child = null then 
  521.           Write_Intel (U32' (0)); 
  522.           if node.back_leaf = null then 
  523.             Write_String (s, empty); 
  524.           else 
  525.             Write_String (s, node.back_leaf.ID); 
  526.           end if; 
  527.         else 
  528.           Write_Intel (U32 (node.back_child.node_id)); 
  529.         end if; 
  530.         for i in node.normal'Range loop 
  531.           Write_Double (s, node.normal (i)); 
  532.         end loop; 
  533.         Write_Double (s, node.distance); 
  534.         -- 
  535.         Save_node (node.front_child); 
  536.         Save_node (node.back_child); 
  537.       end if; 
  538.     end Save_node; 
  539.  
  540.   begin 
  541.     Numbering (tree);                -- fill the node_id's 
  542.     String'Write (s, signature_bsp); -- header 
  543.     Write_Intel (U32 (n));           -- give the number of nodes first 
  544.     Save_node (tree); 
  545.   end Write; 
  546.  
  547.   -- Write a BSP tree to a file 
  548.  
  549.   procedure Save_file (file_name : String; tree : in BSP.p_BSP_node) is 
  550.     use Ada.Streams.Stream_IO; 
  551.     f : File_Type; 
  552.   begin 
  553.     if Index (file_name, ".")=0 then 
  554.       Create (f, out_file, file_name & BSP_extension); 
  555.     else 
  556.       Create (f, out_file, file_name); 
  557.     end if; 
  558.     Write (Stream (f), tree); 
  559.     Close (f); 
  560.   end Save_file; 
  561.  
  562.   procedure Load ( 
  563.     name_in_resource : in  String; 
  564.     referred         : in  Map_of_Visuals; 
  565.     tree             : out BSP.p_BSP_node 
  566. ) 
  567.   is 
  568.  
  569.     function Find_object (ID : Ident; tolerant : Boolean) return p_Object_3D is 
  570.     begin 
  571.       if ID = empty then 
  572.         return null; 
  573.       else 
  574.         return p_Object_3D ( 
  575.           Visuals_Mapping.Element ( 
  576.             Container => Visuals_Mapping.Map (referred), 
  577.             Key       => Ada.Strings.Unbounded.To_Unbounded_String (ID) 
  578. ) 
  579. ); 
  580.       end if; 
  581.     exception 
  582.       when Constraint_Error => 
  583.         -- GNAT gives also the message: 
  584.         -- no element available because key not in map 
  585.         if tolerant then 
  586.           return null; 
  587.         else 
  588.           Raise_Exception ( 
  589.             Missing_object_in_BSP'Identity, 
  590.             "Object not found : [" & Trim (ID, Right) & ']' 
  591. ); 
  592.         end if; 
  593.     end Find_object; 
  594.  
  595.     procedure Read ( 
  596.       s            : in  Ada.Streams.Stream_IO.Stream_Access; 
  597.       tree         : out BSP.p_BSP_node 
  598. ) 
  599.     is 
  600.       use BSP; 
  601.       buf : GL.IO.Input_buffer; 
  602.       procedure Read_Intel is new Read_Intel_x86_number (U32); 
  603.  
  604.       test_signature : String (signature_bsp'Range); 
  605.       n, j, k : U32; 
  606.       ID : Ident; 
  607.       tol : constant Boolean := False; 
  608.     begin 
  609.       String'Read (s, test_signature); 
  610.       if test_signature /= signature_bsp then 
  611.         raise Bad_data_format; 
  612.       end if; 
  613.       GL.IO.Attach_Stream (b => buf, stm => s); 
  614.       Read_Intel (buf, n); 
  615.       if n < 1 then 
  616.         tree := null; 
  617.         return; 
  618.       end if; 
  619.       declare 
  620.         -- We put all the new - born nodes into a farm with numbered boxes, 
  621.         -- because only the numbers are stored in the BSP file. 
  622.         -- Once the nodes are linked together through accesses (pointers), 
  623.         -- we can forget the farm and let the tree float .. . 
  624.         farm : array (0 .. n) of p_BSP_Node; 
  625.       begin 
  626.         farm (0) := null; 
  627.         for i in 1 .. n loop 
  628.           farm (i) := new BSP_Node; 
  629.         end loop; 
  630.         for i in 1 .. n loop 
  631.           Read_Intel (buf, j); -- node_id 
  632.           farm (j).node_id := Integer (j); 
  633.           Read_Intel (buf, k); 
  634.           farm (j).front_child := farm (k); 
  635.           if k = 0 then -- it is a front leaf - > associate object 
  636.             Read_String (buf, ID); 
  637.             farm (j).front_leaf := Find_object (ID, tol); 
  638.           end if; 
  639.           Read_Intel (buf, k); 
  640.           farm (j).back_child := farm (k); 
  641.           if k = 0 then -- it is a back leaf - > associate object 
  642.             Read_String (buf, ID); 
  643.             farm (j).back_leaf := Find_object (ID, tol); 
  644.           end if; 
  645.           -- The node's geometric information (a plane): 
  646.           for ii in farm (j).normal'Range loop 
  647.             Read_Double (buf, farm (j).normal (ii)); 
  648.           end loop; 
  649.           Read_Double (buf, farm (j).distance); 
  650.         end loop; 
  651.         tree := farm (1); 
  652.       end; 
  653.     end Read; 
  654.  
  655.     procedure Load_Internal is 
  656.       new Load_generic ( 
  657.         Anything  => BSP.p_BSP_node, 
  658.         extension => BSP_extension, 
  659.         animal    => "BSP tree", 
  660.         Read      => Read 
  661. ); 
  662.  
  663.   begin 
  664.     Load_Internal (name_in_resource, tree); 
  665.   end Load; 
  666.  
  667. end GLOBE_3D.IO;