------------------------------------------------- ------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . D I A . P R I N T E R . M I S C -- -- -- -- B o d y -- -- -- -- Copyright (C) 2005-2007, GET-Telecom Paris. -- -- -- -- Ocarina is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. Ocarina is distributed in the hope that it will be -- -- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- -- Public License for more details. You should have received a copy of the -- -- GNU General Public License distributed with Ocarina; see file COPYING. -- -- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth -- -- Floor, Boston, MA 02111-1301, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- Ocarina is maintained by the Ocarina team -- -- (ocarina-users@listes.enst.fr) -- -- -- ------------------------------------------------------------------------------ with Output; use Output; with Unicode; use Unicode; with Unicode.CES; use Unicode.CES; with Unicode.Names.Basic_Latin; use Unicode.Names.Basic_Latin; with Sax.Encodings; use Sax.Encodings; with DOM.Core.Nodes; with Ocarina.Dia.Printer.Objects; with DOM.Core.Elements; with DOM.Core.Documents; with Ada.Strings.Fixed; with DOM.Core.Character_Datas; package body Ocarina.Dia.Printer.Misc is procedure Print_String (Str : DOM_String); ------------------------ -- Remove_First_Space -- ------------------------ function Remove_First_Space (input : String) return String is begin return Ada.Strings.Fixed.Trim (input, Ada.Strings.Left); end Remove_First_Space; ----------------------- -- Integer_To_String -- ----------------------- function Integer_To_String (input : Integer) return String is begin return Ada.Strings.Fixed.Trim (Integer'Image (input), Ada.Strings.Left); end Integer_To_String; --------------------- -- Float_To_String -- --------------------- function Float_To_String (input : Float) return String is begin return Ada.Strings.Fixed.Trim (Float'Image (input), Ada.Strings.Left); end Float_To_String; ----------------- -- Print_Point -- ----------------- function Print_Point (Pt : in Point) return String is begin return Float_To_String (Pt.X) & "," & Float_To_String (Pt.Y); end Print_Point; --------------------- -- Print_Rectangle -- --------------------- function Print_Rectangle (Rect : in Rectangle) return String is begin return Print_Point (Rect.TL) & ";" & Print_Point (Rect.BR); end Print_Rectangle; ---------------- -- Add_Points -- ---------------- function Add_Points (Pt1 : in Point; Pt2 : in Point) return Point is begin return ((Pt1.X + Pt2.X), (Pt1.Y + Pt2.Y)); end Add_Points; ---------------------- -- String to point -- ---------------------- function String_To_Point (Im : String) return Point is Comma : constant Natural := Ada.Strings.Fixed.Index (Im, ","); begin return (Float'Value (Im (Im'First .. Comma - 1)), Float'Value (Im (Comma + 1 .. Im'Last))); end String_To_Point; -------------------------- -- Add_Point_Connection -- -------------------------- function Add_Point_Connection (Doc : DOM.Core.Document; XML_Node : DOM.Core.Node) return Integer is use DOM.Core.Nodes; use DOM.Core.Elements; use DOM.Core.Documents; XML_Node2 : DOM.Core.Node := Last_Child (XML_Node); pragma Warnings (Off, XML_Node2); -- Kills warning "useless assignment to "XML_Node2", value never -- referenced" from GNAT. XML_Childs : DOM.Core.Node; XML_Element : constant DOM.Core.Element := Create_Element (Doc, "dia:point"); numConnec : Integer := 0; List_Attr : Named_Node_Map; Test_Node : DOM.Core.Node; begin List_Attr := Attributes (XML_Node2); if Length (List_Attr) /= 0 then Test_Node := Get_Named_Item (List_Attr, "name"); end if; while (Length (List_Attr) = 0) or else Test_Node = null or else Node_Value (Test_Node) /= "aadlbox_ports" loop XML_Node2 := Previous_Sibling (XML_Node2); List_Attr := Attributes (XML_Node2); Test_Node := Get_Named_Item (List_Attr, "name"); end loop; XML_Childs := First_Child (XML_Node2); while XML_Childs /= null loop XML_Childs := Next_Sibling (XML_Childs); numConnec := numConnec + 2; end loop; XML_Node2 := Last_Child (XML_Node); XML_Childs := First_Child (XML_Node2); while XML_Childs /= null loop XML_Childs := Next_Sibling (XML_Childs); numConnec := numConnec + 1; end loop; Set_Attribute (XML_Element, "val", Print_Point ((7.0, 6.0))); XML_Node2 := Append_Child (XML_Node2, XML_Element); return numConnec; end Add_Point_Connection; --------------------------- -- Get_Name_Of_XML_Port -- --------------------------- function Get_Name_Of_XML_Port (XML_Node : DOM.Core.Node) return String is use DOM.Core.Nodes; use DOM.Core.Character_Datas; XML_Childs : DOM.Core.Node := First_Child (XML_Node); List_Attr : Named_Node_Map; Test_Node : DOM.Core.Node; begin if Length (List_Attr) /= 0 then List_Attr := Attributes (XML_Childs); Test_Node := Get_Named_Item (List_Attr, "name"); end if; while (Length (List_Attr) = 0) or else Test_Node = null or else Node_Value (Test_Node) /= "port_declaration" loop XML_Childs := Next_Sibling (XML_Childs); List_Attr := Attributes (XML_Childs); Test_Node := Get_Named_Item (List_Attr, "name"); end loop; Test_Node := First_Child (XML_Childs); return Data (First_Child (Test_Node)); end Get_Name_Of_XML_Port; --------------- -- Find_Node -- --------------- function Find_Node (Doc : DOM.Core.Document; Node : Node_Id) return DOM.Core.Node is use DOM.Core.Nodes; use Ocarina.Dia.Printer.Objects; XML_Node : DOM.Core.Node := Doc; List_Node : DOM.Core.Node; Name : constant String := "#" & Get_Name (Node) & "#"; begin XML_Node := Last_Child (Doc); XML_Node := Last_Child (XML_Node); List_Node := First_Child (XML_Node); while List_Node /= null loop if Name = Get_Name_XML_Object (List_Node) then return List_Node; end if; List_Node := Next_Sibling (List_Node); end loop; raise Program_Error; return Doc; end Find_Node; function Find_Node (Doc : DOM.Core.Document; I : String) return DOM.Core.Node is use DOM.Core.Nodes; use Ocarina.Dia.Printer.Objects; XML_Node : DOM.Core.Node := Doc; List_Node : DOM.Core.Node; begin XML_Node := Last_Child (Doc); XML_Node := Last_Child (XML_Node); List_Node := First_Child (XML_Node); while List_Node /= null loop if I = Id (List_Node) then return List_Node; end if; List_Node := Next_Sibling (List_Node); end loop; raise Program_Error; return Doc; end Find_Node; --------------------- -- Find_Node_Value -- --------------------- function Find_Node_Value (XML_Node : DOM.Core.Node; Value_Type : String; Value : String) return DOM.Core.Node is use DOM.Core.Nodes; use Ocarina.Dia.Printer.Objects; List_Node : DOM.Core.Node; XML_Child : DOM.Core.Node; begin List_Node := First_Child (XML_Node); while List_Node /= null loop if Value = Node_Value (Get_Named_Item (Attributes (List_Node), "name")) then XML_Child := First_Child (List_Node); if Node_Name (XML_Child) = Value_Type then return Get_Named_Item (Attributes (XML_Child), "val"); else raise Program_Error; end if; end if; List_Node := Next_Sibling (List_Node); end loop; raise Program_Error; return XML_Node; end Find_Node_Value; -------- -- Id -- -------- function Id (Node : DOM.Core.Node) return String is use DOM.Core.Nodes; List_Attr : constant Named_Node_Map := Attributes (Node); XML_Node : constant DOM.Core.Node := Get_Named_Item (List_Attr, "id"); begin return Node_Value (XML_Node); end Id; -- XML Pretty Printing utility inspired from DOM.Core.Nodes.Print ------------------ -- Print_String -- ------------------ procedure Print_String (Str : DOM_String) is J : Natural := Str'First; C : Unicode.Unicode_Char; Buffer : Byte_Sequence (1 .. 20); Index : Natural; begin while J <= Str'Last loop Encoding.Read (Str, J, C); case C is when Ampersand => Write_Str (Amp_DOM_Sequence); when Less_Than_Sign => Write_Str (Lt_DOM_Sequence); when Greater_Than_Sign => Write_Str (Gt_DOM_Sequence); when Quotation_Mark => Write_Str (Quot_DOM_Sequence); -- when Apostrophe => Write_Str ("'"); when Horizontal_Tabulation => Write_Str (Tab_Sequence); when Line_Feed => Write_Str (Lf_Sequence); when Carriage_Return => Write_Str (Cr_Sequence); when others => Index := Buffer'First - 1; Encoding.Encode (C, Buffer, Index); Write_Str (Buffer (Buffer'First .. Index)); end case; end loop; end Print_String; -- XML printing stuff ----------- -- Print -- ----------- procedure Print (Prefix : String; List : DOM.Core.Node_List; Print_Comments : Boolean := False; Print_XML_PI : Boolean := False; With_URI : Boolean := False) is begin for J in 0 .. DOM.Core.Nodes.Length (List) - 1 loop Ocarina.Dia.Printer.Misc.Print (Prefix, DOM.Core.Nodes.Item (List, J), Print_Comments, Print_XML_PI, With_URI); end loop; end Print; ----------- -- Print -- ----------- procedure Print (Prefix : String; N : DOM.Core.Node; Print_Comments : Boolean := False; Print_XML_PI : Boolean := False; With_URI : Boolean := False) is use DOM.Core.Nodes; procedure Print_Name (N : DOM.Core.Node); -- Print the name of the node. ---------------- -- Print_Name -- ---------------- procedure Print_Name (N : DOM.Core.Node) is NS : constant DOM_String := Namespace_URI (N); begin if With_URI and then NS /= "" then Print_String (NS & Colon_Sequence & Local_Name (N)); else Print_String (Node_Name (N)); end if; end Print_Name; begin if N = null then return; end if; declare Children : constant Node_List := Child_Nodes (N); begin case N.Node_Type is when Element_Node => Write_Line (""); declare AS : constant Named_Node_Map := Attributes (N); LastChild : DOM.Core.Node; begin -- ??? Should define a new constant in Sax.Encodings Write_Str (Prefix); Write_Str (Less_Than_Sequence); Print_Name (N); -- Sort the XML attributes as required for canonical XML -- Sort (N.Attributes); for J in 0 .. Length (AS) - 1 loop Write_Str (Space_Sequence); Ocarina.Dia.Printer.Misc.Print ("", Item (AS, J), Print_Comments, Print_XML_PI, With_URI); end loop; if Length (Children) /= 0 then Write_Str (Greater_Than_Sequence); Ocarina.Dia.Printer.Misc.Print (Prefix & " ", Children, Print_Comments, Print_XML_PI, With_URI); LastChild := Item (Children, Length (Children) - 1); if LastChild.Node_Type /= Text_Node then Write_Line (""); Write_Str (Prefix); end if; Write_Str (Less_Than_Sequence & Slash_Sequence); Print_Name (N); else Write_Str (Slash_Sequence); end if; Write_Str (Greater_Than_Sequence); end; when Attribute_Node => Print_Name (N); Write_Str (Equals_Sign_Sequence & Quotation_Mark_Sequence); Print_String (Node_Value (N)); Write_Str (Quotation_Mark_Sequence); when Processing_Instruction_Node => declare Target : constant DOM_String := Node_Name (N); Data : constant DOM_String := Node_Value (N); begin if Print_XML_PI or else Target /= Xml_Sequence then Write_Str (Prefix); Write_Str (Less_Than_Sequence & Question_Mark_Sequence & Target); if Data'Length = 0 then Write_Str (Space_Sequence); else declare C : Unicode_Char; Index : Natural := Data'First; begin Encoding.Read (Data, Index, C); if C /= Space then Write_Str (Space_Sequence); end if; end; end if; Write_Str (Data & Question_Mark_Sequence & Greater_Than_Sequence); end if; end; when Comment_Node => if Print_Comments then Write_Line (""); Write_Str (Prefix); Write_Line (""); end if; when Document_Node => Ocarina.Dia.Printer.Misc.Print (Prefix, Children, Print_Comments, Print_XML_PI, With_URI); when Document_Fragment_Node => Ocarina.Dia.Printer.Misc.Print (Prefix, Children, Print_Comments, Print_XML_PI, With_URI); when Document_Type_Node | Notation_Node => null; when Text_Node => Print_String (Node_Value (N)); when others => Write_Str (Node_Value (N)); end case; end; end Print; end Ocarina.Dia.Printer.Misc;