-- Skywalker is another attempt of A. i. written with Ada. -- Skywalker is Copyright (C) 2024 Manuel De Girardi ;  -- -- This program 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 2 of the License, or -- (at your option) any later version. -- -- This program 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 this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA -- -- Date := "2024-11-12 09:45:23" -- Version := "0.0.8r" -- Code page of this file : Windows west Europe -- Tabulation : 3 -- Contact : les-ziboux@rasama.org with Ada.Wide_Text_Io; package body Sky.Ansi.Windows is package W_Io renames Ada.Wide_Text_Io; function Real_Length (Line : in Wide_String) return Natural is Count : Natural := 0; In_Escape : Boolean := False; Terminated : Boolean := False; begin for I in Line'Range loop declare Char : constant Wide_Character := Line(I); begin if In_Escape then case Char is when 'm' => In_Escape := false; when others => null; end case; else case Char is when Wide_Character'Val(27) => In_Escape := True; when Wide_Character'Val(9) => Count := Count + 4; when others => Count := Count + 1; end case; end if; end; end loop; return Count; end Real_Length; procedure Clear_Screen is begin --Ansi_Console.Clear_Screen;  null; end Clear_Screen; procedure Initialize is begin -- Initialisation Set_Screen_Mode (Color_Text_Mode_80x25); Disable_Line_Wrapping; -- Pour éviter les mauvaises surprises d'affichage. Set_Background_Color (Black); -- La couleur la plus supportable pour un fond. Set_Text_Attributes (Default_Text_Attributes); --(Bold_Text); -- Texte en couleur claire. Clear_Screen; -- Évidement... end Initialize; procedure Leave_And_Restore_Defaults is begin -- Avant de quitter, on restitue l'environnement Enable_Line_Wrapping; -- En condition normal, toujours Set_Background_Color (Black); -- Couleur normal la plus courante Set_Text_Color (White); -- Couleur normal la plus courante Set_Text_Attributes (Default_Text_Attributes); Clear_Screen; -- Si on effaçais pas, le reste d'écran défilerait : pas joli. -- On ne peut pas restaurer le mode d'écran, car on n'a aucun moyen de -- connaître le mode graphique qui était actif au démarrage. end Leave_And_Restore_Defaults; -- Dessine un fond d'espace de travail. Le rectangle défini par -- les coordonnées et les dimensions, est rempli avec un caractère -- spécial.  procedure Draw_Desktop_Background ( L : in Line_Type; C : in Column_Type; H : in Height_Type; W : in Width_Type; Color : in Color_Type) is begin if not Fit_In_Screen (L, C, H, W) then raise Metric_Error; end if; for j in 1..W loop Draw_Buffer ((C - 1) + j) := Wide_Character'Val(32); -- Old : 176. end loop; Set_Text_Color (Color); for i in 1..H loop Move_Cursor_To ((L - 1) + i, C); W_io.Put (Draw_Buffer (C..(C- 1) + W)); end loop; end Draw_Desktop_Background; -- Dessine un fenêtre, c'est-à-dire un cadre, un fond rempli d'espace, -- et un bouton « ferme » en haut à droite du cadre. procedure Draw_Window (W : in Window_Type) is type Frame_Component_Enum is ( Top_Left_Corner, Top_Right_Corner, Bottom_Right_Corner, Bottom_Left_Corner, Horizontal_Border, Vertical_Border ); Frame_Component : constant array (Frame_Type_Enum, Frame_Component_Enum) of Wide_Character := ( Double_Line_Frame => ( Top_Left_Corner => Wide_Character'Val(43), Top_Right_Corner => Wide_Character'Val(43), Bottom_Right_Corner => Wide_Character'Val(43), Bottom_Left_Corner => Wide_Character'Val(43), Horizontal_Border => Wide_Character'Val(45), Vertical_Border => Wide_Character'Val(124)), Single_Line_Frame => ( Top_Left_Corner => Wide_Character'Val(43), Top_Right_Corner => Wide_Character'Val(43), Bottom_Right_Corner => Wide_Character'Val(43), Bottom_Left_Corner => Wide_Character'Val(43), Horizontal_Border => Wide_Character'Val(45), Vertical_Border => Wide_Character'Val(124))); Client_Background : constant Wide_Character := Wide_Character'Val (32); Close_Box_Symbol : constant Wide_Character := 'X'; -- Pourrait être aussi Character'Val(254) begin if not Fit_In_Screen (W.L, W.C, W.H, W.W) then raise Metric_Error; end if; if W.W < 5 then raise Metric_Error; end if; if W.H < 2 then raise Metric_Error; end if; Set_Text_Color (W.Frame_Color); -- Bottom side Draw_Buffer (W.C) := Frame_Component (W.Frame_Type, Bottom_Left_Corner); for i in 2 .. W.W - 1 loop Draw_Buffer ((W.C - 1) + i) := Frame_Component (W.Frame_Type, Horizontal_Border); end loop; Draw_Buffer ((W.C - 1) + W.W) := Frame_Component (W.Frame_Type, Bottom_Right_Corner); Move_Cursor_To ((W.L - 1) + W.H, W.C); W_io.Put (Draw_Buffer (W.C..(W.C - 1) + W.W)); -- Top side Draw_Buffer (W.C) := Frame_Component (W.Frame_Type, Top_Left_Corner); Draw_Buffer ((W.C - 1) + W.W - 3) := '['; Draw_Buffer ((W.C - 1) + W.W - 2) := 'X'; Draw_Buffer ((W.C - 1) + W.W - 1) := ']'; Draw_Buffer ((W.C - 1) + W.W) := Frame_Component (W.Frame_Type, Top_Right_Corner); Move_Cursor_To (W.L, W.C); W_io.Put (Draw_Buffer (W.C..(W.C - 1) + W.W)); -- Middle Draw_Buffer (W.C) := Frame_Component (W.Frame_Type, Vertical_Border); for i in 2 .. W.W - 1 loop Draw_Buffer ((W.C - 1) + i) := Client_Background; end loop; Draw_Buffer ((W.C - 1) + W.W) := Frame_Component (W.Frame_Type, Vertical_Border); for i in 2..W.H - 1 loop Move_Cursor_To ((W.L - 1) + i, W.C); W_io.Put (Draw_Buffer (W.C..(W.C - 1) + W.W)); end loop; -- Button Set_Text_Color (W.Close_Box_Color); Move_Cursor_To (W.L, (W.C - 1) + W.W - 2); W_io.Put (Close_Box_Symbol); end; procedure Enlight_Window (W : in Window_Type) is type Frame_Component_Enum is ( Top_Left_Corner, Top_Right_Corner, Bottom_Right_Corner, Bottom_Left_Corner, Horizontal_Border, Vertical_Border ); Frame_Component : constant array (Frame_Type_Enum, Frame_Component_Enum) of Wide_Character := ( Double_Line_Frame => ( Top_Left_Corner => Wide_Character'Val(43), Top_Right_Corner => Wide_Character'Val(43), Bottom_Right_Corner => Wide_Character'Val(43), Bottom_Left_Corner => Wide_Character'Val(43), Horizontal_Border => Wide_Character'Val(45), Vertical_Border => Wide_Character'Val(124)), Single_Line_Frame => ( Top_Left_Corner => Wide_Character'Val(43), Top_Right_Corner => Wide_Character'Val(43), Bottom_Right_Corner => Wide_Character'Val(43), Bottom_Left_Corner => Wide_Character'Val(43), Horizontal_Border => Wide_Character'Val(45), Vertical_Border => Wide_Character'Val(124))); Client_Background : constant Wide_Character := Wide_Character'Val (32); Close_Box_Symbol : constant Wide_Character := 'X'; -- Pourrait être aussi Character'Val(254) begin if not Fit_In_Screen (W.L, W.C, W.H, W.W) then raise Metric_Error; end if; if W.W < 5 then raise Metric_Error; end if; if W.H < 2 then raise Metric_Error; end if; enlight_Text_Color (W.Frame_Color); -- Bottom side Draw_Buffer (W.C) := Frame_Component (W.Frame_Type, Bottom_Left_Corner); for i in 2 .. W.W - 1 loop Draw_Buffer ((W.C - 1) + i) := Frame_Component (W.Frame_Type, Horizontal_Border); end loop; Draw_Buffer ((W.C - 1) + W.W) := Frame_Component (W.Frame_Type, Bottom_Right_Corner); Move_Cursor_To ((W.L - 1) + W.H, W.C); Put (Draw_Buffer (W.C..(W.C - 1) + W.W)); -- Top side Draw_Buffer (W.C) := Frame_Component (W.Frame_Type, Top_Left_Corner); Draw_Buffer ((W.C - 1) + W.W - 3) := '['; Draw_Buffer ((W.C - 1) + W.W - 2) := 'X'; Draw_Buffer ((W.C - 1) + W.W - 1) := ']'; Draw_Buffer ((W.C - 1) + W.W) := Frame_Component (W.Frame_Type, Top_Right_Corner); Move_Cursor_To (W.L, W.C); Put (Draw_Buffer (W.C..(W.C - 1) + W.W)); -- Middle Draw_Buffer (W.C) := Frame_Component (W.Frame_Type, Vertical_Border); for i in 2 .. W.W - 1 loop Draw_Buffer ((W.C - 1) + i) := Client_Background; end loop; Draw_Buffer ((W.C - 1) + W.W) := Frame_Component (W.Frame_Type, Vertical_Border); for i in 2..W.H - 1 loop Move_Cursor_To ((W.L - 1) + i, W.C); Put (Draw_Buffer (W.C..(W.C - 1) + W.W)); end loop; -- Button Enlight_Text_Color (W.Close_Box_Color); Move_Cursor_To (W.L, (W.C - 1) + W.W - 2); Put (Close_Box_Symbol); end; -- Dessine un caractère dans la zone cliente d'une fenêtre, aux coordonnées -- spécifiées avec la couleur indiquée. procedure Draw ( W : in Window_Type; L : in Client_Line_Type; C : in Client_Column_Type; Color : in Color_Type; Ch : in Wide_Character) is begin -- ((W.L + 1) - 1) + L = W.L + L -- ((W.C + 1) - 1) + C = W.C + C if not Fit_In_Screen (W.L + L, W.C + C, 1, 1) then raise Metric_Error; end if; if not Fit_In_Client (W, L, C, 1, 1) then raise Metric_Error; end if; Set_Text_Color (Color); Move_Cursor_To (W.L + L, W.C + C); W_io.Put (Ch); end; -- Dessine du texte dans la zone cliente d'une fenêtre, aux coordonnées -- spécifiées avec la couleur indiquée. procedure Draw ( W : in Window_Type; L : in Client_Line_Type; C : in Client_Column_Type; Color : in Color_Type; Text : in Wide_String) is begin -- ((W.L + 1) - 1) + L = W.L + L -- ((W.C + 1) - 1) + C = W.C + C if not Fit_In_Screen (W.L + L, W.C + C, 1, Real_Length(Text)) then raise Metric_Error; end if; if not Fit_In_Client (W, L, C, 1, Real_Length(Text)) then raise Metric_Error; end if; Set_Text_Color (Color); Move_Cursor_To (W.L + L, W.C + C); W_io.Put (Text); end; procedure Enlight_Draw ( W : in Window_Type; L : in Client_Line_Type; C : in Client_Column_Type; Color : in Color_Type; Text : in Wide_String) is begin -- ((W.L + 1) - 1) + L = W.L + L -- ((W.C + 1) - 1) + C = W.C + C if not Fit_In_Screen (W.L + L, W.C + C, 1, Real_Length(Text)) then raise Metric_Error; end if; if not Fit_In_Client (W, L, C, 1, Real_Length(Text)) then raise Metric_Error; end if; Enlight_Text_Color (Color); Move_Cursor_To (W.L + L, W.C + C); W_io.Put (Text); end; -- Dessine du texte centré. Comme c'est le centrage qui donne la coordonnée -- horizontal, on ne spécifie bien sûre que la coordonnée vertical. procedure Draw_Centered ( W : in Window_Type; L : in Client_Line_Type; Color : in Color_Type; Text : in Wide_String) is C2 : Natural; begin -- (W.L + 1) - 1 = W.L if not Fit_In_Screen (W.L + L, W.C + 1, 1, Real_Length(Text)) then raise Metric_Error; end if; if not Fit_In_Client (W, L, 1, 1, Real_Length(Text)) then raise Metric_Error; end if; if W.W - 2 < Real_Length(Text) then raise Metric_Error; end if; -- (W.C - 1) + 1 = W.C C2 := W.C + (W.W - 2 - Real_Length(Text)) / 2; Set_Text_Color (Color); Move_Cursor_To (W.L + L, C2); W_io.Put (Text); end; procedure Move_Cursor_To ( W : in Window_Type; L : in Client_Line_Type; C : in Client_Column_Type) is begin if L < 1 then raise Metric_Error; end if; if L > W.H - 2 then raise Metric_Error; end if; if C < 1 then raise Metric_Error; end if; if C > W.W - 2 then raise Metric_Error; end if; Move_Cursor_To (W.L + L, W.C + C); end; function Is_Printable (C : in Wide_Character) return Boolean is begin if Wide_Character'Pos (C) in 0..31 then return False; else return True; end if; end; -- Test si le rectangle défini par (L, C)-(H, W) passe dans l'écran. function Fit_In_Screen ( L : in Line_Type; C : in Column_Type; H : in Height_Type; W : in Width_Type) return Boolean is begin if C < 1 then return False; end if; if (C - 1) + W > Term_Columns_Max then return False; end if; if L < 1 then return False; end if; if (L - 1) + H > Term_Lines_Max then return False; end if; return True; end; -- Test si le rectangle défini par (L, C)-(H, W) passe dans la fenêtre. function Fit_In_Window ( Window : in Window_Type; L : in Line_Type; C : in Column_Type; H : in Height_Type; W : in Width_Type) return Boolean is begin if C < 1 then return False; end if; if (C - 1) + W > Window.W then return False; end if; if L < 1 then return False; end if; if (L - 1) + H > Window.H then return False; end if; return True; end; -- Test si le rectangle défini par (L, C)-(H, W) passe dans la zone -- cliente de la fenêtre. Notez que l'argument est bien une fenêtre, et non -- un type Client_Type. function Fit_In_Client ( Window : in Window_Type; L : in Line_Type; C : in Column_Type; H : in Height_Type; W : in Width_Type) return Boolean is begin if C < 1 then return False; end if; if (C - 1) + W > Window.W - 2 then return False; end if; if L < 1 then return False; end if; if (L - 1) + H > Window.H - 2 then return False; end if; return True; end; end Sky.Ansi.Windows ;