with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Exceptions; use Ada.Exceptions;
with Basic_Io; use Basic_Io;
package body HTML is
function HTML_Document
(Head_Contens : Unbounded_String := Null_Unbounded_String;
Body_Contens : Unbounded_String := Null_Unbounded_String) return Unbounded_String is
DocType : Unbounded_String :=
To_Unbounded_String
("<!DOCTYPE html PUBLIC " &
Quotation &
"-//W3C//DTD HTML 4.01//EN" &
Quotation &
' ' &
Quotation &
"http://www.w3.org/TR/html4/strict.dtd" &
Quotation &
">" &
LF);
HTML_Begin : Unbounded_String := To_Unbounded_String ("<html>" & LF & LF);
HTML_End : Unbounded_String := To_Unbounded_String ("</html>");
HTML_Head : Unbounded_String :=
To_Unbounded_String ("<head>" & LF) & Head_Contens & To_Unbounded_String (LF & "</head>" & LF & LF);
HTML_Body : Unbounded_String :=
To_Unbounded_String ("<body>" & LF & LF) & Body_Contens & LF & "</body>" & LF & LF;
begin
return DocType & HTML_Begin & HTML_Head & HTML_Body & HTML_End;
end HTML_Document;
function Table (Lines : Unbounded_String := Null_Unbounded_String) return Unbounded_String is
Table : Unbounded_String := Null_Unbounded_String;
begin
Table :=
"<table style=" &
Quotation &
"border-color:#000000; border:1px solid; padding:0px; border-collapse:collapse" &
Quotation &
">" &
LF &
Lines &
"</table>" &
LF;
return Table;
exception
when Error : others =>
Put_Line ("Error in function Table!");
Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error));
return Null_Unbounded_String;
end Table;
Head_Line_Style : constant Unbounded_String := To_Unbounded_String ("background-color:#E0FFFF; font-weight:bold;");
function Line
(Item_List : Unbounded_String;
Head_Line : Boolean := False) return Unbounded_String is
Line : Unbounded_String := Null_Unbounded_String;
begin
if Head_Line then
Line := " <tr style=" & Quotation & Head_Line_Style & Quotation & ">" & LF & Item_List & " </tr>" & LF;
else
Line :=
" <tr style=" &
Quotation &
"padding:0px; margin:0px;" &
Quotation &
">" &
LF &
Item_List &
" </tr>" &
LF;
end if;
return Line;
exception
when Error : others =>
Put_Line ("Error in function Line!");
Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error));
return Null_Unbounded_String;
end Line;
function Item
(Contens : Unbounded_String;
Mark_First_Column : Boolean := False;
Text_Align : Text_Align_Type := Center) return Unbounded_String is
Item : Unbounded_String := Null_Unbounded_String;
Text_Align_Center : String := "text-align:center; ";
Text_Align_Left : String := "text-align:left; ";
Text_Align_Right : String := "text-align:right; ";
Style : Unbounded_String := Null_Unbounded_String;
Default_Part : String := "padding:3px; border-color:#ffffff; border:1px solid; margin:0px;";
begin
case Text_Align is
when Center =>
Style := To_Unbounded_String (Text_Align_Center & Default_Part);
when Left =>
Style := To_Unbounded_String (Text_Align_Left & Default_Part);
when Right =>
Style := To_Unbounded_String (Text_Align_Right & Default_Part);
end case;
if Mark_First_Column then
Item := " <td style=" & Quotation & Style & Head_Line_Style & Quotation & ">" & Contens & "</td>" & LF;
else
Item := " <td style=" & Quotation & Style & Quotation & ">" & Contens & "</td>" & LF;
end if;
return Item;
exception
when Error : others =>
Put_Line ("Error in function Item!");
Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error));
return Null_Unbounded_String;
end Item;
function Item (Contens : String; Mark_First_Column : Boolean := False) return Unbounded_String is
Item : Unbounded_String := Null_Unbounded_String;
begin
if Mark_First_Column then
Item :=
" <td style=" &
Quotation &
"text-align:center; padding:4px border-color:#ffffff; border:1px solid; margin:0px;" &
Head_Line_Style &
Quotation &
">" &
To_Unbounded_String (Contens) &
"</td>" &
LF;
else
Item :=
" <td style=" &
Quotation &
"text-align:center; padding:4px border-color:#ffffff; border:1px solid; margin:0px;" &
Quotation &
">" &
To_Unbounded_String (Contens) &
"</td>" &
LF;
end if;
return Item;
exception
when Error : others =>
Put_Line ("Error in function Item!");
Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error));
return Null_Unbounded_String;
end Item;
function Table
(Matrix : String_Matrix_Type;
Head_Line : Boolean := False;
Mark_first_Column : Boolean := False;
Text_Align : Text_Align_Type := Center;
Display_Steps : Boolean := False) return Unbounded_String is
Table : Unbounded_String := Null_Unbounded_String;
HTML_Contens : Unbounded_String := Null_Unbounded_String;
Lines : Unbounded_String := Null_Unbounded_String;
Item_List : Unbounded_String := Null_Unbounded_String;
begin
for i in Matrix'range (1) loop
for j in Matrix'range (2) loop
if j = Matrix'first (2) then
Item_List := Item_List & HTML.Item (Matrix (i, j), Mark_First_Column => Mark_first_Column,Text_Align => Text_Align);
else
Item_List := Item_List & HTML.Item (Matrix (i, j),Text_Align => Text_Align);
end if;
if Display_Steps then
Put (Matrix (i, j) & " ");
end if;
end loop;
if Display_Steps then
New_Line;
end if;
if i = Matrix'first (1) then
Lines := Lines & HTML.Line (Item_List, Head_Line => Head_Line);
else
Lines := Lines & HTML.Line (Item_List);
end if;
Item_List := Null_Unbounded_String;
end loop;
Table := HTML.Table (Lines);
return Table;
exception
when Error : others =>
Put_Line ("Error in function Table!");
Put_Line ("Exception_Information: " & Ada.Exceptions.Exception_Information (Error));
return Null_Unbounded_String;
end Table;
end HTML;