-----------------------------------------------------------------------
--  wiki-render-html -- Wiki HTML renderer
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Characters.Conversions;
with Util.Strings;

package body Wiki.Render.Html is

   package ACC renames Ada.Characters.Conversions;

   --  ------------------------------
   --  Set the output stream.
   --  ------------------------------
   procedure Set_Output_Stream (Engine : in out Html_Renderer;
                                Stream : in Wiki.Streams.Html.Html_Output_Stream_Access) is
   begin
      Engine.Output := Stream;
   end Set_Output_Stream;

   --  ------------------------------
   --  Set the link renderer.
   --  ------------------------------
   procedure Set_Link_Renderer (Document : in out Html_Renderer;
                                Links    : in Link_Renderer_Access) is
   begin
      Document.Links := Links;
   end Set_Link_Renderer;

   --  ------------------------------
   --  Render the node instance from the document.
   --  ------------------------------
   overriding
   procedure Render (Engine : in out Html_Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Html_Tag_Type;
      use type Wiki.Nodes.Node_List_Access;
   begin
      case Node.Kind is
         when Wiki.Nodes.N_HEADER =>
            Engine.Add_Header (Header => Node.Header,
                               Level  => Node.Level);

         when Wiki.Nodes.N_LINE_BREAK =>
            Engine.Output.Start_Element ("br");
            Engine.Output.End_Element ("br");

         when Wiki.Nodes.N_HORIZONTAL_RULE =>
            Engine.Close_Paragraph;
            Engine.Add_Blockquote (0);
            Engine.Output.Start_Element ("hr");
            Engine.Output.End_Element ("hr");

         when Wiki.Nodes.N_PARAGRAPH =>
            Engine.Close_Paragraph;
            Engine.Need_Paragraph := True;

         when Wiki.Nodes.N_INDENT =>
            -- Engine.Indent_Level := Node.Level;
            null;

         when Wiki.Nodes.N_TEXT =>
            Engine.Add_Text (Text   => Node.Text,
                             Format => Node.Format);

         when Wiki.Nodes.N_QUOTE =>
            Engine.Open_Paragraph;
            Engine.Output.Write (Node.Quote);

         when Wiki.Nodes.N_LINK =>
            if Node.Image then
               Engine.Add_Link (Node.Title, Node.Link_Attr);
            else
               Engine.Render_Link (Doc, Node.Title, Node.Link_Attr);
            end if;

         when Wiki.Nodes.N_BLOCKQUOTE =>
            Engine.Add_Blockquote (Node.Level);

         when Wiki.Nodes.N_TAG_START =>
            Engine.Render_Tag (Doc, Node);

      end case;
   end Render;

   procedure Render_Tag (Engine : in out Html_Renderer;
                         Doc    : in Wiki.Nodes.Document;
                         Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Html_Tag_Type;

      Name : constant Wiki.Nodes.String_Access := Wiki.Nodes.Get_Tag_Name (Node.Tag_Start);
      Iter : Wiki.Attributes.Cursor := Wiki.Attributes.First (Node.Attributes);
   begin
      if Node.Tag_Start = Wiki.Nodes.P_TAG then
         Engine.Has_Paragraph := True;
         Engine.Need_Paragraph := False;
      end if;
      Engine.Output.Start_Element (Name.all);
      while Wiki.Attributes.Has_Element (Iter) loop
         Engine.Output.Write_Wide_Attribute (Name    => Wiki.Attributes.Get_Name (Iter),
                                             Content => Wiki.Attributes.Get_Wide_Value (Iter));
         Wiki.Attributes.Next (Iter);
      end loop;
      Engine.Render (Doc, Node.Children);
      if Node.Tag_Start = Wiki.Nodes.P_TAG then
         Engine.Has_Paragraph := False;
         Engine.Need_Paragraph := True;
      end if;
      Engine.Output.End_Element (Name.all);
   end Render_Tag;

   --  ------------------------------
   --  Add a section header in the document.
   --  ------------------------------
   procedure Add_Header (Engine : in out Html_Renderer;
                         Header : in Wiki.Strings.WString;
                         Level  : in Positive) is
   begin
      Engine.Close_Paragraph;
      Engine.Add_Blockquote (0);
      case Level is
         when 1 =>
            Engine.Output.Write_Wide_Element ("h1", Header);

         when 2 =>
            Engine.Output.Write_Wide_Element ("h2", Header);

         when 3 =>
            Engine.Output.Write_Wide_Element ("h3", Header);

         when 4 =>
            Engine.Output.Write_Wide_Element ("h4", Header);

         when 5 =>
            Engine.Output.Write_Wide_Element ("h5", Header);

         when 6 =>
            Engine.Output.Write_Wide_Element ("h6", Header);

         when others =>
            Engine.Output.Write_Wide_Element ("h3", Header);
      end case;
   end Add_Header;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Document : in out Html_Renderer;
                             Level    : in Natural) is
   begin
      if Document.Quote_Level /= Level then
         Document.Close_Paragraph;
         Document.Need_Paragraph := True;
      end if;
      while Document.Quote_Level < Level loop
         Document.Output.Start_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level + 1;
      end loop;
      while Document.Quote_Level > Level loop
         Document.Output.End_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level - 1;
      end loop;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Document : in out Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Document.Has_Paragraph then
         Document.Output.End_Element ("p");
         Document.Has_Paragraph := False;
      end if;
      if Document.Has_Item then
         Document.Output.End_Element ("li");
         Document.Has_Item := False;
      end if;
      Document.Need_Paragraph := False;
      Document.Open_Paragraph;
      while Document.Current_Level < Level loop
         if Ordered then
            Document.Output.Start_Element ("ol");
         else
            Document.Output.Start_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level + 1;
         Document.List_Styles (Document.Current_Level) := Ordered;
      end loop;
   end Add_List_Item;

   procedure Close_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Has_Paragraph then
         Document.Output.End_Element ("p");
      end if;
      if Document.Has_Item then
         Document.Output.End_Element ("li");
      end if;
      while Document.Current_Level > 0 loop
         if Document.List_Styles (Document.Current_Level) then
            Document.Output.End_Element ("ol");
         else
            Document.Output.End_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level - 1;
      end loop;
      Document.Has_Paragraph := False;
      Document.Has_Item := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Need_Paragraph then
         Document.Output.Start_Element ("p");
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
      if Document.Current_Level > 0 and not Document.Has_Item then
         Document.Output.Start_Element ("li");
         Document.Has_Item := True;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Render a link.
   --  ------------------------------
   procedure Render_Link (Engine : in out Html_Renderer;
                          Doc    : in Wiki.Nodes.Document;
                          Title  : in Wiki.Strings.WString;
                          Attr   : in Wiki.Attributes.Attribute_List_Type) is
      Exists : Boolean;
      Link   : Unbounded_Wide_Wide_String := Wiki.Attributes.Get_Unbounded_Wide_Value (Attr, "href");
      URI    : Unbounded_Wide_Wide_String;
   begin
      Engine.Open_Paragraph;
      Engine.Output.Start_Element ("a");
      if Length (Title) > 0 then
         Document.Output.Write_Wide_Attribute ("title", Title);
      end if;
      if Length (Language) > 0 then
         Document.Output.Write_Wide_Attribute ("lang", Language);
      end if;
      Engine.Links.Make_Page_Link (Link, URI, Exists);
      Engine.Output.Write_Wide_Attribute ("href", URI);
      Engine.Output.Write_Wide_Text (Name);
      Engine.Output.End_Element ("a");
   end Render_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Document    : in out Html_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);

      URI    : Unbounded_Wide_Wide_String;
      Width  : Natural;
      Height : Natural;
   begin
      Document.Open_Paragraph;
      Document.Output.Start_Element ("img");
      if Length (Alt) > 0 then
         Document.Output.Write_Wide_Attribute ("alt", Alt);
      end if;
      if Length (Description) > 0 then
         Document.Output.Write_Wide_Attribute ("longdesc", Description);
      end if;
      Document.Links.Make_Image_Link (Link, URI, Width, Height);
      Document.Output.Write_Wide_Attribute ("src", URI);
      if Width > 0 then
         Document.Output.Write_Attribute ("width", Natural'Image (Width));
      end if;
      if Height > 0 then
         Document.Output.Write_Attribute ("height", Natural'Image (Height));
      end if;
      Document.Output.End_Element ("img");
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Document : in out Html_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is
   begin
      Document.Open_Paragraph;
      Document.Output.Start_Element ("q");
      if Length (Language) > 0 then
         Document.Output.Write_Wide_Attribute ("lang", Language);
      end if;
      if Length (Link) > 0 then
         Document.Output.Write_Wide_Attribute ("cite", Link);
      end if;
      Document.Output.Write_Wide_Text (Quote);
      Document.Output.End_Element ("q");
   end Add_Quote;

   HTML_BOLD        : aliased constant String := "b";
   HTML_ITALIC      : aliased constant String := "i";
   HTML_CODE        : aliased constant String := "tt";
   HTML_SUPERSCRIPT : aliased constant String := "sup";
   HTML_SUBSCRIPT   : aliased constant String := "sub";
   HTML_STRIKEOUT   : aliased constant String := "del";
   --  HTML_UNDERLINE   : aliased constant String := "ins";
   HTML_PREFORMAT   : aliased constant String := "pre";

   type String_Array_Access is array (Documents.Format_Type) of Util.Strings.Name_Access;

   HTML_ELEMENT     : constant String_Array_Access :=
     (Documents.BOLD        => HTML_BOLD'Access,
      Documents.ITALIC      => HTML_ITALIC'Access,
      Documents.CODE        => HTML_CODE'Access,
      Documents.SUPERSCRIPT => HTML_SUPERSCRIPT'Access,
      Documents.SUBSCRIPT   => HTML_SUBSCRIPT'Access,
      Documents.STRIKEOUT   => HTML_STRIKEOUT'Access,
      Documents.PREFORMAT   => HTML_PREFORMAT'Access);

   --  ------------------------------
   --  Add a text block with the given format.
   --  ------------------------------
   procedure Add_Text (Engine   : in out Html_Renderer;
                       Text     : in Wiki.Strings.WString;
                       Format   : in Wiki.Documents.Format_Map) is
   begin
      Engine.Open_Paragraph;
      for I in Format'Range loop
         if Format (I) then
            Engine.Output.Start_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
      Engine.Output.Write_Wide_Text (Text);
      for I in reverse Format'Range loop
         if Format (I) then
            Engine.Output.End_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
   end Add_Text;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Document : in out Html_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is
   begin
      Document.Close_Paragraph;
      if Format = "html" then
         Document.Output.Write (Text);
      else
         Document.Output.Start_Element ("pre");
--         Document.Output.Write_Wide_Text (Text);
         Document.Output.End_Element ("pre");
      end if;
   end Add_Preformatted;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
   end Finish;

end Wiki.Render.Html;

-----------------------------------------------------------------------
--  wiki-render-html -- Wiki HTML renderer
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Characters.Conversions;
with Util.Strings;

package body Wiki.Render.Html is

   package ACC renames Ada.Characters.Conversions;

   --  ------------------------------
   --  Set the output stream.
   --  ------------------------------
   procedure Set_Output_Stream (Engine : in out Html_Renderer;
                                Stream : in Wiki.Streams.Html.Html_Output_Stream_Access) is
   begin
      Engine.Output := Stream;
   end Set_Output_Stream;

   --  ------------------------------
   --  Set the link renderer.
   --  ------------------------------
   procedure Set_Link_Renderer (Document : in out Html_Renderer;
                                Links    : in Link_Renderer_Access) is
   begin
      Document.Links := Links;
   end Set_Link_Renderer;

   --  ------------------------------
   --  Render the node instance from the document.
   --  ------------------------------
   overriding
   procedure Render (Engine : in out Html_Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Html_Tag_Type;
      use type Wiki.Nodes.Node_List_Access;
   begin
      case Node.Kind is
         when Wiki.Nodes.N_HEADER =>
            Engine.Render_Header (Header => Node.Header,
                                  Level  => Node.Level);

         when Wiki.Nodes.N_LINE_BREAK =>
            Engine.Output.Start_Element ("br");
            Engine.Output.End_Element ("br");

         when Wiki.Nodes.N_HORIZONTAL_RULE =>
            Engine.Close_Paragraph;
            Engine.Add_Blockquote (0);
            Engine.Output.Start_Element ("hr");
            Engine.Output.End_Element ("hr");

         when Wiki.Nodes.N_PARAGRAPH =>
            Engine.Close_Paragraph;
            Engine.Need_Paragraph := True;

         when Wiki.Nodes.N_INDENT =>
            -- Engine.Indent_Level := Node.Level;
            null;

         when Wiki.Nodes.N_TEXT =>
            Engine.Add_Text (Text   => Node.Text,
                             Format => Node.Format);

         when Wiki.Nodes.N_QUOTE =>
            Engine.Open_Paragraph;
            Engine.Output.Write (Node.Quote);

         when Wiki.Nodes.N_LINK =>
            if Node.Image then
               Engine.Add_Link (Node.Title, Node.Link_Attr);
            else
               Engine.Render_Link (Doc, Node.Title, Node.Link_Attr);
            end if;

         when Wiki.Nodes.N_BLOCKQUOTE =>
            Engine.Add_Blockquote (Node.Level);

         when Wiki.Nodes.N_TAG_START =>
            Engine.Render_Tag (Doc, Node);

      end case;
   end Render;

   procedure Render_Tag (Engine : in out Html_Renderer;
                         Doc    : in Wiki.Nodes.Document;
                         Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Html_Tag_Type;

      Name : constant Wiki.Nodes.String_Access := Wiki.Nodes.Get_Tag_Name (Node.Tag_Start);
      Iter : Wiki.Attributes.Cursor := Wiki.Attributes.First (Node.Attributes);
   begin
      if Node.Tag_Start = Wiki.Nodes.P_TAG then
         Engine.Has_Paragraph := True;
         Engine.Need_Paragraph := False;
      end if;
      Engine.Output.Start_Element (Name.all);
      while Wiki.Attributes.Has_Element (Iter) loop
         Engine.Output.Write_Wide_Attribute (Name    => Wiki.Attributes.Get_Name (Iter),
                                             Content => Wiki.Attributes.Get_Wide_Value (Iter));
         Wiki.Attributes.Next (Iter);
      end loop;
      Engine.Render (Doc, Node.Children);
      if Node.Tag_Start = Wiki.Nodes.P_TAG then
         Engine.Has_Paragraph := False;
         Engine.Need_Paragraph := True;
      end if;
      Engine.Output.End_Element (Name.all);
   end Render_Tag;

   --  ------------------------------
   --  Render a section header in the document.
   --  ------------------------------
   procedure Render_Header (Engine : in out Html_Renderer;
                            Header : in Wiki.Strings.WString;
                            Level  : in Positive) is
   begin
      Engine.Close_Paragraph;
      Engine.Add_Blockquote (0);
      case Level is
         when 1 =>
            Engine.Output.Write_Wide_Element ("h1", Header);

         when 2 =>
            Engine.Output.Write_Wide_Element ("h2", Header);

         when 3 =>
            Engine.Output.Write_Wide_Element ("h3", Header);

         when 4 =>
            Engine.Output.Write_Wide_Element ("h4", Header);

         when 5 =>
            Engine.Output.Write_Wide_Element ("h5", Header);

         when 6 =>
            Engine.Output.Write_Wide_Element ("h6", Header);

         when others =>
            Engine.Output.Write_Wide_Element ("h3", Header);
      end case;
   end Render_Header;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Document : in out Html_Renderer;
                             Level    : in Natural) is
   begin
      if Document.Quote_Level /= Level then
         Document.Close_Paragraph;
         Document.Need_Paragraph := True;
      end if;
      while Document.Quote_Level < Level loop
         Document.Output.Start_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level + 1;
      end loop;
      while Document.Quote_Level > Level loop
         Document.Output.End_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level - 1;
      end loop;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Document : in out Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Document.Has_Paragraph then
         Document.Output.End_Element ("p");
         Document.Has_Paragraph := False;
      end if;
      if Document.Has_Item then
         Document.Output.End_Element ("li");
         Document.Has_Item := False;
      end if;
      Document.Need_Paragraph := False;
      Document.Open_Paragraph;
      while Document.Current_Level < Level loop
         if Ordered then
            Document.Output.Start_Element ("ol");
         else
            Document.Output.Start_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level + 1;
         Document.List_Styles (Document.Current_Level) := Ordered;
      end loop;
   end Add_List_Item;

   procedure Close_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Has_Paragraph then
         Document.Output.End_Element ("p");
      end if;
      if Document.Has_Item then
         Document.Output.End_Element ("li");
      end if;
      while Document.Current_Level > 0 loop
         if Document.List_Styles (Document.Current_Level) then
            Document.Output.End_Element ("ol");
         else
            Document.Output.End_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level - 1;
      end loop;
      Document.Has_Paragraph := False;
      Document.Has_Item := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Need_Paragraph then
         Document.Output.Start_Element ("p");
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
      if Document.Current_Level > 0 and not Document.Has_Item then
         Document.Output.Start_Element ("li");
         Document.Has_Item := True;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Render a link.
   --  ------------------------------
   procedure Render_Link (Engine : in out Html_Renderer;
                          Doc    : in Wiki.Nodes.Document;
                          Title  : in Wiki.Strings.WString;
                          Attr   : in Wiki.Attributes.Attribute_List_Type) is
      Exists : Boolean;
      Link   : Unbounded_Wide_Wide_String := Wiki.Attributes.Get_Unbounded_Wide_Value (Attr, "href");
      URI    : Unbounded_Wide_Wide_String;
   begin
      Engine.Open_Paragraph;
      Engine.Output.Start_Element ("a");
      if Length (Title) > 0 then
         Document.Output.Write_Wide_Attribute ("title", Title);
      end if;
      if Length (Language) > 0 then
         Document.Output.Write_Wide_Attribute ("lang", Language);
      end if;
      Engine.Links.Make_Page_Link (Link, URI, Exists);
      Engine.Output.Write_Wide_Attribute ("href", URI);
      Engine.Output.Write_Wide_Text (Name);
      Engine.Output.End_Element ("a");
   end Render_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Document    : in out Html_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);

      URI    : Unbounded_Wide_Wide_String;
      Width  : Natural;
      Height : Natural;
   begin
      Document.Open_Paragraph;
      Document.Output.Start_Element ("img");
      if Length (Alt) > 0 then
         Document.Output.Write_Wide_Attribute ("alt", Alt);
      end if;
      if Length (Description) > 0 then
         Document.Output.Write_Wide_Attribute ("longdesc", Description);
      end if;
      Document.Links.Make_Image_Link (Link, URI, Width, Height);
      Document.Output.Write_Wide_Attribute ("src", URI);
      if Width > 0 then
         Document.Output.Write_Attribute ("width", Natural'Image (Width));
      end if;
      if Height > 0 then
         Document.Output.Write_Attribute ("height", Natural'Image (Height));
      end if;
      Document.Output.End_Element ("img");
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Document : in out Html_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is
   begin
      Document.Open_Paragraph;
      Document.Output.Start_Element ("q");
      if Length (Language) > 0 then
         Document.Output.Write_Wide_Attribute ("lang", Language);
      end if;
      if Length (Link) > 0 then
         Document.Output.Write_Wide_Attribute ("cite", Link);
      end if;
      Document.Output.Write_Wide_Text (Quote);
      Document.Output.End_Element ("q");
   end Add_Quote;

   HTML_BOLD        : aliased constant String := "b";
   HTML_ITALIC      : aliased constant String := "i";
   HTML_CODE        : aliased constant String := "tt";
   HTML_SUPERSCRIPT : aliased constant String := "sup";
   HTML_SUBSCRIPT   : aliased constant String := "sub";
   HTML_STRIKEOUT   : aliased constant String := "del";
   --  HTML_UNDERLINE   : aliased constant String := "ins";
   HTML_PREFORMAT   : aliased constant String := "pre";

   type String_Array_Access is array (Documents.Format_Type) of Util.Strings.Name_Access;

   HTML_ELEMENT     : constant String_Array_Access :=
     (Documents.BOLD        => HTML_BOLD'Access,
      Documents.ITALIC      => HTML_ITALIC'Access,
      Documents.CODE        => HTML_CODE'Access,
      Documents.SUPERSCRIPT => HTML_SUPERSCRIPT'Access,
      Documents.SUBSCRIPT   => HTML_SUBSCRIPT'Access,
      Documents.STRIKEOUT   => HTML_STRIKEOUT'Access,
      Documents.PREFORMAT   => HTML_PREFORMAT'Access);

   --  ------------------------------
   --  Add a text block with the given format.
   --  ------------------------------
   procedure Add_Text (Engine   : in out Html_Renderer;
                       Text     : in Wiki.Strings.WString;
                       Format   : in Wiki.Documents.Format_Map) is
   begin
      Engine.Open_Paragraph;
      for I in Format'Range loop
         if Format (I) then
            Engine.Output.Start_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
      Engine.Output.Write_Wide_Text (Text);
      for I in reverse Format'Range loop
         if Format (I) then
            Engine.Output.End_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
   end Add_Text;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Document : in out Html_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is
   begin
      Document.Close_Paragraph;
      if Format = "html" then
         Document.Output.Write (Text);
      else
         Document.Output.Start_Element ("pre");
--         Document.Output.Write_Wide_Text (Text);
         Document.Output.End_Element ("pre");
      end if;
   end Add_Preformatted;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
   end Finish;

end Wiki.Render.Html;

Rename Add_Header into Render_Header

Rename Add_Header into Render_Header


-----------------------------------------------------------------------
--  gen-commands-templates -- Template based command
--  Copyright (C) 2011, 2013, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Containers.Vectors;
with Util.Strings.Sets;
with Util.Strings.Vectors;
package Gen.Commands.Templates is

   --  ------------------------------
   --  Template Generic Command
   --  ------------------------------
   --  This command adds a XHTML page to the web application.
   type Command is new Gen.Commands.Command with private;
   type Command_Access is access all Command'Class;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler);

   --  Write the help associated with the command.
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler);

   --  Read the template commands defined in dynamo configuration directory.
   procedure Read_Commands (Generator : in out Gen.Generator.Handler);

private

   type Param is record
      Name        : Ada.Strings.Unbounded.Unbounded_String;
      Argument    : Ada.Strings.Unbounded.Unbounded_String;
      Value       : Ada.Strings.Unbounded.Unbounded_String;
      Is_Optional : Boolean := False;
   end record;

   package Param_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Param);

   type Patch is record
      Template  : Ada.Strings.Unbounded.Unbounded_String;
      After     : Util.Strings.Vectors.Vector;
      Missing   : Util.Strings.Vectors.Vector;
      Before    : Ada.Strings.Unbounded.Unbounded_String;
      Optional  : Boolean := False;
   end record;

   package Patch_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Patch);

   type Command is new Gen.Commands.Command with record
      Name      : Ada.Strings.Unbounded.Unbounded_String;
      Title     : Ada.Strings.Unbounded.Unbounded_String;
      Usage     : Ada.Strings.Unbounded.Unbounded_String;
      Help_Msg  : Ada.Strings.Unbounded.Unbounded_String;
      Base_Dir  : Ada.Strings.Unbounded.Unbounded_String;
      Templates : Util.Strings.Sets.Set;
      Patches   : Patch_Vectors.Vector;
      Params    : Param_Vectors.Vector;
   end record;

end Gen.Commands.Templates;

-----------------------------------------------------------------------
--  gen-commands-templates -- Template based command
--  Copyright (C) 2011, 2013, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Containers.Vectors;
with Util.Strings.Sets;
with Util.Strings.Vectors;
package Gen.Commands.Templates is

   --  ------------------------------
   --  Template Generic Command
   --  ------------------------------
   --  This command adds a XHTML page to the web application.
   type Command is new Gen.Commands.Command with private;
   type Command_Access is access all Command'Class;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler);

   --  Write the help associated with the command.
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler);

   --  Read the template commands defined in dynamo configuration directory.
   procedure Read_Commands (Generator : in out Gen.Generator.Handler);

private

   type Param is record
      Name        : Ada.Strings.Unbounded.Unbounded_String;
      Argument    : Ada.Strings.Unbounded.Unbounded_String;
      Value       : Ada.Strings.Unbounded.Unbounded_String;
      Is_Optional : Boolean := False;
   end record;

   package Param_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Param);

   type Patch is record
      Template  : Ada.Strings.Unbounded.Unbounded_String;
      After     : Util.Strings.Vectors.Vector;
      Missing   : Util.Strings.Vectors.Vector;
      Before    : Ada.Strings.Unbounded.Unbounded_String;
      Title     : Ada.Strings.Unbounded.Unbounded_String;
      Optional  : Boolean := False;
   end record;

   package Patch_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Patch);

   type Command is new Gen.Commands.Command with record
      Name      : Ada.Strings.Unbounded.Unbounded_String;
      Title     : Ada.Strings.Unbounded.Unbounded_String;
      Usage     : Ada.Strings.Unbounded.Unbounded_String;
      Help_Msg  : Ada.Strings.Unbounded.Unbounded_String;
      Base_Dir  : Ada.Strings.Unbounded.Unbounded_String;
      Templates : Util.Strings.Sets.Set;
      Patches   : Patch_Vectors.Vector;
      Params    : Param_Vectors.Vector;
   end record;

end Gen.Commands.Templates;

Add a title for each patch so that we can report some clever error/info message


-----------------------------------------------------------------------
--  awa-components-wikis -- Wiki rendering component
--  Copyright (C) 2011, 2012, 2013, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Strings;

with Ada.Characters.Conversions;
with ASF.Contexts.Writer;
with ASF.Utils;

with Wiki.Render.Html;
with Wiki.Writers;
package body AWA.Components.Wikis is

   WIKI_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   type Html_Writer_Type is limited new Wiki.Writers.Html_Writer_Type with record
      Writer : ASF.Contexts.Writer.Response_Writer_Access;
   end record;

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Wide_Wide_String);

   --  Write a single character to the string builder.
   overriding
   procedure Write (Writer : in out Html_Writer_Type;
                    Char   : in Wide_Wide_Character);

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Unbounded_Wide_Wide_String);

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   overriding
   procedure Write_Wide_Element (Writer  : in out Html_Writer_Type;
                                 Name    : in String;
                                 Content : in Unbounded_Wide_Wide_String);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String);

   --  Start an XML element with the given name.
   overriding
   procedure Start_Element (Writer : in out Html_Writer_Type;
                            Name   : in String);

   --  Closes an XML element of the given name.
   overriding
   procedure End_Element (Writer : in out Html_Writer_Type;
                          Name   : in String);

   --  Write a text escaping any character as necessary.
   overriding
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Unbounded_Wide_Wide_String);

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Wide_Wide_String) is
   begin
      Writer.Writer.Write_Wide_Text (Content);
   end Write;

   --  ------------------------------
   --  Write a single character to the string builder.
   --  ------------------------------
   overriding
   procedure Write (Writer : in out Html_Writer_Type;
                    Char   : in Wide_Wide_Character) is
   begin
      Writer.Writer.Write_Wide_Char (Char);
   end Write;

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Unbounded_Wide_Wide_String) is
   begin
      Writer.Writer.Write (Content);
   end Write;

   --  ------------------------------
   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   --  ------------------------------
   overriding
   procedure Write_Wide_Element (Writer  : in out Html_Writer_Type;
                                 Name    : in String;
                                 Content : in Unbounded_Wide_Wide_String) is
   begin
      Writer.Writer.Write_Wide_Element (Name, Content);
   end Write_Wide_Element;

   --  ------------------------------
   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   --  ------------------------------
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String) is
   begin
      Writer.Writer.Write_Wide_Attribute (Name, Content);
   end Write_Wide_Attribute;

   --  ------------------------------
   --  Start an XML element with the given name.
   --  ------------------------------
   overriding
   procedure Start_Element (Writer : in out Html_Writer_Type;
                            Name   : in String) is
   begin
      Writer.Writer.Start_Element (Name);
   end Start_Element;

   --  ------------------------------
   --  Closes an XML element of the given name.
   --  ------------------------------
   overriding
   procedure End_Element (Writer : in out Html_Writer_Type;
                          Name   : in String) is
   begin
      Writer.Writer.End_Element (Name);
   end End_Element;

   --  ------------------------------
   --  Write a text escaping any character as necessary.
   --  ------------------------------
   overriding
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Unbounded_Wide_Wide_String) is
   begin
      Writer.Writer.Write_Wide_Text (Content);
   end Write_Wide_Text;

   --  ------------------------------
   --  Get the wiki format style.  The format style is obtained from the format
   --  attribute name.
   --  ------------------------------
   function Get_Wiki_Style (UI      : in UIWiki;
                            Context : in Faces_Context'Class)
                            return Wiki.Parsers.Wiki_Syntax_Type is
      Format : constant String := UI.Get_Attribute (Name    => FORMAT_NAME,
                                                    Context => Context,
                                                    Default => "dotclear");
   begin
      if Format = "dotclear" then
         return Wiki.Parsers.SYNTAX_DOTCLEAR;
      elsif Format = "google" then
         return Wiki.Parsers.SYNTAX_GOOGLE;
      elsif Format = "phpbb" then
         return Wiki.Parsers.SYNTAX_PHPBB;
      elsif Format = "creole" then
         return Wiki.Parsers.SYNTAX_CREOLE;
      elsif Format = "mediawiki" then
         return Wiki.Parsers.SYNTAX_MEDIA_WIKI;
      else
         return Wiki.Parsers.SYNTAX_MIX;
      end if;
   end Get_Wiki_Style;

   --  ------------------------------
   --  Get the links renderer that must be used to render image and page links.
   --  ------------------------------
   function Get_Links_Renderer (UI      : in UIWiki;
                                Context : in Faces_Context'Class)
                                return Wiki.Render.Link_Renderer_Access is
      Value : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, LINKS_NAME);
      Bean  : constant access Util.Beans.Basic.Readonly_Bean'Class
           := Util.Beans.Objects.To_Bean (Value);
   begin
      if Bean = null then
         return null;
      elsif not (Bean.all in Link_Renderer_Bean'Class) then
         return null;
      else
         return Link_Renderer_Bean'Class (Bean.all)'Access;
      end if;
   end Get_Links_Renderer;

   --  ------------------------------
   --  Render the wiki text
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIWiki;
                           Context : in out Faces_Context'Class) is
      use ASF.Contexts.Writer;
      use type Wiki.Render.Link_Renderer_Access;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Html     : aliased Html_Writer_Type;
         Renderer : aliased Wiki.Render.Html.Html_Renderer;
         Format   : constant Wiki.Parsers.Wiki_Syntax_Type := UI.Get_Wiki_Style (Context);
         Value    : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, VALUE_NAME);
         Links    : Wiki.Render.Link_Renderer_Access;
      begin
         Html.Writer := Writer;
         Writer.Start_Element ("div");
         UI.Render_Attributes (Context, WIKI_ATTRIBUTE_NAMES, Writer);

         if not Util.Beans.Objects.Is_Empty (Value) then
            Links := UI.Get_Links_Renderer (Context);
            if Links /= null then
               Renderer.Set_Link_Renderer (Links);
            end if;
            Renderer.Set_Writer (Html'Unchecked_Access);
            Wiki.Parsers.Parse (Renderer'Unchecked_Access,
                                Util.Beans.Objects.To_Wide_Wide_String (Value),
                                Format);
         end if;
         Writer.End_Element ("div");
      end;
   end Encode_Begin;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Link_Renderer_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = IMAGE_PREFIX_ATTR then
         return Util.Beans.Objects.To_Object (From.Image_Prefix);
      elsif Name = PAGE_PREFIX_ATTR then
         return Util.Beans.Objects.To_Object (From.Page_Prefix);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   function Starts_With (Content : in Unbounded_Wide_Wide_String;
                         Item    : in String) return Boolean is
      use Ada.Characters.Conversions;

      Pos : Positive := 1;
   begin
      if Length (Content) < Item'Length then
         return False;
      end if;
      for I in Item'Range loop
         if Item (I) /= To_Character (Element (Content, Pos)) then
            return False;
         end if;
         Pos := Pos + 1;
      end loop;
      return True;
   end Starts_With;

   --  ------------------------------
   --  Return true if the link is an absolute link.
   --  ------------------------------
   function Is_Link_Absolute (Renderer : in Link_Renderer_Bean;
                              Link     : in Unbounded_Wide_Wide_String) return Boolean is
   begin
      return Starts_With (Link, "http://") or Starts_With (Link, "https://");
   end Is_Link_Absolute;

   procedure Make_Link (Renderer : in Link_Renderer_Bean;
                        Link     : in Unbounded_Wide_Wide_String;
                        Prefix   : in Unbounded_Wide_Wide_String;
                        URI      : out Unbounded_Wide_Wide_String) is
   begin
      if Renderer.Is_Link_Absolute (Link) then
         URI := Link;
      else
         URI := Prefix & Link;
      end if;
   end Make_Link;

   --  ------------------------------
   --  Get the image link that must be rendered from the wiki image link.
   --  ------------------------------
   overriding
   procedure Make_Image_Link (Renderer : in Link_Renderer_Bean;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is
   begin
      Renderer.Make_Link (Link, Renderer.Image_Prefix, URI);
      Width  := 0;
      Height := 0;
   end Make_Image_Link;

   --  ------------------------------
   --  Get the page link that must be rendered from the wiki page link.
   --  ------------------------------
   overriding
   procedure Make_Page_Link (Renderer : in Link_Renderer_Bean;
                             Link     : in Unbounded_Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is
   begin
      Renderer.Make_Link (Link, Renderer.Page_Prefix, URI);
      Exists := True;
   end Make_Page_Link;

begin
   ASF.Utils.Set_Text_Attributes (WIKI_ATTRIBUTE_NAMES);
end AWA.Components.Wikis;

-----------------------------------------------------------------------
--  awa-components-wikis -- Wiki rendering component
--  Copyright (C) 2011, 2012, 2013, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Strings;

with Ada.Characters.Conversions;
with ASF.Contexts.Writer;
with ASF.Utils;

with Wiki.Render.Html;
with Wiki.Writers;
package body AWA.Components.Wikis is

   WIKI_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   type Html_Writer_Type is limited new Wiki.Writers.Html_Writer_Type with record
      Writer : ASF.Contexts.Writer.Response_Writer_Access;
   end record;

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Wide_Wide_String);

   --  Write a single character to the string builder.
   overriding
   procedure Write (Writer : in out Html_Writer_Type;
                    Char   : in Wide_Wide_Character);

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Unbounded_Wide_Wide_String);

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   overriding
   procedure Write_Wide_Element (Writer  : in out Html_Writer_Type;
                                 Name    : in String;
                                 Content : in Unbounded_Wide_Wide_String);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String);

   --  Start an XML element with the given name.
   overriding
   procedure Start_Element (Writer : in out Html_Writer_Type;
                            Name   : in String);

   --  Closes an XML element of the given name.
   overriding
   procedure End_Element (Writer : in out Html_Writer_Type;
                          Name   : in String);

   --  Write a text escaping any character as necessary.
   overriding
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Unbounded_Wide_Wide_String);

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Wide_Wide_String) is
   begin
      Writer.Writer.Write_Wide_Text (Content);
   end Write;

   --  ------------------------------
   --  Write a single character to the string builder.
   --  ------------------------------
   overriding
   procedure Write (Writer : in out Html_Writer_Type;
                    Char   : in Wide_Wide_Character) is
   begin
      Writer.Writer.Write_Wide_Char (Char);
   end Write;

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Unbounded_Wide_Wide_String) is
   begin
      Writer.Writer.Write (Content);
   end Write;

   --  ------------------------------
   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   --  ------------------------------
   overriding
   procedure Write_Wide_Element (Writer  : in out Html_Writer_Type;
                                 Name    : in String;
                                 Content : in Unbounded_Wide_Wide_String) is
   begin
      Writer.Writer.Write_Wide_Element (Name, Content);
   end Write_Wide_Element;

   --  ------------------------------
   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   --  ------------------------------
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String) is
   begin
      Writer.Writer.Write_Wide_Attribute (Name, Content);
   end Write_Wide_Attribute;

   --  ------------------------------
   --  Start an XML element with the given name.
   --  ------------------------------
   overriding
   procedure Start_Element (Writer : in out Html_Writer_Type;
                            Name   : in String) is
   begin
      Writer.Writer.Start_Element (Name);
   end Start_Element;

   --  ------------------------------
   --  Closes an XML element of the given name.
   --  ------------------------------
   overriding
   procedure End_Element (Writer : in out Html_Writer_Type;
                          Name   : in String) is
   begin
      Writer.Writer.End_Element (Name);
   end End_Element;

   --  ------------------------------
   --  Write a text escaping any character as necessary.
   --  ------------------------------
   overriding
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Unbounded_Wide_Wide_String) is
   begin
      Writer.Writer.Write_Wide_Text (Content);
   end Write_Wide_Text;

   --  ------------------------------
   --  Get the wiki format style.  The format style is obtained from the format
   --  attribute name.
   --  ------------------------------
   function Get_Wiki_Style (UI      : in UIWiki;
                            Context : in Faces_Context'Class)
                            return Wiki.Parsers.Wiki_Syntax_Type is
      Format : constant String := UI.Get_Attribute (Name    => FORMAT_NAME,
                                                    Context => Context,
                                                    Default => "dotclear");
   begin
      if Format = "dotclear" then
         return Wiki.Parsers.SYNTAX_DOTCLEAR;
      elsif Format = "google" then
         return Wiki.Parsers.SYNTAX_GOOGLE;
      elsif Format = "phpbb" then
         return Wiki.Parsers.SYNTAX_PHPBB;
      elsif Format = "creole" then
         return Wiki.Parsers.SYNTAX_CREOLE;
      elsif Format = "mediawiki" then
         return Wiki.Parsers.SYNTAX_MEDIA_WIKI;
      else
         return Wiki.Parsers.SYNTAX_MIX;
      end if;
   end Get_Wiki_Style;

   --  ------------------------------
   --  Get the links renderer that must be used to render image and page links.
   --  ------------------------------
   function Get_Links_Renderer (UI      : in UIWiki;
                                Context : in Faces_Context'Class)
                                return Wiki.Render.Link_Renderer_Access is
      Value : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, LINKS_NAME);
      Bean  : constant access Util.Beans.Basic.Readonly_Bean'Class
           := Util.Beans.Objects.To_Bean (Value);
   begin
      if Bean = null then
         return null;
      elsif not (Bean.all in Link_Renderer_Bean'Class) then
         return null;
      else
         return Link_Renderer_Bean'Class (Bean.all)'Access;
      end if;
   end Get_Links_Renderer;

   --  ------------------------------
   --  Render the wiki text
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIWiki;
                           Context : in out Faces_Context'Class) is
      use ASF.Contexts.Writer;
      use type Wiki.Render.Link_Renderer_Access;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Html     : aliased Html_Writer_Type;
         Renderer : aliased Wiki.Render.Html.Html_Renderer;
         Format   : constant Wiki.Parsers.Wiki_Syntax_Type := UI.Get_Wiki_Style (Context);
         Value    : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, VALUE_NAME);
         Links    : Wiki.Render.Link_Renderer_Access;
      begin
         Html.Writer := Writer;
         Writer.Start_Element ("div");
         UI.Render_Attributes (Context, WIKI_ATTRIBUTE_NAMES, Writer);

         if not Util.Beans.Objects.Is_Empty (Value) then
            Links := UI.Get_Links_Renderer (Context);
            if Links /= null then
               Renderer.Set_Link_Renderer (Links);
            end if;
            Renderer.Set_Writer (Html'Unchecked_Access);
            Wiki.Parsers.Parse (Renderer'Unchecked_Access,
                                Util.Beans.Objects.To_Wide_Wide_String (Value),
                                Format);
         end if;
         Writer.End_Element ("div");
      end;
   end Encode_Begin;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Link_Renderer_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = IMAGE_PREFIX_ATTR then
         return Util.Beans.Objects.To_Object (From.Image_Prefix);
      elsif Name = PAGE_PREFIX_ATTR then
         return Util.Beans.Objects.To_Object (From.Page_Prefix);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Link_Renderer_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = IMAGE_PREFIX_ATTR then
         From.Image_Prefix := Util.Beans.Objects.To_Unbounded_Wide_Wide_String (Value);
      elsif Name = PAGE_PREFIX_ATTR then
         From.Page_Prefix := Util.Beans.Objects.To_Unbounded_Wide_Wide_String (Value);
      end if;
   end Set_Value;

   function Starts_With (Content : in Unbounded_Wide_Wide_String;
                         Item    : in String) return Boolean is
      use Ada.Characters.Conversions;

      Pos : Positive := 1;
   begin
      if Length (Content) < Item'Length then
         return False;
      end if;
      for I in Item'Range loop
         if Item (I) /= To_Character (Element (Content, Pos)) then
            return False;
         end if;
         Pos := Pos + 1;
      end loop;
      return True;
   end Starts_With;

   --  ------------------------------
   --  Return true if the link is an absolute link.
   --  ------------------------------
   function Is_Link_Absolute (Renderer : in Link_Renderer_Bean;
                              Link     : in Unbounded_Wide_Wide_String) return Boolean is
   begin
      return Starts_With (Link, "http://") or Starts_With (Link, "https://");
   end Is_Link_Absolute;

   procedure Make_Link (Renderer : in Link_Renderer_Bean;
                        Link     : in Unbounded_Wide_Wide_String;
                        Prefix   : in Unbounded_Wide_Wide_String;
                        URI      : out Unbounded_Wide_Wide_String) is
   begin
      if Renderer.Is_Link_Absolute (Link) then
         URI := Link;
      else
         URI := Prefix & Link;
      end if;
   end Make_Link;

   --  ------------------------------
   --  Get the image link that must be rendered from the wiki image link.
   --  ------------------------------
   overriding
   procedure Make_Image_Link (Renderer : in Link_Renderer_Bean;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is
   begin
      Renderer.Make_Link (Link, Renderer.Image_Prefix, URI);
      Width  := 0;
      Height := 0;
   end Make_Image_Link;

   --  ------------------------------
   --  Get the page link that must be rendered from the wiki page link.
   --  ------------------------------
   overriding
   procedure Make_Page_Link (Renderer : in Link_Renderer_Bean;
                             Link     : in Unbounded_Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is
   begin
      Renderer.Make_Link (Link, Renderer.Page_Prefix, URI);
      Exists := True;
   end Make_Page_Link;

begin
   ASF.Utils.Set_Text_Attributes (WIKI_ATTRIBUTE_NAMES);
end AWA.Components.Wikis;

Implement the Set_Value procedure to set the image/page prefix from the value


--  Copyright (c) 2017 onox <denkpadje@gmail.com>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with System;

with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Ada.Text_IO;
with Ada.Exceptions;

with Orka.Futures;
with Orka.Simulation_Jobs;

package body Orka.Loops is

   use Ada.Real_Time;

   Render_Job_Start, Render_Job_Finish : Jobs.Job_Ptr := Jobs.Null_Job;

   procedure Free is new Ada.Unchecked_Deallocation
     (Behaviors.Behavior_Array, Behaviors.Behavior_Array_Access);

   function "<" (Left, Right : Behaviors.Behavior_Ptr) return Boolean is
      function Convert is new Ada.Unchecked_Conversion
        (Source => System.Address, Target => Long_Integer);
   begin
      return Convert (Left.all'Address) < Convert (Right.all'Address);
   end "<";

   protected body Handler is
      procedure Stop is
      begin
         Stop_Flag := True;
      end Stop;

      procedure Set_Frame_Limit (Value : Time_Span) is
      begin
         Limit := Value;
      end Set_Frame_Limit;

      function Frame_Limit return Time_Span is
        (Limit);

      function Should_Stop return Boolean is
        (Stop_Flag);
   end Handler;

   protected body Scene is
      procedure Add (Object : Behaviors.Behavior_Ptr) is
      begin
         Behaviors_Set.Insert (Object);
         Modified_Flag := True;
      end Add;

      procedure Remove (Object : Behaviors.Behavior_Ptr) is
      begin
         Behaviors_Set.Delete (Object);
         Modified_Flag := True;
      end Remove;

      procedure Replace_Array (Target : in out Behaviors.Behavior_Array_Access) is
         Index : Positive := 1;
         Count : constant Positive := Positive (Behaviors_Set.Length);
      begin
         Free (Target);
         Target := new Behaviors.Behavior_Array'(1 .. Count => Behaviors.Null_Behavior);

         --  Copy the elements from the set to the array
         --  for faster iteration by the game loop
         for Element of Behaviors_Set loop
            Target (Index) := Element;
            Index := Index + 1;
         end loop;

         Modified_Flag := False;
      end Replace_Array;

      function Modified return Boolean is
        (Modified_Flag);

      procedure Set_Camera (Camera : Cameras.Camera_Ptr) is
      begin
         Scene_Camera := Camera;
      end Set_Camera;

      function Camera return Cameras.Camera_Ptr is
        (Scene_Camera);
   end Scene;

   package SJ renames Simulation_Jobs;

   procedure Run_Game_Loop is
      Previous_Time : Time := Clock;
      Next_Time     : Time := Previous_Time;

      Lag : Time_Span := Time_Span_Zero;

      Scene_Array : Behaviors.Behavior_Array_Access := Behaviors.Empty_Behavior_Array;
      Batch_Length : constant := 10;
   begin
      Scene.Replace_Array (Scene_Array);

      --  Based on http://gameprogrammingpatterns.com/game-loop.html
      loop
         declare
            Current_Time : constant Time := Clock;
            Elapsed : constant Time_Span := Current_Time - Previous_Time;
         begin
            Previous_Time := Current_Time;
            Lag := Lag + Elapsed;

            exit when Handler.Should_Stop;

            declare
               Iterations : constant Natural := Lag / Time_Step;
            begin
               Lag := Lag - Iterations * Time_Step;
               Scene.Camera.Update (To_Duration (Lag));

               declare
                  Fixed_Update_Job : constant Jobs.Job_Ptr
                    := Jobs.Parallelize (SJ.Create_Fixed_Update_Job
                         (Scene_Array, Time_Step, Iterations), Scene_Array'Length, Batch_Length);

                  Finished_Job : constant Jobs.Job_Ptr := SJ.Create_Finished_Job
                    (Scene_Array, Time_Step, Scene.Camera.View_Position, Batch_Length);

                  Render_Start_Job : constant Jobs.Job_Ptr
                    := new Jobs.GPU_Job'Class'(Jobs.GPU_Job'Class (Render_Job_Start.all));

                  Render_Scene_Job : constant Jobs.Job_Ptr
                    := SJ.Create_Scene_Render_Job (Render, Scene_Array, Scene.Camera);

                  Render_Finish_Job : constant Jobs.Job_Ptr
                    := new Jobs.GPU_Job'Class'(Jobs.GPU_Job'Class (Render_Job_Finish.all));

                  Handle : Futures.Pointers.Mutable_Pointer;
                  Status : Futures.Status;
               begin
                  Orka.Jobs.Chain
                    ((Render_Start_Job, Fixed_Update_Job, Finished_Job,
                      Render_Scene_Job, Render_Finish_Job));

                  Job_Manager.Queue.Enqueue (Render_Start_Job, Handle);

                  Handle.Get.Wait_Until_Done (Status);
               end;
            end;

            if Scene.Modified then
               Scene.Replace_Array (Scene_Array);
            end if;

            declare
               New_Elapsed : constant Time_Span := Clock - Current_Time;
            begin
               if New_Elapsed > Handler.Frame_Limit then
                  Next_Time := Current_Time;
               else
                  Next_Time := Next_Time + Handler.Frame_Limit;
                  delay until Next_Time;
               end if;
            end;
         end;
      end loop;

      Job_Manager.Shutdown;
   exception
      when others =>
         Job_Manager.Shutdown;
         raise;
   end Run_Game_Loop;

   procedure Stop_Loop is
   begin
      Handler.Stop;
   end Stop_Loop;

   procedure Run_Loop is
      Fence : aliased SJ.Fences.Buffer_Fence := SJ.Fences.Create_Buffer_Fence;
   begin
      Render_Job_Start  := SJ.Create_Start_Render_Job (Fence'Unchecked_Access, Window);
      Render_Job_Finish := SJ.Create_Finish_Render_Job (Fence'Unchecked_Access, Window,
        Stop_Loop'Unrestricted_Access);

      declare
         task Simulation;

         use Ada.Exceptions;

         task body Simulation is
         begin
            Run_Game_Loop;
         exception
            when Error : others =>
               Ada.Text_IO.Put_Line ("Exception game loop: " & Exception_Information (Error));
         end Simulation;
      begin
         Job_Manager.Executors.Execute_Jobs
           ("Renderer", Job_Manager.Queues.GPU, Job_Manager.Queue'Access);
      end;
   end Run_Loop;

end Orka.Loops;

--  Copyright (c) 2017 onox <denkpadje@gmail.com>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with System;

with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Ada.Text_IO;
with Ada.Exceptions;

with Orka.Futures;
with Orka.Simulation_Jobs;

package body Orka.Loops is

   use Ada.Real_Time;

   procedure Free is new Ada.Unchecked_Deallocation
     (Behaviors.Behavior_Array, Behaviors.Behavior_Array_Access);

   function "<" (Left, Right : Behaviors.Behavior_Ptr) return Boolean is
      function Convert is new Ada.Unchecked_Conversion
        (Source => System.Address, Target => Long_Integer);
   begin
      return Convert (Left.all'Address) < Convert (Right.all'Address);
   end "<";

   protected body Handler is
      procedure Stop is
      begin
         Stop_Flag := True;
      end Stop;

      procedure Set_Frame_Limit (Value : Time_Span) is
      begin
         Limit := Value;
      end Set_Frame_Limit;

      function Frame_Limit return Time_Span is
        (Limit);

      function Should_Stop return Boolean is
        (Stop_Flag);
   end Handler;

   protected body Scene is
      procedure Add (Object : Behaviors.Behavior_Ptr) is
      begin
         Behaviors_Set.Insert (Object);
         Modified_Flag := True;
      end Add;

      procedure Remove (Object : Behaviors.Behavior_Ptr) is
      begin
         Behaviors_Set.Delete (Object);
         Modified_Flag := True;
      end Remove;

      procedure Replace_Array (Target : in out Behaviors.Behavior_Array_Access) is
         Index : Positive := 1;
         Count : constant Positive := Positive (Behaviors_Set.Length);
      begin
         Free (Target);
         Target := new Behaviors.Behavior_Array'(1 .. Count => Behaviors.Null_Behavior);

         --  Copy the elements from the set to the array
         --  for faster iteration by the game loop
         for Element of Behaviors_Set loop
            Target (Index) := Element;
            Index := Index + 1;
         end loop;

         Modified_Flag := False;
      end Replace_Array;

      function Modified return Boolean is
        (Modified_Flag);

      procedure Set_Camera (Camera : Cameras.Camera_Ptr) is
      begin
         Scene_Camera := Camera;
      end Set_Camera;

      function Camera return Cameras.Camera_Ptr is
        (Scene_Camera);
   end Scene;

   package SJ renames Simulation_Jobs;

   procedure Stop_Loop is
   begin
      Handler.Stop;
   end Stop_Loop;

   procedure Run_Game_Loop (Fence : not null access SJ.Fences.Buffer_Fence) is
      Previous_Time : Time := Clock;
      Next_Time     : Time := Previous_Time;

      Lag : Time_Span := Time_Span_Zero;

      Scene_Array : Behaviors.Behavior_Array_Access := Behaviors.Empty_Behavior_Array;
      Batch_Length : constant := 10;
   begin
      Scene.Replace_Array (Scene_Array);

      --  Based on http://gameprogrammingpatterns.com/game-loop.html
      loop
         declare
            Current_Time : constant Time := Clock;
            Elapsed : constant Time_Span := Current_Time - Previous_Time;
         begin
            Previous_Time := Current_Time;
            Lag := Lag + Elapsed;

            exit when Handler.Should_Stop;

            declare
               Iterations : constant Natural := Lag / Time_Step;
            begin
               Lag := Lag - Iterations * Time_Step;
               Scene.Camera.Update (To_Duration (Lag));

               declare
                  Fixed_Update_Job : constant Jobs.Job_Ptr
                    := Jobs.Parallelize (SJ.Create_Fixed_Update_Job
                         (Scene_Array, Time_Step, Iterations), Scene_Array'Length, Batch_Length);

                  Finished_Job : constant Jobs.Job_Ptr := SJ.Create_Finished_Job
                    (Scene_Array, Time_Step, Scene.Camera.View_Position, Batch_Length);

                  Render_Scene_Job : constant Jobs.Job_Ptr
                    := SJ.Create_Scene_Render_Job (Render, Scene_Array, Scene.Camera);

                  Render_Start_Job  : constant Jobs.Job_Ptr
                    := SJ.Create_Start_Render_Job (Fence, Window);
                  Render_Finish_Job : constant Jobs.Job_Ptr
                    := SJ.Create_Finish_Render_Job (Fence, Window,
                      Stop_Loop'Unrestricted_Access);

                  Handle : Futures.Pointers.Mutable_Pointer;
                  Status : Futures.Status;
               begin
                  Orka.Jobs.Chain
                    ((Render_Start_Job, Fixed_Update_Job, Finished_Job,
                      Render_Scene_Job, Render_Finish_Job));

                  Job_Manager.Queue.Enqueue (Render_Start_Job, Handle);

                  Handle.Get.Wait_Until_Done (Status);
               end;
            end;

            if Scene.Modified then
               Scene.Replace_Array (Scene_Array);
            end if;

            declare
               New_Elapsed : constant Time_Span := Clock - Current_Time;
            begin
               if New_Elapsed > Handler.Frame_Limit then
                  Next_Time := Current_Time;
               else
                  Next_Time := Next_Time + Handler.Frame_Limit;
                  delay until Next_Time;
               end if;
            end;
         end;
      end loop;

      Job_Manager.Shutdown;
   exception
      when others =>
         Job_Manager.Shutdown;
         raise;
   end Run_Game_Loop;

   procedure Run_Loop is
      Fence : aliased SJ.Fences.Buffer_Fence := SJ.Fences.Create_Buffer_Fence;
   begin
      declare
         --  Create a separate task for the game loop. The current task
         --  will be used to dequeue and execute GPU jobs.
         task Simulation;

         use Ada.Exceptions;

         task body Simulation is
         begin
            Run_Game_Loop (Fence'Unchecked_Access);
         exception
            when Error : others =>
               Ada.Text_IO.Put_Line ("Exception game loop: " & Exception_Information (Error));
         end Simulation;
      begin
         --  Execute GPU jobs in the current task
         Job_Manager.Executors.Execute_Jobs
           ("Renderer", Job_Manager.Queues.GPU, Job_Manager.Queue'Access);
      end;
   end Run_Loop;

end Orka.Loops;

orka: Create render jobs instead of copying them

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  Atlas-server -- Application server
--  Copyright (C) 2011 XXX
--  Written by XXX (XXX)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Exceptions;
with ASF.Server.Web;
with Atlas.Applications;
procedure Atlas.Server is
   CONTEXT_PATH : constant String := "/atlas";
   App     : constant Atlas.Applications.Application_Access := new Atlas.Applications.Application;

   WS      : ASF.Server.Web.AWS_Container;
begin
   Atlas.Applications.Initialize (App);
   WS.Register_Application (CONTEXT_PATH, App.all'Access);
   WS.Start;
   delay 365.0 * 24.0 * 3600.0;
   App.Close;
exception
   when E: others =>
      Ada.Text_IO.Put_Line ("Exception in server: " &
                            Ada.Exceptions.Exception_Name (E) & ": " &
                            Ada.Exceptions.Exception_Message (E));
end Atlas.Server;

-----------------------------------------------------------------------
--  Atlas-server -- Application server
--  Copyright (C) 2011 XXX
--  Written by XXX (XXX)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Exceptions;
with ASF.Server.Web;

with Util.Log.Loggers;

with Atlas.Applications;
procedure Atlas.Server is
   CONTEXT_PATH : constant String := "/atlas";
   App     : constant Atlas.Applications.Application_Access := new Atlas.Applications.Application;

   Log     : Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Atlas.Server");
   WS      : ASF.Server.Web.AWS_Container;
begin
   Atlas.Applications.Initialize (App);
   WS.Register_Application (CONTEXT_PATH, App.all'Access);

   Log.Info ("Connect you browser to: http://localhost:8080/atlas/index.html");

   WS.Start;
   delay 365.0 * 24.0 * 3600.0;
   App.Close;
exception
   when E: others =>
      Ada.Text_IO.Put_Line ("Exception in server: " &
                            Ada.Exceptions.Exception_Name (E) & ": " &
                            Ada.Exceptions.Exception_Message (E));
end Atlas.Server;

Add a log to indicate the main URL to connect to


------------------------------------------------------------------------------
--                                                                          --
--                       Copyright (C) 2016, AdaCore                        --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with nRF51.GPIO;   use nRF51.GPIO;
with nRF51.Device; use nRF51.Device;

procedure Main is
   Conf : GPIO_Configuration;
begin
   Conf.Mode      := Mode_Out;
   Conf.Resistors := Pull_Down;

   --  Column
   P04.Configure_IO (Conf);
   P05.Configure_IO (Conf);
   P06.Configure_IO (Conf);
   P07.Configure_IO (Conf);
   P08.Configure_IO (Conf);
   P09.Configure_IO (Conf);
   P10.Configure_IO (Conf);
   P11.Configure_IO (Conf);
   P12.Configure_IO (Conf);

   --  Row
   P13.Configure_IO (Conf);
   P14.Configure_IO (Conf);
   P15.Configure_IO (Conf);

   --  Column sink current
   P04.Clear;
   P05.Clear;
   P06.Clear;
   P07.Clear;
   P08.Clear;
   P09.Clear;
   P10.Clear;
   P11.Clear;
   P12.Clear;

   --  Blinky!!!

   loop
      --  Row source current
      P13.Set;
      P14.Set;
      P15.Set;
      for Cnt in 1 .. 100_000 loop
         null;
      end loop;
      P13.Clear;
      P14.Clear;
      P15.Clear;
      for Cnt in 1 .. 100_000 loop
         null;
      end loop;
   end loop;
end Main;

------------------------------------------------------------------------------
--                                                                          --
--                       Copyright (C) 2016, AdaCore                        --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with MicroBit.Display; use MicroBit.Display;

procedure Main is
begin
   Initialize;

   loop
      for X in Coord loop
         for Y in Coord loop
            Set (X, Y);
            for Cnt in 0 .. 100_000 loop
               null;
            end loop;
            Clear (X, Y);
         end loop;
      end loop;
   end loop;
end Main;

Update example with Display driver

MicroBit: Update example with Display driver


-----------------------------------------------------------------------
--  gen-artifacts-xmi -- UML-XMI artifact for Code Generator
--  Copyright (C) 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with DOM.Core;
with Gen.Model.Packages;
with Gen.Model.XMI;

--  The Gen.Artifacts.XMI package is an artifact for the generation of Ada code
--  from an UML XMI description.
package Gen.Artifacts.XMI is

   --  ------------------------------
   --  UML XMI artifact
   --  ------------------------------
   type Artifact is new Gen.Artifacts.Artifact with private;

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   overriding
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class);

   --  Read the UML/XMI model file.
   procedure Read_Model (Handler : in out Artifact;
                         File    : in String;
                         Context : in out Generator'Class);

   --  Read the UML configuration files that define the pre-defined types, stereotypes
   --  and other components used by a model.  These files are XMI files as well.
   --  All the XMI files in the UML config directory are read.
   procedure Read_UML_Configuration (Handler : in out Artifact;
                                     Context : in out Generator'Class);

private

   type Artifact is new Gen.Artifacts.Artifact with record
      Nodes      : aliased Gen.Model.XMI.UML_Model;
      Has_Config : Boolean := False;

      --  Stereotype which triggers the generation of database table.
      Table_Stereotype      : Gen.Model.XMI.Stereotype_Element_Access;
      PK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      FK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      Data_Model_Stereotype : Gen.Model.XMI.Stereotype_Element_Access;

      --  Tag definitions which control the generation.
      Has_List_Tag          : Gen.Model.XMI.Tag_Definition_Element_Access;

      --  Stereotype which triggers the generation of AWA bean types.
      Bean_Stereotype  : Gen.Model.XMI.Stereotype_Element_Access;
   end record;

end Gen.Artifacts.XMI;

-----------------------------------------------------------------------
--  gen-artifacts-xmi -- UML-XMI artifact for Code Generator
--  Copyright (C) 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with DOM.Core;
with Gen.Model.Packages;
with Gen.Model.XMI;

--  The Gen.Artifacts.XMI package is an artifact for the generation of Ada code
--  from an UML XMI description.
package Gen.Artifacts.XMI is

   --  ------------------------------
   --  UML XMI artifact
   --  ------------------------------
   type Artifact is new Gen.Artifacts.Artifact with private;

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   overriding
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class);

   --  Read the UML/XMI model file.
   procedure Read_Model (Handler : in out Artifact;
                         File    : in String;
                         Context : in out Generator'Class);

   --  Read the UML configuration files that define the pre-defined types, stereotypes
   --  and other components used by a model.  These files are XMI files as well.
   --  All the XMI files in the UML config directory are read.
   procedure Read_UML_Configuration (Handler : in out Artifact;
                                     Context : in out Generator'Class);

private

   type Artifact is new Gen.Artifacts.Artifact with record
      Nodes      : aliased Gen.Model.XMI.UML_Model;
      Has_Config : Boolean := False;

      --  Stereotype which triggers the generation of database table.
      Table_Stereotype      : Gen.Model.XMI.Stereotype_Element_Access;
      PK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      FK_Stereotype         : Gen.Model.XMI.Stereotype_Element_Access;
      Data_Model_Stereotype : Gen.Model.XMI.Stereotype_Element_Access;

      --  Tag definitions which control the generation.
      Has_List_Tag          : Gen.Model.XMI.Tag_Definition_Element_Access;
      Table_Name_Tag        : Gen.Model.XMI.Tag_Definition_Element_Access;

      --  Stereotype which triggers the generation of AWA bean types.
      Bean_Stereotype  : Gen.Model.XMI.Stereotype_Element_Access;
   end record;

end Gen.Artifacts.XMI;

Add the table name tag definition

Add the table name tag definition