-- -- Author: Brent Seidel -- Date: 6-Aug-2024 -- -- This file is part of Simple Ada Web Server. -- Simple Ada Web Server is free software: you can redistribute it and/or -- modify it under the terms of the GNU General Public License as published -- by the Free Software Foundation, either version 3 of the License, or (at -- your option) any later version. -- -- Simple Ada Web Server is distributed in the hope that it will be useful, but -- WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for -- more details. -- -- You should have received a copy of the GNU General Public License along -- with Simple Ada Web Server. If not, see .-- -- with Ada.Strings.Fixed; with BBS.web.http; package body BBS.web.svg is -- -- Display a thermometer SVG showing the value parameter. This procedire -- does the extraction and checking of parameters and then calls another -- procedure to do the actual display. -- procedure thermometer(s : GNAT.Sockets.Stream_Access; h : params.Map; p : params.Map) is value : Integer; max : Integer := 250; min : Integer := 0; error : Boolean := false; begin if params.Contains(p, "min") then begin min := Integer'Value(params.Element(p, "min")); exception when others => error := True; end; end if; if params.Contains(p, "max") then begin max := Integer'Value(params.Element(p, "max")); exception when others => error := True; end; end if; if params.Contains(p, "value") then begin value := Integer'Value(params.Element(p, "value")); exception when others => error := True; end; if value < min then value := min; elsif value > max then value := max; end if; end if; if min >= max then error := True; end if; if error then red_x(s, 100, 350); else svg.thermometer(s, Float(min), Float(max), Float(value)); end if; end thermometer; -- -- Display a thermometer type graphic. The value is clipped to be between -- the min and max. The range between min and max is divided into 10 -- labeled ranges. There is no fancy fiddling to adjust the min and max to -- make nice ranges display. That is the job of the calling software. -- -- This could be combined with the procedure above. -- procedure thermometer(s : GNAT.Sockets.Stream_Access; min : Float; max : Float; value : Float) is start : Integer; scale : constant Float := 250.0 / (max - min); height : constant Integer := Integer((value - min)*scale); begin svg_header(s, 100, 350); -- -- Black outline -- String'Write(s, "" & CRLF); String'Write(s, "" & CRLF); String'Write(s, "" & CRLF); -- -- Labels -- for i in Integer range 0 .. 10 loop String'Write(s, "" & CRLF); String'Write(s, "" & Integer'Image(Integer(min + Float(i)*(max-min)/10.0)) & "" & CRLF); end loop; -- -- White fill -- String'Write(s, "" & CRLF); String'Write(s, "" & CRLF); -- -- Red mark -- String'Write(s, "" & CRLF); String'Write(s, "" & CRLF); if (height > 0) then start := 280 - height; String'Write(s, "" & CRLF); end if; -- -- Closing stuff -- String'Write(s, "" & CRLF); end thermometer; -- -- Display a round dial with a pointer to the appropriate value. The -- following parameters are supported: -- min - The minimum displayed value -- max - The maximum displayed value -- value - The value to display. -- -- The value is clamped to be between min and max. If the parameters are -- invalid, a Red-X is produced. -- procedure dial(s : GNAT.Sockets.Stream_Access; h : params.Map; p : params.Map) is value : Integer; max : Integer := 250; min : Integer := 0; angle : Integer; error : Boolean := false; begin -- -- Extract the parameters -- if params.Contains(p, "min") then begin min := Integer'Value(params.Element(p, "min")); exception when others => error := true; end; end if; if params.Contains(p, "max") then begin max := Integer'Value(params.Element(p, "max")); exception when others => error := true; end; end if; if params.Contains(p, "value") then begin value := Integer'Value(params.Element(p, "value")); exception when others => error := true; end; if value < min then value := min; elsif value > max then value := max; end if; end if; if min >= max then error := True; end if; if error then red_x(s, 300, 300); else -- -- Send headers -- svg_header(s, 300, 300); -- -- Draw the graphics -- String'Write(s, "" & CRLF); -- -- Labels -- for i in Integer range 0 .. 10 loop String'Write(s, "" & CRLF); String'Write(s, "" & CRLF); String'Write(s, "" & Integer'Image(Integer(Float(min) + Float(i)*Float(max-min)/10.0)) & "" & CRLF); String'Write(s, "" & CRLF); end loop; -- -- Draw pointer -- angle := Integer(Float(value - min)*270.0/Float(max - min) - 45.0); String'Write(s, "" & CRLF); String'Write(s, "" & CRLF); String'Write(s, "" & CRLF); String'Write(s, "" & CRLF); -- -- Closing stuff -- String'Write(s, "" & CRLF); end if; end dial; -- -- Send the standard SVG header. -- procedure svg_header(s : GNAT.Sockets.Stream_Access; width : Integer; height : Integer) is begin BBS.web.http.ok(s, "image/svg+xml"); String'Write(s, "" & CRLF); String'Write(s, "" & CRLF); end svg_header; -- -- Display a red X for replacing instruments when an error occurs. This is -- called locally from some other function that decides when the error has -- occured. -- procedure red_x(s : GNAT.Sockets.Stream_Access; width : Integer; height : Integer) is begin svg_header(s, width, height); -- -- Draw the X -- String'Write(s, "" & CRLF); -- -- Closing stuff -- String'Write(s, "" & CRLF); end red_x; end BBS.web.svg;