From 3d0c8035d7ce0cab65678645e6094ccbf2c06a92 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Antonio=20Verde=20Jim=C3=A9nez?= Date: Fri, 6 Nov 2020 20:47:38 +0100 Subject: [PATCH] Added styles! --- CHANGELOG.md | 6 + adatyper.gpr | 12 +- debug/INTERFACE | 12 +- debug/PROJECT.md | 85 +++++++++++ src/ansi-colors.adb | 112 ++++++++++++-- src/ansi-colors.ads | 30 ++-- src/ansi-cursors.adb | 18 ++- src/ansi-cursors.ads | 15 +- src/ansi-exceptions.ads | 1 + src/ansi-styles.adb | 277 +++++++++++++++++++++++++++++++--- src/ansi-styles.ads | 109 +++++++++++-- src/ansi-surfaces.adb | 17 ++- src/ansi-surfaces.ads | 6 +- src/ansi.adb | 3 + src/ansi.ads | 14 +- src/main.adb | 5 +- src/title.adb | 166 ++++++++++++++++++++ src/{todo => }/title.ads | 29 +++- tests/logs/speed.analyzed.log | 12 ++ tests/logs/speed.log | 4 +- tests/src/styles.adb | 20 +++ tests/tests.gpr | 2 +- 22 files changed, 861 insertions(+), 94 deletions(-) create mode 100644 debug/PROJECT.md create mode 100644 src/title.adb rename src/{todo => }/title.ads (71%) create mode 100644 tests/logs/speed.analyzed.log create mode 100644 tests/src/styles.adb diff --git a/CHANGELOG.md b/CHANGELOG.md index 9901fa9..55711c6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,3 +18,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Fixed major bugs +## [0.0.1] - 2020-11-06 +### Added +- Finished Styles and Colours +- Added some tests +- Fixed some major bugs + diff --git a/adatyper.gpr b/adatyper.gpr index e0a15cc..7ce5a81 100644 --- a/adatyper.gpr +++ b/adatyper.gpr @@ -42,7 +42,7 @@ project AdaTyper is package Compiler is for Switches ("Ada") use ("-g", -- Use debug symbols "-O0", -- No optimizations - "-gnatd_F", -- Detailed invocation information + -- "-gnatd_F", -- Detailed invocation information "-fdata-sections", "-ffunction-sections", --"-gnatE", -- Dynamic elaboration @@ -54,13 +54,13 @@ project AdaTyper is end Compiler; package Linker is - for Switches ("Ada") use ("-Wl,--gc-sections", -- Remove unused sections - "-flto"); + for Switches ("Ada") use ("-Wl,--gc-sections"); -- Remove unused sections + -- "-flto"); end Linker; - package Binder is - for Switches ("Ada") use ("-d_C"); -- Diagnose all circularities - end Binder; + --package Binder is + -- for Switches ("Ada") use ("-d_C"); -- Diagnose all circularities + --end Binder; end AdaTyper; diff --git a/debug/INTERFACE b/debug/INTERFACE index 6d4863a..3efe868 100644 --- a/debug/INTERFACE +++ b/debug/INTERFACE @@ -12,12 +12,12 @@ This is the interface of the program. _Main menu - _ _ ______ ####### - / | / | |_. __| _ _ ___ ____ ___ ####### - / | _) | ___ | | | \_/ | / \ / __ \ /\/ __) ####### - / # | / | / \ | | \ / | ___) | ___/ | / ####### - / /| | ( (_) | ( (_) ) | | _\ / | ( | (___ | | ####### - /_/ |_| \___/ \_____\ |_| |____/ |_| \____/ |_| ####### + _ _ _____ ####### + / | / | (_ _) _ _ ___ ____ ___ ####### + / | _) | ___ | | ( \_/ ) / \ / __ \ /\/ __) ####### + / - | / | / \ | | \ / | (_) ) / ___/ | / ####### + / /| | ( (_) | ( (_) ) | | _) / | __/ \ (___ | | ####### + /_/ |_| \___/ \_____\ |_| (__/ |_( \____) |_| ####### diff --git a/debug/PROJECT.md b/debug/PROJECT.md new file mode 100644 index 0000000..5ff6d43 --- /dev/null +++ b/debug/PROJECT.md @@ -0,0 +1,85 @@ +# PROJECT +This is a kind of file with everything I want to do in each version. + +## 0.0.P +The Ansi Escape Sequences library. + + * Surfaces + * Layers + * Colours + * Styles + * Text_IO + * And so on... + +## 0.1.P +More for the Ansi Escape Sequences library + + * Menus + * Buttons + * Scrolling + * Loading screens + * Letters library + * And so on... + +## 0.2.P +The language support and encoding problems and configuration files. + + * Language packs + * Change them in runtime + * Configuration files. + * And so on... + +## 0.3.P +Credits, CLI and simple functional interface. + +## 0.4.P +A way to access the keyboard layout of the user. + + * Keyboard + * Layouts + * And so on... + + +## 0.5.P +Windows support and improve the gpr file with more options. + + +## 0.6.P +The first learn to type program. + +### 0.5.N (RELEASE) + + +## 0.7.P +Leaderboards. + +## 0.8.P +Wrap everything up with the user interface. + + +## 0.9.P +Text challenges + + +## 0.A.P +Space invaders game. + + +## 0.B.P +Clear all bugs and prepare for Alire. + + +## 0.C.P +More games + + +## 0.D.P +Pluggin creator (Maybe with Lua or Ada) + + +## 0.E.P +Cross-platform support (Android's termux, Windows, ReactOS, Linux, BSD, Unix...) + + +## 0.F.P +Fix all bugs for first release. diff --git a/src/ansi-colors.adb b/src/ansi-colors.adb index 3bb1453..1e1f9e7 100644 --- a/src/ansi-colors.adb +++ b/src/ansi-colors.adb @@ -26,6 +26,8 @@ -- -- ------------------------------------------------------------------------------- +with Ansi.Cursors; +with Ansi.Exceptions; with Ansi.Text_IO; @@ -38,7 +40,7 @@ package body Ansi.Colors is -- SURFACE OPERATIONS -- ------------------------ - procedure Get_Foreground (Surface: in Surface_Type; + procedure Get_Foreground (Surface: in not null Surface_Type; Color : out Color_Type; Bright : out Boolean; Row : Row_Type; @@ -48,10 +50,15 @@ package body Ansi.Colors is Color := Surface.Grid(Row, Col).Fmt.Fg_Color; Bright := Surface.Grid(Row, Col).Fmt.Fg_Bright; + exception + when Constraint_Error => + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Index out of range!"; + end Get_Foreground; - procedure Get_Background (Surface: in Surface_Type; + procedure Get_Background (Surface: in not null Surface_Type; Color : out Color_Type; Bright : out Boolean; Row : Row_Type; @@ -61,6 +68,11 @@ package body Ansi.Colors is Color := Surface.Grid(Row, Col).Fmt.Bg_Color; Bright := Surface.Grid(Row, Col).Fmt.Bg_Bright; + exception + when Constraint_Error => + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Index out of range!"; + end Get_Background; @@ -96,34 +108,58 @@ package body Ansi.Colors is - procedure Set_Foreground (Surface: out Surface_Type; + procedure Set_Foreground (Surface: out not null Surface_Type; Color : Color_Type; Bright : Boolean; Row : Row_Type; Col : Col_Type) is begin - - Surface.Grid(Row, Col).Fmt.Fg_Color := Color; - Surface.Grid(Row, Col).Fmt.Fg_Bright := Bright; + + -- We check whether we are overwriting the colour. + if Surface.Grid(Row, Col).Fmt.Fg_Color /= Color or + Surface.Grid(Row, Col).Fmt.Fg_Bright /= Bright + then + -- If so we change it and push it to the tail. + Surface.Grid(Row, Col).Fmt.Fg_Color := Color; + Surface.Grid(Row, Col).Fmt.Fg_Bright := Bright; + Surface.Push(Ansi.Cursors.New_Cursor(Row, Col)); + end if; + + exception + when Constraint_Error => + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Index out of range!"; end Set_Foreground; - procedure Set_Background (Surface: out Surface_Type; + procedure Set_Background (Surface: out not null Surface_Type; Color : Color_Type; Bright : Boolean; Row : Row_Type; Col : Col_Type) is begin - - Surface.Grid(Row, Col).Fmt.Bg_Color := Color; - Surface.Grid(Row, Col).Fmt.Bg_Bright := Bright; + + -- We check if we are overwriting the colour. + if Surface.Grid(Row, Col).Fmt.Bg_Color /= Color or + Surface.Grid(Row, Col).Fmt.Bg_Bright /= Bright + then + -- If so we change it and push it to the tail. + Surface.Grid(Row, Col).Fmt.Bg_Color := Color; + Surface.Grid(Row, Col).Fmt.Bg_Bright := Bright; + Surface.Push(Ansi.Cursors.New_Cursor(Row, Col)); + end if; + + exception + when Constraint_Error => + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Index out of range!"; end Set_Background; - procedure Set_Foreground (Surface : out Surface_Type; + procedure Set_Foreground (Surface : out not null Surface_Type; Color : Color_Type; Bright : Boolean; From_Row: Row_Type; @@ -132,6 +168,11 @@ package body Ansi.Colors is To_Col : Col_Type) is begin + if To_Row > Surface.Height or To_Col > Surface.Width then + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Range out of bounds!"; + end if; + for Row in Row_Type range From_Row .. To_Row loop for Col in Col_Type range From_Col .. To_Col loop Set_Foreground(Surface => Surface, @@ -145,7 +186,7 @@ package body Ansi.Colors is end Set_Foreground; - procedure Set_Background (Surface : out Surface_Type; + procedure Set_Background (Surface : out not null Surface_Type; Color : Color_Type; Bright : Boolean; From_Row: Row_Type; @@ -154,6 +195,11 @@ package body Ansi.Colors is To_Col : Col_Type) is begin + if To_Row > Surface.Height or To_Col > Surface.Width then + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Range out of bounds!"; + end if; + for Row in Row_Type range From_Row .. To_Row loop for Col in Col_Type range From_Col .. To_Col loop Set_Background(Surface => Surface, @@ -167,13 +213,47 @@ package body Ansi.Colors is end Set_Background; + procedure Set_Foreground (Surface: out not null Surface_Type; + Color : Color_Type; + Bright : Boolean) is + begin + + for Row in Surface.Grid'Range(1) loop + for Col in Surface.Grid'Range(2) loop + Surface.Grid(Row, Col).Fmt.Fg_Color := Color; + Surface.Grid(Row, Col).Fmt.Fg_Bright := Bright; + end loop; + end loop; + + Surface.Update_All := True; + + end Set_Foreground; + + + procedure Set_Background (Surface: out not null Surface_Type; + Color : Color_Type; + Bright : Boolean) is + begin + + for Row in Surface.Grid'Range(1) loop + for Col in Surface.Grid'Range(2) loop + Surface.Grid(Row, Col).Fmt.Bg_Color := Color; + Surface.Grid(Row, Col).Fmt.Bg_Bright := Bright; + end loop; + end loop; + + Surface.Update_All := True; + + end Set_Background; + + --------------------------------- -- SURFACE'S CURSOR OPERATIONS -- --------------------------------- - procedure Get_Cursor_Foreground (Surface: in Surface_Type; + procedure Get_Cursor_Foreground (Surface: in not null Surface_Type; Color : out Color_Type; Bright : out Boolean) is begin @@ -184,7 +264,7 @@ package body Ansi.Colors is end Get_Cursor_Foreground; - procedure Get_Cursor_Background (Surface: in Surface_Type; + procedure Get_Cursor_Background (Surface: in not null Surface_Type; Color : out Color_Type; Bright : out Boolean) is begin @@ -196,7 +276,7 @@ package body Ansi.Colors is - procedure Set_Cursor_Foreground (Surface: out Surface_Type; + procedure Set_Cursor_Foreground (Surface: out not null Surface_Type; Color : Color_Type; Bright : Boolean) is begin @@ -207,7 +287,7 @@ package body Ansi.Colors is end Set_Cursor_Foreground; - procedure Set_Cursor_Background (Surface: out Surface_Type; + procedure Set_Cursor_Background (Surface: out not null Surface_Type; Color : Color_Type; Bright : Boolean) is begin diff --git a/src/ansi-colors.ads b/src/ansi-colors.ads index 6fbd3b0..ba0ac1f 100644 --- a/src/ansi-colors.ads +++ b/src/ansi-colors.ads @@ -36,7 +36,7 @@ package Ansi.Colors is -- This procedure returns the foreground colour in a certain position of the -- surface. - procedure Get_Foreground (Surface: in Surface_Type; + procedure Get_Foreground (Surface: in not null Surface_Type; Color : out Color_Type; Bright : out Boolean; Row : Row_Type; @@ -45,7 +45,7 @@ package Ansi.Colors is -- This procedure returns the background colour in a certain position of the -- surface. - procedure Get_Background (Surface: in Surface_Type; + procedure Get_Background (Surface: in not null Surface_Type; Color : out Color_Type; Bright : out Boolean; Row : Row_Type; @@ -64,14 +64,14 @@ package Ansi.Colors is pragma Inline (Put_Background); -- This procedure sets a foreground colour in a cell of the surface. - procedure Set_Foreground (Surface: out Surface_Type; + procedure Set_Foreground (Surface: out not null Surface_Type; Color : Color_Type; Bright : Boolean; Row : Row_Type; Col : Col_Type); -- This procedure sets a background colour in a cell of the surface. - procedure Set_Background (Surface: out Surface_Type; + procedure Set_Background (Surface: out not null Surface_Type; Color : Color_Type; Bright : Boolean; Row : Row_Type; @@ -79,7 +79,7 @@ package Ansi.Colors is -- This procedure sets a foreground colour in a block of cells from the -- surface. - procedure Set_Foreground (Surface : out Surface_Type; + procedure Set_Foreground (Surface : out not null Surface_Type; Color : Color_Type; Bright : Boolean; From_Row: Row_Type; @@ -89,7 +89,7 @@ package Ansi.Colors is -- This procedure sets a background colour in a block of cells from the -- surface. - procedure Set_Background (Surface : out Surface_Type; + procedure Set_Background (Surface : out not null Surface_Type; Color : Color_Type; Bright : Boolean; From_Row: Row_Type; @@ -97,31 +97,41 @@ package Ansi.Colors is To_Row : Row_Type; To_Col : Col_Type); + -- This procedure sets the foreground colour of a whole surface. + procedure Set_Foreground (Surface: out not null Surface_Type; + Color : Color_Type; + Bright : Boolean); + + -- This procedure sets the background colour of a whole surface. + procedure Set_Background (Surface: out not null Surface_Type; + Color : Color_Type; + Bright : Boolean); + --------------------------------- -- SURFACE'S CURSOR OPERATIONS -- --------------------------------- -- This procedure returns the default foreground colour from the cursor. - procedure Get_Cursor_Foreground (Surface: in Surface_Type; + procedure Get_Cursor_Foreground (Surface: in not null Surface_Type; Color : out Color_Type; Bright : out Boolean); pragma Inline (Get_Cursor_Foreground); -- This procedure returns the default background colour from the cursor. - procedure Get_Cursor_Background (Surface: in Surface_Type; + procedure Get_Cursor_Background (Surface: in not null Surface_Type; Color : out Color_Type; Bright : out Boolean); pragma Inline (Get_Cursor_Background); -- This procedure changes the default foreground colour for the cursor. - procedure Set_Cursor_Foreground (Surface: out Surface_Type; + procedure Set_Cursor_Foreground (Surface: out not null Surface_Type; Color : Color_Type; Bright : Boolean); pragma Inline (Set_Cursor_Foreground); -- This procedure changes the default background colour for the cursor. - procedure Set_Cursor_Background (Surface: out Surface_Type; + procedure Set_Cursor_Background (Surface: out not null Surface_Type; Color : Color_Type; Bright : Boolean); pragma Inline (Set_Cursor_Background); diff --git a/src/ansi-cursors.adb b/src/ansi-cursors.adb index 44612d6..bbe60f1 100644 --- a/src/ansi-cursors.adb +++ b/src/ansi-cursors.adb @@ -36,7 +36,8 @@ package body Ansi.Cursors is procedure Put_Ansi_Sequence (Item: Str_Type) renames Ansi.Text_IO.Put_Ansi_Sequence; - -- This function transforms a number into a string. + + function To_String (N: Positive) return Str_Type is C: String := N'Image; @@ -55,8 +56,23 @@ package body Ansi.Cursors is end To_String; + ---------------------------------------------------------------------------- + function New_Cursor (Row: Row_Type; + Col: Col_Type) + return not null Ansi.Cursor_Type is + begin + + return new Cursor_Type'(Row => Row, + Col => Col); + + end New_Cursor; + + ----------------------- + -- CURSOR OPERATIONS -- + ----------------------- + procedure Set_Position (Cursor : in out Cursor_Type; New_Row: Row_Type; diff --git a/src/ansi-cursors.ads b/src/ansi-cursors.ads index 61cae7d..8b1ed11 100644 --- a/src/ansi-cursors.ads +++ b/src/ansi-cursors.ads @@ -31,6 +31,15 @@ package Ansi.Cursors is type Cursor_Type is tagged limited private; + + + function New_Cursor (Row: Row_Type; + Col: Col_Type) + return not null Ansi.Cursor_Type; + + ----------------------- + -- CURSOR OPERATIONS -- + ----------------------- -- This procedure changes the position of the cursor to another. procedure Set_Position (Cursor : in out Cursor_Type; @@ -106,7 +115,11 @@ private Row: Row_Type; Col: Col_Type; end record; - + + -- This function transforms a number into a string. + function To_String (N: Positive) + return Str_Type; + pragma Pure_Function (To_String); end Ansi.Cursors; diff --git a/src/ansi-exceptions.ads b/src/ansi-exceptions.ads index 79be97d..abff89e 100644 --- a/src/ansi-exceptions.ads +++ b/src/ansi-exceptions.ads @@ -34,6 +34,7 @@ package Ansi.Exceptions is -- Raised when trying to print something out of bounds. Out_Of_Bounds_Issue : exception; + Windows_Size_Issue : exception; end Ansi.Exceptions; diff --git a/src/ansi-styles.adb b/src/ansi-styles.adb index 20a68bc..754d54c 100644 --- a/src/ansi-styles.adb +++ b/src/ansi-styles.adb @@ -26,53 +26,292 @@ -- -- ------------------------------------------------------------------------------- -with Ada.Text_IO; +with Ansi.Cursors; +with Ansi.Exceptions; +with Ansi.Text_IO; package body Ansi.Styles is + ZERO: CONSTANT Natural := Character'Pos('0'); + + ------------------------ + -- SURFACE OPERATIONS -- + ------------------------ + + procedure Get_Style (Surface: in not null Surface_Type; + Styles : out Style_Array; + Row : Row_Type; + Col : Col_Type) is + begin + + Styles := Surface.Grid(Row, Col).Fmt.Style; + + exception + when Constraint_Error => + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Index out of range!"; + + end Get_Style; - procedure Set_Style (Style: Style_Type) is + + procedure Put_Style (Styles: Style_Array) is + -- The sequence is stored in an array like: + -- ESC[<>;<>;<>m + -- Where <> are two bytes the first one is \0 if the Style is printed, + -- otherwise it's '2'. The second one is the style code. + Size : CONSTANT Positive := Styles'Size * 3; + Sequence: Str_Type (1 .. Size) := (others => Char_Type'Val(0)); + Pointer : Natural := 1; begin + -- We add the semicolons to the string. + for I in Natural range 1 .. Styles'Size loop + Sequence(3*I) := ';'; + end loop; + Sequence(Size) := 'm'; + + for S in Styles'Range loop + Sequence(Pointer + 1) := Char_Type'Val(S'Enum_Rep + ZERO); + if not Styles(S) then + Sequence(Pointer) := '2'; + end if; + Pointer := Pointer + 3; + end loop; - -- Ada.Text_IO.Put(ESC & Character'Val(48 + Style'Enum_Rep) & 'm'); - Styles_Used(Style) := True; + Ansi.Text_IO.Put_Ansi_Sequence(ESC & Sequence); - end Set_Style; + end Put_Style; + procedure Put_Style (Style: Style_Type) is + begin + + Ansi.Text_IO.Put_Ansi_Sequence(ESC & + Char_Type'Val(Style'Enum_Rep + ZERO) & + 'm'); + + end Put_Style; + + + + procedure Set_Style (Surface: out not null Surface_Type; + Styles : Style_Array; + Row : Row_Type; + Col : Col_Type) is + begin + + if Surface.Grid(Row, Col).Fmt.Style /= Styles then + Surface.Grid(Row, Col).Fmt.Style := Styles; + Surface.Push(Ansi.Cursors.New_Cursor(Row, Col)); + end if; - procedure Remove_Style (Style: Style_Type) is + exception + when Constraint_Error => + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Index out of range!"; + + end Set_Style; + + + procedure Set_Style (Surface: out not null Surface_Type; + Style : Style_Type; + Row : Row_Type; + Col : Col_Type) is + begin + + if not Surface.Grid(Row, Col).Fmt.Style(Style) then + Surface.Grid(Row, Col).Fmt.Style(Style) := True; + Surface.Push(Ansi.Cursors.New_Cursor(Row, Col)); + end if; + + exception + when Constraint_Error => + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Index out of range!"; + + end Set_Style; + + + procedure Remove_Style (Surface: out not null Surface_Type; + Style : Style_Type; + Row : Row_Type; + Col : Col_Type) is begin - -- Ada.Text_IO.Put(ESC & '2' & Character'Val(48 + Style'Enum_Rep) & 'm'); - Styles_Used(Style) := False; + if Surface.Grid(Row, Col).Fmt.Style(Style) then + Surface.Grid(Row, Col).Fmt.Style(Style) := False; + Surface.Push(Ansi.Cursors.New_Cursor(Row, Col)); + end if; + + exception + when Constraint_Error => + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Index out of range!"; end Remove_Style; - - procedure Remove_All_Styles is + + procedure Set_Style (Surface : out not null Surface_Type; + Styles : Style_Array; + From_Row: Row_Type; + From_Col: Col_Type; + To_Row : Row_Type; + To_Col : Col_Type) is begin - for Style in Styles_Used'Range loop - if Styles_Used(Style) then - Remove_Style(Style); - end if; + if To_Row > Surface.Height or To_Col > Surface.Width then + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Range out of bounds!"; + end if; + + for Row in Row_Type range From_Row .. To_Row loop + for Col in Col_Type range From_Col .. To_Col loop + Set_Style(Surface => Surface, + Styles => Styles, + Row => Row, + Col => Col); + end loop; + end loop; + + end Set_Style; + + procedure Set_Style (Surface : out not null Surface_Type; + Style : Style_Type; + From_Row: Row_Type; + From_Col: Col_Type; + To_Row : Row_Type; + To_Col : Col_Type) is + begin + + if To_Row > Surface.Height or To_Col > Surface.Width then + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Range out of bounds!"; + end if; + + for Row in Row_Type range From_Row .. To_Row loop + for Col in Col_Type range From_Col .. To_Col loop + Set_Style(Surface => Surface, + Style => Style, + Row => Row, + Col => Col); + end loop; + end loop; + + end Set_Style; + + + procedure Remove_Style (Surface : out not null Surface_Type; + Style : Style_Type; + From_Row: Row_Type; + From_Col: Col_Type; + To_Row : Row_Type; + To_Col : Col_Type) is + begin + + if To_Row > Surface.Height or To_Col > Surface.Width then + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Range out of bounds!"; + end if; + + for Row in Row_Type range From_Row .. To_Row loop + for Col in Col_Type range From_Col .. To_Col loop + Set_Style(Surface => Surface, + Style => Style, + Row => Row, + Col => Col); + end loop; + end loop; + + end Remove_Style; + + + + procedure Set_Style (Surface: out not null Surface_Type; + Styles : Style_Array) is + begin + + for Row in Surface.Grid'Range(1) loop + for Col in Surface.Grid'Range(2) loop + Surface.Grid(Row, Col).Fmt.Style := Styles; + end loop; + end loop; + + Surface.Update_All := True; + + end Set_Style; + + + procedure Set_Style (Surface: out not null Surface_Type; + Style : Style_Type) is + begin + + for Row in Surface.Grid'Range(1) loop + for Col in Surface.Grid'Range(2) loop + Surface.Grid(Row, Col).Fmt.Style(Style) := True; + end loop; + end loop; + + Surface.Update_All := True; + + end Set_Style; + + + procedure Remove_Style (Surface: out not null Surface_Type; + Style : Style_Type) is + begin + + for Row in Surface.Grid'Range(1) loop + for Col in Surface.Grid'Range(2) loop + Surface.Grid(Row, Col).Fmt.Style(Style) := False; + end loop; end loop; - end Remove_All_Styles; + Surface.Update_All := True; + + end Remove_Style; + + + --------------------------------- + -- SURFACE'S CURSOR OPERATIONS -- + --------------------------------- - procedure Plain is + procedure Get_Cursor_Style (Surface: in not null Surface_Type; + Styles : out Style_Array) is begin + Styles := Surface.Cursor_Fmt.Style; + + end Get_Cursor_Style; + + + procedure Set_Cursor_Style (Surface: out not null Surface_Type; + Styles : in Style_Array) is + begin + + Surface.Cursor_Fmt.Style := Styles; + + end Set_Cursor_Style; + + + procedure Set_Cursor_Style (Surface: out not null Surface_Type; + Style : in Style_Type) is + begin + + Surface.Cursor_Fmt.Style(Style) := True; + + end Set_Cursor_Style; + + + procedure Remove_Cursor_Style (Surface: out not null Surface_Type; + Style : in Style_Type) is + begin - NULL; - -- Ada.Text_IO.Put(ESC & "0m"); + Surface.Cursor_Fmt.Style(Style) := False; - end Plain; + end Remove_Cursor_Style; end Ansi.Styles; diff --git a/src/ansi-styles.ads b/src/ansi-styles.ads index a24948d..35724e5 100644 --- a/src/ansi-styles.ads +++ b/src/ansi-styles.ads @@ -30,22 +30,109 @@ -- This package contains procedures to work with styles. package Ansi.Styles is - -- It adds an style, many styles can be set at the same time. - procedure Set_Style (Style: Style_Type); + ------------------------ + -- SURFACE OPERATIONS -- + ------------------------ + + -- This procedure returns the style in a certain position of the surface. + procedure Get_Style (Surface: in not null Surface_Type; + Styles : out Style_Array; + Row : Row_Type; + Col : Col_Type); + pragma Inline (Get_Style); + + + -- This procedure puts a style array in standard output. + procedure Put_Style (Styles: Style_Array); + + -- This procedure puts a style in standard output. + procedure Put_Style (Style: Style_Type); + pragma Inline (Put_Style); + + + -- This procedure sets a style array in a cell of the surface. + procedure Set_Style (Surface: out not null Surface_Type; + Styles : Style_Array; + Row : Row_Type; + Col : Col_Type); + pragma Inline (Set_Style); + + -- This procedure sets a style to true in a cell of the surface. + procedure Set_Style (Surface: out not null Surface_Type; + Style : Style_Type; + Row : Row_Type; + Col : Col_Type); + + -- This procedure removes a style (sets it to false) in a cell of the + -- surface. + procedure Remove_Style (Surface: out not null Surface_Type; + Style : Style_Type; + Row : Row_Type; + Col : Col_Type); + + + -- This procedure sets a style array in a block from the surface. + procedure Set_Style (Surface : out not null Surface_Type; + Styles : Style_Array; + From_Row: Row_Type; + From_Col: Col_Type; + To_Row : Row_Type; + To_Col : Col_Type); + + -- This procedure sets a style to true in a block from the surface. + procedure Set_Style (Surface : out not null Surface_Type; + Style : Style_Type; + From_Row: Row_Type; + From_Col: Col_Type; + To_Row : Row_Type; + To_Col : Col_Type); + + -- This procedure removes a style from a block of the surface. + procedure Remove_Style (Surface : out not null Surface_Type; + Style : Style_Type; + From_Row: Row_Type; + From_Col: Col_Type; + To_Row : Row_Type; + To_Col : Col_Type); + + + -- This procedure sets a style array for all the surface. + procedure Set_Style (Surface: out not null Surface_Type; + Styles : Style_Array); + + -- This procedure sets a style to true in all cells of the surface. + procedure Set_Style (Surface: out not null Surface_Type; + Style : Style_Type); + + -- This procedure removes a style from all cells of the surface. + procedure Remove_Style (Surface: out not null Surface_Type; + Style : Style_Type); + - -- Removes a specific style. It doesn't raise any error if the style hasn't - -- been set before. - procedure Remove_Style (Style: Style_Type); + --------------------------------- + -- SURFACE'S CURSOR OPERATIONS -- + --------------------------------- - -- Removes all styles without removing the colours. - procedure Remove_All_Styles; + -- This procedure returns the default style of the cursor. + procedure Get_Cursor_Style (Surface: in not null Surface_Type; + Styles : out Style_Array); + pragma Inline (Get_Cursor_Style); - -- Resets the terminal to the initial state (colours included) - procedure Plain; + -- This procedure changes the default styles of the cursor to an array of + -- them. + procedure Set_Cursor_Style (Surface: out not null Surface_Type; + Styles : in Style_Array); + pragma Inline (Set_Cursor_Style); -private + -- This procedure changes a default style of the cursor to true. + procedure Set_Cursor_Style (Surface: out not null Surface_Type; + Style : in Style_Type); + pragma Inline (Set_Cursor_Style); - Styles_Used: array (Style_Type'Range) of Boolean := (others => False); + -- This procedure removes a default style of the cursor. + procedure Remove_Cursor_Style (Surface: out not null Surface_Type; + Style : in Style_Type); + pragma Inline (Remove_Cursor_Style); end Ansi.Styles; diff --git a/src/ansi-surfaces.adb b/src/ansi-surfaces.adb index d5c3bc1..32877f9 100644 --- a/src/ansi-surfaces.adb +++ b/src/ansi-surfaces.adb @@ -64,12 +64,14 @@ package body Ansi.Surfaces is procedure Put (Item : Str_Type; - Surface: Surface_Type := null) is + Surface: Surface_Type := null; + Feed : Boolean := False) is begin for Char of Item loop Put(Item => Char, - Surface => Surface); + Surface => Surface, + Feed => Feed); end loop; exception @@ -81,7 +83,8 @@ package body Ansi.Surfaces is procedure Put (Item : Char_Type; - Surface: Surface_Type := null) is + Surface: Surface_Type := null; + Feed : Boolean := False) is Surf: Surface_Type := (if Surface = null then Main_Surface else @@ -89,8 +92,12 @@ package body Ansi.Surfaces is begin if Surf.Cursor.Get_Col > Col_Type(Surf.Width) then - raise Ansi.Exceptions.Out_Of_Bounds_Issue - with "Character went out of bounds!"; + if Feed then + Surf.Cursor.Set_Position(Surf.Cursor.Get_Row + 1, 1, False); + else + raise Ansi.Exceptions.Out_Of_Bounds_Issue + with "Character went out of bounds!"; + end if; end if; Surf.Grid(Surf.Cursor.Get_Row, Surf.Cursor.Get_Col).Char := Item; diff --git a/src/ansi-surfaces.ads b/src/ansi-surfaces.ads index 5fb0eb4..a23bc7f 100644 --- a/src/ansi-surfaces.ads +++ b/src/ansi-surfaces.ads @@ -55,13 +55,15 @@ package Ansi.Surfaces is -- ranges but it writes it until it can. It also moves the cursor one space -- to the left of the place where it ended. (Out_Of_Bounds_Issue) procedure Put (Item : Str_Type; - Surface: Surface_Type := null); + Surface: Surface_Type := null; + Feed : Boolean := False); -- This procedure prints a character into a surface. If the surface is null, -- it points to the main surface. It raises an error if the character goes -- out of bounds. (Out_Of_Bounds_Issue) procedure Put (Item : Char_Type; - Surface: Surface_Type := null); + Surface: Surface_Type := null; + Feed : Boolean := False); -- This procedure forces a surface to be printed onto the screen, if it goes -- out of bounds it raises an exception Out_Of_Bounds_Issue. If the surface diff --git a/src/ansi.adb b/src/ansi.adb index 3979d84..407965f 100644 --- a/src/ansi.adb +++ b/src/ansi.adb @@ -31,6 +31,8 @@ with Ansi.Cursors; with Ansi.Exceptions; with Ansi.Surfaces; +pragma Elaborate (Ansi.Surfaces); + package body Ansi is @@ -158,6 +160,7 @@ begin -- We initialize the package. Temp_Boolean := Update_Terminal_Size; + -- Free(Main_Surface); Main_Surface := Ansi.Surfaces.Create(Height, Width); Main_Cursor := new Cursors.Cursor_Type; diff --git a/src/ansi.ads b/src/ansi.ads index 82a5c12..d0f9454 100644 --- a/src/ansi.ads +++ b/src/ansi.ads @@ -80,6 +80,11 @@ package Ansi is Reversed => 7); for Style_Type'Size use 3; + -- This type is just an array of styles telling which are on and which off. + type Style_Array is array (Style_Type'Range) of Boolean + with Default_Component_Value => False; + pragma Pack(Style_Array); + -- The type of character we will use for this program. subtype Char_Type is Wide_Character; @@ -167,11 +172,6 @@ private ----------------------------------------------------------------------- ----------- -- TYPES -- ----------- - - -- This type is just an array of styles telling which are on and which off. - type Style_Array is array (Style_Type'Range) of Boolean - with Default_Component_Value => False; - pragma Pack(Style_Array); -- The format type contains the information about formatting in every cell -- of the matrix using only two bytes of memory to store the colour, the @@ -258,7 +258,7 @@ private ----------------------------------------------------------------------- -- Finally we add a variable to tell whether the surface has to be -- completely updated or not. - Uptade_All: Boolean := True; + Update_All: Boolean := True; -- The current cursor position in this surface. Cursor : Cursor_Type; @@ -291,7 +291,7 @@ private ----------------------------------------------------------------------- ----------------- -- The main surface. - Main_Surface: Surface_Type; + Main_Surface: Surface_Type := new Surface_Record(1, 1); -- The dimensions of the screen. Height: Row_Type := 1; diff --git a/src/main.adb b/src/main.adb index 0c695d9..b9099f5 100644 --- a/src/main.adb +++ b/src/main.adb @@ -35,6 +35,7 @@ with Ansi.Styles; with Ansi.Surfaces; with Credits; with System; +with Title; -- This is the main function of the program, it returns an natural nuber with -- the error code if any occurs. @@ -132,7 +133,9 @@ begin Ansi.Surfaces.Put(Red_Surf, 1, 1); Ansi.Surfaces.Put(Small_Green, 2, 2); Ansi.Surfaces.Put(Col_Blue, 4, 4); - + Ansi.Surfaces.Put(Ansi.Get_Main_Surface, 1, 1); + + Title.Main_Title; -- Credits.Startup_Notice; -- Credits.Start_UP diff --git a/src/title.adb b/src/title.adb new file mode 100644 index 0000000..8dd6aa6 --- /dev/null +++ b/src/title.adb @@ -0,0 +1,166 @@ +------------------------------------------------------------------------------- +-- -- +-- T I T L E . A D B -- +-- -- +-- A D A T Y P E R -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------- +-- Copyright (c) 2020 José Antonio Verde Jiménez All Rights Reserved -- +------------------------------------------------------------------------------- +-- This file is part of adatyper. -- +-- -- +-- This program is free software: you can redistribute it and/or modify it -- +-- under the terms of the GNU General License as published by the Free -- +-- Software Foundation, either version 3 of the License, or (at your -- +-- opinion) 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, see . -- +-- -- +------------------------------------------------------------------------------- + +with Ansi.Colors; +with Ansi.Cursors; +with Ansi.Exceptions; +with Ansi.Text_IO; + +package body Title is + + use type Ansi.Col_Type; + use type Ansi.Row_Type; + + procedure Main_Title is + type Position is + record + R: Ansi.Row_Type; + C: Ansi.Col_Type; + end record; + + Left: Ansi.Col_Type; + Top : Ansi.Row_Type; + + Positions : array (1 .. 8) of Position; + Cursor_Pos: Natural := 0; + Sleep : Duration := 1.0; + begin + + Left := (Ansi.Get_Width - 8*7) / 2; + Top := 4; -- Ansi.Row_Type(Left) / 4; + + for P in Positions'Range loop + Positions(P) := Position'(Top, Ansi.Col_Type(Positive(Left)+(P-1)*7)); + end loop; + + Ansi.Surfaces.Put( Letter_Big_A, Positions(1).R, Positions(1).C); + Ansi.Surfaces.Put(Letter_Small_d, Positions(2).R, Positions(2).C); + Ansi.Surfaces.Put(Letter_Small_a, Positions(3).R, Positions(3).C); + Ansi.Surfaces.Put( Letter_Big_T, Positions(4).R, Positions(4).C); + Ansi.Surfaces.Put(Letter_Small_y, Positions(5).R, Positions(5).C); + Ansi.Surfaces.Put(Letter_Small_p, Positions(6).R, Positions(6).C); + Ansi.Surfaces.Put(Letter_Small_e, Positions(7).R, Positions(7).C); + Ansi.Surfaces.Put(Letter_Small_r, Positions(8).R, Positions(8).C); + + exception + when Constraint_Error => + raise Ansi.Exceptions.Windows_Size_Issue + with "The window is too small!"; + end Main_Title; + +begin + + Ansi.Colors.Set_Cursor_Foreground(Letter_Big_A, Ansi.Red, True); + Ansi.Surfaces.Put(" _ ", Letter_Big_A, True); + Ansi.Surfaces.Put(" / |", Letter_Big_A, True); + Ansi.Surfaces.Put(" / |", Letter_Big_A, True); + Ansi.Surfaces.Put(" / - |", Letter_Big_A, True); + Ansi.Surfaces.Put(" / /| |", Letter_Big_A, True); + Ansi.Surfaces.Put("/_/ |_|", Letter_Big_A, True); + + Ansi.Colors.Set_Cursor_Foreground(Letter_Small_d, Ansi.Red, True); + Ansi.Surfaces.Put(" _ ", Letter_Small_d, True); + Ansi.Surfaces.Put(" / |", Letter_Small_d, True); + Ansi.Surfaces.Put(" _) |", Letter_Small_d, True); + Ansi.Surfaces.Put(" / |", Letter_Small_d, True); + Ansi.Surfaces.Put("( (_) |", Letter_Small_d, True); + Ansi.Surfaces.Put(" \___/ ", Letter_Small_d, True); + + Ansi.Colors.Set_Cursor_Foreground(Letter_Small_a, Ansi.Red, True); + Ansi.Surfaces.Put(" ", Letter_Small_a, True); + Ansi.Surfaces.Put(" ", Letter_Small_a, True); + Ansi.Surfaces.Put(" ___ ", Letter_Small_a, True); + Ansi.Surfaces.Put(" / \ ", Letter_Small_a, True); + Ansi.Surfaces.Put("( (_) )", Letter_Small_a, True); + Ansi.Surfaces.Put(" \____\", Letter_Small_a, True); + + + Ansi.Colors.Set_Cursor_Foreground(Letter_Big_T, Ansi.Red, True); + Ansi.Surfaces.Put(" _____ ", Letter_Big_T, True); + Ansi.Surfaces.Put("(_ _)", Letter_Big_T, True); + Ansi.Surfaces.Put(" | | ", Letter_Big_T, True); + Ansi.Surfaces.Put(" | | ", Letter_Big_T, True); + Ansi.Surfaces.Put(" | | ", Letter_Big_T, True); + Ansi.Surfaces.Put(" |_| ", Letter_Big_T, True); + + Ansi.Colors.Set_Cursor_Foreground(Letter_Small_y, Ansi.Red, True); + Ansi.Surfaces.Put(" ", Letter_Small_y, True); + Ansi.Surfaces.Put(" _ _ ", Letter_Small_y, True); + Ansi.Surfaces.Put("( \_/ )", Letter_Small_y, True); + Ansi.Surfaces.Put(" \ / ", Letter_Small_y, True); + Ansi.Surfaces.Put(" _) / ", Letter_Small_y, True); + Ansi.Surfaces.Put("(__/ ", Letter_Small_y, True); + + Ansi.Colors.Set_Cursor_Foreground(Letter_Small_p, Ansi.Red, True); + Ansi.Surfaces.Put(" ", Letter_Small_p, True); + Ansi.Surfaces.Put(" ___ ", Letter_Small_p, True); + Ansi.Surfaces.Put(" / \ ", Letter_Small_p, True); + Ansi.Surfaces.Put("| (_) )", Letter_Small_p, True); + Ansi.Surfaces.Put("| __/ ", Letter_Small_p, True); + Ansi.Surfaces.Put("|_( ", Letter_Small_p, True); + + Ansi.Colors.Set_Cursor_Foreground(Letter_Small_e, Ansi.Red, True); + Ansi.Surfaces.Put(" ", Letter_Small_e, True); + Ansi.Surfaces.Put(" ____ ", Letter_Small_e, True); + Ansi.Surfaces.Put(" / __ \", Letter_Small_e, True); + Ansi.Surfaces.Put("/ ___/", Letter_Small_e, True); + Ansi.Surfaces.Put("\ (___ ", Letter_Small_e, True); + Ansi.Surfaces.Put(" \____)", Letter_Small_e, True); + + Ansi.Colors.Set_Cursor_Foreground(Letter_Small_r, Ansi.Red, True); + Ansi.Surfaces.Put(" ", Letter_Small_r, True); + Ansi.Surfaces.Put(" ___ ", Letter_Small_r, True); + Ansi.Surfaces.Put("/\/ __)", Letter_Small_r, True); + Ansi.Surfaces.Put("| / ", Letter_Small_r, True); + Ansi.Surfaces.Put("| | ", Letter_Small_r, True); + Ansi.Surfaces.Put("|_| ", Letter_Small_r, True); + + + Ansi.Colors.Set_Cursor_Foreground(Letter_Cursor, Ansi.White, True); + Ansi.Surfaces.Put("#######", Letter_Cursor, True); + Ansi.Surfaces.Put("#######", Letter_Cursor, True); + Ansi.Surfaces.Put("#######", Letter_Cursor, True); + Ansi.Surfaces.Put("#######", Letter_Cursor, True); + Ansi.Surfaces.Put("#######", Letter_Cursor, True); + Ansi.Surfaces.Put("#######", Letter_Cursor, True); + + + Ansi.Colors.Set_Cursor_Background(Letter_Space, Ansi.Black, False); + Ansi.Surfaces.Put(" ", Letter_Space, True); + Ansi.Surfaces.Put(" ", Letter_Space, True); + Ansi.Surfaces.Put(" ", Letter_Space, True); + Ansi.Surfaces.Put(" ", Letter_Space, True); + Ansi.Surfaces.Put(" ", Letter_Space, True); + Ansi.Surfaces.Put(" ", Letter_Space, True); + +end Title; + + +---=======================-------------------------=========================--- +--=======================-- E N D O F F I L E --=========================-- +---=======================-------------------------=========================--- diff --git a/src/todo/title.ads b/src/title.ads similarity index 71% rename from src/todo/title.ads rename to src/title.ads index 734555b..ca98503 100644 --- a/src/todo/title.ads +++ b/src/title.ads @@ -1,6 +1,6 @@ ------------------------------------------------------------------------------- -- -- --- C R E D I T S . A D S -- +-- T I T L E . A D S -- -- -- -- A D A T Y P E R -- -- -- @@ -26,14 +26,31 @@ -- -- ------------------------------------------------------------------------------- --- This package contains the credits information. -package Credits is +private with Ansi; +private with Ansi.Surfaces; - pragma Elaborate_Body (Credits); +-- This package contains the title. +package Title is - procedure Startup_Notice; + pragma Elaborate_Body (Title); -end Credits; + procedure Main_Title; + + +private + + -- The letters + Letter_Big_A: Ansi.Surface_Type := Ansi.Surfaces.Create(6, 7); + Letter_Small_d: Ansi.Surface_Type := Ansi.Surfaces.Create(6, 7); + Letter_Small_a: Ansi.Surface_Type := Ansi.Surfaces.Create(6, 7); + Letter_Big_T: Ansi.Surface_Type := Ansi.Surfaces.Create(6, 7); + Letter_Small_y: Ansi.Surface_Type := Ansi.Surfaces.Create(6, 7); + Letter_Small_p: Ansi.Surface_Type := Ansi.Surfaces.Create(6, 7); + Letter_Small_e: Ansi.Surface_Type := Ansi.Surfaces.Create(6, 7); + Letter_Small_r: Ansi.Surface_Type := Ansi.Surfaces.Create(6, 7); + Letter_Cursor : Ansi.Surface_Type := Ansi.Surfaces.Create(6, 7); + Letter_Space : Ansi.Surface_Type := Ansi.Surfaces.Create(6, 7); +end Title; ---=======================-------------------------=========================--- diff --git a/tests/logs/speed.analyzed.log b/tests/logs/speed.analyzed.log new file mode 100644 index 0000000..d289eee --- /dev/null +++ b/tests/logs/speed.analyzed.log @@ -0,0 +1,12 @@ +HEIGHT := 48 +WIDTH := 169 + +AREA := HEIGHT * WIDTH -- 8112 letters^2 + +GEN_TIME := 0.001986000 / 8 -- 0.24749975 s +REN_TIME := 1.979998000 / 8 -- 0.00024825 s +TIME := GEN_TIME + REN_TIME -- 0.247748 s + +LETTER_TIME := TIME / AREA -- 3.0540927e-05 seconds/letter + +LETTERS_FPS := AREA / TIME / 30 -- 1091.4316 letters => Surface.Area < 1091 diff --git a/tests/logs/speed.log b/tests/logs/speed.log index 051f74d..dd26539 100644 --- a/tests/logs/speed.log +++ b/tests/logs/speed.log @@ -1,4 +1,4 @@ HEIGHT: 24 WIDTH: 80 -Time taken to generate and set the background colour of 8 Surfaces: 0.000430000 -Rendering time: 0.472091000 +Time taken to generate and set the background colour of 8 Surfaces: 0.002523000 +Rendering time: 0.465534000 diff --git a/tests/src/styles.adb b/tests/src/styles.adb new file mode 100644 index 0000000..dc3edc5 --- /dev/null +++ b/tests/src/styles.adb @@ -0,0 +1,20 @@ +with Ada.Text_IO; +with Ansi; +with Ansi.Styles; + +procedure Styles is + My_Style: Ansi.Style_Array := (Ansi.Bright => True, + Ansi.Dim => True, + Ansi.Italics => True, + Ansi.Underlined => True, + Ansi.Reversed => True); +begin + + Ansi.Styles.Put_Style(My_Style); + Ada.Text_IO.Put_Line("Hola"); + + Ansi.Finalize; +exception + when others => + Ada.Text_IO.Put_Line("ERROR: An unknown error occurred"); +end Styles; diff --git a/tests/tests.gpr b/tests/tests.gpr index 6cb2327..b217b8e 100644 --- a/tests/tests.gpr +++ b/tests/tests.gpr @@ -3,6 +3,6 @@ project Tests is for Source_Dirs use ("../src", "src"); for Object_Dir use "obj"; for Exec_Dir use "bin"; - for Main use ("speed.adb", "speed-c.c"); + for Main use ("speed.adb", "speed-c.c", "styles.adb"); end Tests;