diff --git a/CHANGELOG.md b/CHANGELOG.md index 55711c6..a0e30e7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,4 +23,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Finished Styles and Colours - Added some tests - Fixed some major bugs +- Completed Surfaces (only some features have to be implemented) +- Optimized update time +- Added title screen diff --git a/TODO b/TODO index 37ae123..24466a6 100644 --- a/TODO +++ b/TODO @@ -15,3 +15,7 @@ * Scrolling. * Check `tput smcup' and `tput rmcup' * Make all types Controlled types. And add garbage collection. + * Add own pool to stack. + * In functions with repeated code, use procedures inide them with global + variables and constants to reduce duplication related problems. Also, inline + them. diff --git a/src/ansi-colors.adb b/src/ansi-colors.adb index 1e1f9e7..d5ea4c2 100644 --- a/src/ansi-colors.adb +++ b/src/ansi-colors.adb @@ -40,6 +40,34 @@ package body Ansi.Colors is -- SURFACE OPERATIONS -- ------------------------ + function Gen_Foreground (Color : Color_Type; + Bright: Boolean) + return Str_Type is + begin + + return (if Bright then + '9' + else + '3' + ) & Char_Type'Val(ZERO + Color'Enum_Rep); + + end Gen_Foreground; + + + function Gen_Background (Color : Color_Type; + Bright: Boolean) + return Str_Type is + begin + + return (if Bright then + "10" + else + "4") & Char_Type'Val(ZERO + Color'Enum_Rep); + + end Gen_Background; + + + procedure Get_Foreground (Surface: in not null Surface_Type; Color : out Color_Type; Bright : out Boolean; @@ -81,13 +109,7 @@ package body Ansi.Colors is Bright: Boolean) is begin - Ansi.Text_IO.Put_Ansi_Sequence(ESC & - (if Bright then - "9" - else - "3") & - Char_Type'Val(ZERO + Color'Enum_Rep) & - "m"); + Ansi.Text_IO.Put_Ansi_Sequence(ESC & Gen_Foreground(Color,Bright) & "m"); end Put_Foreground; @@ -96,13 +118,7 @@ package body Ansi.Colors is Bright: Boolean) is begin - Ansi.Text_IO.Put_Ansi_Sequence(ESC & - (if Bright then - "10" - else - "4") & - Char_Type'Val(ZERO + Color'Enum_Rep) & - "m"); + Ansi.Text_IO.Put_Ansi_Sequence(ESC & Gen_Background(Color,Bright) & "m"); end Put_Background; diff --git a/src/ansi-colors.ads b/src/ansi-colors.ads index ba0ac1f..7c2c518 100644 --- a/src/ansi-colors.ads +++ b/src/ansi-colors.ads @@ -34,6 +34,22 @@ package Ansi.Colors is -- SURFACE OPERATIONS -- ------------------------ + -- This function generates the escape code for the foreground colour. + -- Only the number, if the escape code is "ESC[32m", then 32 is returned. + function Gen_Foreground (Color : Color_Type; + Bright: Boolean) + return Str_Type; + pragma Pure_Function (Gen_Foreground); + pragma Inline (Gen_Foreground); + + -- This function generates the escape code number for the background colour. + function Gen_Background (Color : Color_Type; + Bright: Boolean) + return Str_Type; + pragma Pure_Function (Gen_Foreground); + pragma Inline (Gen_Foreground); + + -- This procedure returns the foreground colour in a certain position of the -- surface. procedure Get_Foreground (Surface: in not null Surface_Type; diff --git a/src/ansi-cursors.adb b/src/ansi-cursors.adb index 33a3933..137d1bd 100644 --- a/src/ansi-cursors.adb +++ b/src/ansi-cursors.adb @@ -30,32 +30,13 @@ with Ada.Text_IO; with Ansi.Text_IO; with Ansi.Exceptions; +with Toolbox; use Toolbox; package body Ansi.Cursors is procedure Put_Ansi_Sequence (Item: Str_Type) renames Ansi.Text_IO.Put_Ansi_Sequence; - - - function To_String (N: Positive) - return Str_Type is - C: String := N'Image; - S: Str_Type (1 .. C'Length); - L: Natural := 0; - begin - - for I of C loop - if I /= ' ' then - S(S'First + L) := Char_Type'Val(Character'Pos(I)); - L := L + 1; - end if; - end loop; - - return S(S'First .. S'First + L - 1); - - end To_String; - ---------------------------------------------------------------------------- @@ -83,7 +64,21 @@ package body Ansi.Cursors is ----------------------- -- CURSOR OPERATIONS -- ----------------------- - + + function Set_Position (Cursor : in out Cursor_Type; + New_Row: Row_Type; + New_Col: Col_Type) + return Str_Type is + begin + + Cursor.Row := New_Row; + Cursor.Col := New_Col; + + return ESC & To_String(Positive(New_Row)) & ";" & + To_String(Positive(New_Col)) & "H"; + + end Set_Position; + 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 b18b1f4..5bd8c6a 100644 --- a/src/ansi-cursors.ads +++ b/src/ansi-cursors.ads @@ -46,6 +46,14 @@ package Ansi.Cursors is -- CURSOR OPERATIONS -- ----------------------- + -- This function changes the position of the cursor and returns the escape + -- sequence to feed the stdout. + function Set_Position (Cursor : in out Cursor_Type; + New_Row: Row_Type; + New_Col: Col_Type) + return Str_Type; + + -- This procedure changes the position of the cursor to another. procedure Set_Position (Cursor : in out Cursor_Type; New_Row: Row_Type; @@ -121,11 +129,6 @@ private 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-surfaces.adb b/src/ansi-surfaces.adb index 66a59f9..464b1d1 100644 --- a/src/ansi-surfaces.adb +++ b/src/ansi-surfaces.adb @@ -201,53 +201,8 @@ package body Ansi.Surfaces is end Put; + - -- FIXED!!! - -- XXX: Bug found, when printing the surface the last row is somehow printed - -- onto the first row at least when printing into the first row. There is no - -- problem with columns. - -- - -- When printing a 5x5 there is no problem, though. - -- - -- TESTS: 1) Test 9x9, 8x8, and over 10x10, 11x11. If it only happens with - -- two digit numbers, then it's the problem of the function that - -- converts the numbers into strings. (Even thought the number of - -- columns seems right) [DONE] - -- - -- REPLICATION FOUND: The problem happens when the number of rows - -- is over 10, which then turns into 9 (independently from the - -- intended number of rows) - -- It seems to be caused from the To_String | the range of the - -- function | the ANSI itself. - -- - -- - -- 2) Test it without moving a line down. [DONE] - -- - -- When the line doesn't move down, it's all written in the same - -- line, so it's seems it's not the problem of ANSI. - -- - -- - -- 3) Test to write the escape sequences into a file or to write - -- them without the escape. [DONE] - -- - -- It's unreadable. - -- - -- POSIBLE CAUSES: Maybe is the fault of the terminal emulator or the ANSI - -- escape sequences. In that case, (knowing that it only - -- happens in the first row) would be to either increase the - -- number of rows of the matrix by one. - -- - -- POSIBLE SOLUTIONS: Instead of using numbers use the range of the grid - -- (matrix) instead. [DONE] - -- - -- The problem still occurs. - -- - -- BUG CAUSE FOUND: After tinkering with Python3 and doing the same, it - -- doesn't seem to be a problem of ANSI or the program itself. The bug is - -- found in the Ansi.Cursors package To_String function, that doesn't - -- return the first cypher of the number. That's why 10 overflows to 0, - -- 11 to 1 and 12 to 2. - -- procedure Put (Surface: Surface_Type := null; Row : Row_Type := 1; Col : Col_Type := 1) is @@ -255,32 +210,160 @@ package body Ansi.Surfaces is Main_Surface else Surface); - Item: Element; + Item : Element; + Last_Fmt: Format := Surface.Cursor_Fmt; + + -- We set up the buffer that contains: + -- ESC[;;;;...m + NUL: CONSTANT Char_Type := Char_Type'Val(0); + Buffer : Str_Type (1 .. 2 + 2+1 + 3+1 + Style_Array'Length*3 + 1) := + (1 => ESC(ESC'First), + 2 => ESC(ESC'Last), + 2+2+1+3+1+Style_Array'Length*3+1 => 'm', + others => NUL); + + -- This type is used to store changes. + Fg_Changes: Boolean := False; + Bg_Changes: Boolean := False; + Changes : Boolean := False; + + -- This is the memory chunk. + Chunk : Str_Type(1 .. 1024); + Length: Natural := 1; + + procedure Push (Str: Str_Type); + pragma Inline (Push); + procedure Push (Str: Str_Type) is + begin + if Length + Str'Length > Chunk'Length then + Ansi.Text_IO.Put_Ansi_Sequence(Chunk(1 .. Length - 1)); + Length := 1; + end if; + Chunk(Length .. Length + Str'Length - 1) := Str; + Length := Length + Str'Length; + end Push; + + + procedure Compare_Item is + begin + -- We check which parts of the format have changed. + -- First the foreground colour; the colour and the brightness come in + -- the same pack, so if one of them has changed, we must update both. + if Item.Fmt.Fg_Color /= Last_Fmt.Fg_Color or else + Item.Fmt.Fg_Bright /= Last_Fmt.Fg_Bright + then + -- We update the new Last_Fmt. + Last_Fmt.Fg_Color := Item.Fmt.Fg_Color; + Last_Fmt.Fg_Bright := Item.Fmt.Fg_Bright; + Buffer(3 .. 4) := Ansi.Colors.Gen_Foreground( + Color => Last_Fmt.Fg_Color, + Bright => Last_Fmt.Fg_Bright); + Buffer(5) := ';'; + Fg_Changes := True; + Changes := True; + end if; + end Compare_Item; + + procedure Update_Changes is + begin + -- We then check if there has been any changes, if so we print + -- the escape sequence and set it back to 0. + if Changes then + -- We remove the last colomn. + if Bg_Changes then + Buffer(9) := NUL; + elsif Fg_Changes then + Buffer(5) := NUL; + end if; + + Changes := False; + Bg_Changes := False; + Fg_Changes := False; + + Push(Buffer & Item.Char); + + -- We finally default some parts of the buffer , to make it + -- easier for the terminal emulator not to have so many + -- sequences to convert. + for I in Positive range 3 .. Buffer'Last - 1 loop + Buffer(I) := NUL; + end loop; + else + Push(Item.Char & ""); + end if; + end Update_Changes; + + + + Node: Operation := Surface.Head; + Next: Operation; + begin - Main_Cursor.Set_Position(Row, Col); - for Y in Surf.Grid'Range(1) loop - for X in Surf.Grid'Range(2) loop - Item := Surf.Grid(Y, X); - -- TODO: Optimize it, checking if the last colour used was the same - -- as the colour now and if so change the colour. Even though this - -- function won't be used because the layers will give a more - -- optimized version, but it's good to have it for debugging in - -- early stages. - Ansi.Colors.Put_Foreground(Color => Item.Fmt.Fg_Color, - Bright => Item.Fmt.Fg_Bright); - Ansi.Colors.Put_Background(Color => Item.Fmt.Bg_Color, - Bright => Item.Fmt.Bg_Bright); - Ansi.Styles.Put_Style(Styles => Item.Fmt.Style); - Ansi.Text_IO.Put(Item.Char); - -- delay 0.01; A good effect + -- We first see two possible scenaries, the first one is a screen that is + -- completely when the Update_All attribute is set to true. The second + -- one is to check the stack for any possible changes. + + -- UPDATE ALL -- + -- Surf.Update_All := True; + if Surf.Update_All then + -- We set the cursor to the top left corner of the screen and start + -- writting from there. We also write chunks of memory instead of + -- single calls to the functions, because they are too expensive. + Main_Cursor.Set_Position(Row, Col); + for Y in Surf.Grid'Range(1) loop +--BREAKPOINT("Y =" & Y'Image, 1, True); + for X in Surf.Grid'Range(2) loop + -- We get the item. + Item := Surf.Grid(Y, X); + + -- We compare it + Compare_Item; + + -- We update the changes. + Update_Changes; + + end loop; + -- We move the cursor to the next line. + Push(Main_Cursor.Set_Position(Row + Y, Col)); end loop; - -- This one is faster because the other two will call the To_String - -- function three times. - Main_Cursor.Set_Position(Row + Y, Col); - -- Main_Cursor.Move_Down; - -- Main_Cursor.Set_Col(Col); - end loop; + -- We then print the last buffer. + Ansi.Text_IO.Put_Ansi_Sequence(Chunk(1 .. Length - 1)); + -- And we finally remove log of applied changes to the surface. + -- TODO: Free stack + Surface.Update_All := False; + + else +-- BREAKPOINT("BREAK IT DOWN!", 3, True); + Main_Loop: + while Node /= null loop + Next := Node.Next; + -- We compare this and the last cell. + Item := Surf.Grid(Node.Cursor.Get_Row, + Node.Cursor.Get_Col); + + -- We compare the item. + Compare_Item; + + -- We jump to the new position. + Push(Main_Cursor.Set_Position(Node.Cursor.Get_Row, + Node.Cursor.Get_Col)); + + -- We update the changes. + Update_Changes; + + -- TODO: We free them + Ansi.Cursors.Free(Node.Cursor); + Free(Node); + Node := Next; + end loop Main_Loop; + -- We flush the file. + Ansi.Text_IO.Put_Ansi_Sequence(Chunk(1 .. Length - 1)); + -- Ansi.Text_IO.Flush; + Surf.Head := null; + Surf.Tail := null; + end if; + end Put; @@ -468,6 +551,8 @@ package body Ansi.Surfaces is + -- TODO: Forbid to overwrite main cells for under layers, start with top + -- layer. procedure Update (Layerer: Layerer_Type) is Layer : Surface_Type; Hidden: Element := Element'(Fmt => Format'(Fg_Color => White, diff --git a/src/ansi-text_io.adb b/src/ansi-text_io.adb index 3856dfc..4e030ac 100644 --- a/src/ansi-text_io.adb +++ b/src/ansi-text_io.adb @@ -31,6 +31,14 @@ with Ansi.Cursors; package body Ansi.Text_IO is + procedure Flush is + begin + + Ada.Wide_Text_IO.Flush(File => Ada.Wide_Text_IO.Standard_Output); + + end Flush; + + procedure Put (Item: Char_Type) is begin diff --git a/src/ansi-text_io.ads b/src/ansi-text_io.ads index e2e5285..e6ed5d5 100644 --- a/src/ansi-text_io.ads +++ b/src/ansi-text_io.ads @@ -30,6 +30,10 @@ -- This package contains input and output functions. package Ansi.Text_IO is + -- This procedure flushes the Standard Output. + procedure Flush; + pragma Inline (Flush); + -- This procedure prints a character onto the screen. procedure Put (Item: Char_Type); diff --git a/src/layout.ads b/src/layout.ads new file mode 100644 index 0000000..1d30ad9 --- /dev/null +++ b/src/layout.ads @@ -0,0 +1,36 @@ +------------------------------------------------------------------------------- +-- -- +-- L A Y O U T . A D S -- +-- -- +-- A D A T Y P E R -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------- +-- 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 . -- +-- -- +------------------------------------------------------------------------------- + +package is + +end ; + + +---=======================-------------------------=========================--- +--=======================-- E N D O F F I L E --=========================-- +---=======================-------------------------=========================--- diff --git a/src/title.adb b/src/title.adb index 6ae0c80..14409e7 100644 --- a/src/title.adb +++ b/src/title.adb @@ -70,7 +70,7 @@ package body Title is for P in Positive range 1 .. 8 loop Letterer.Show(P); - delay Sleep; + -- delay Sleep; Letterer.Update; Ansi.Surfaces.Put(Ansi.Get_Main_Surface); end loop; @@ -104,7 +104,7 @@ begin Ansi.Colors.Set_Foreground(Letter_Cursor , Ansi.White, True); -- We change some styles. - Ansi.Styles.Set_Style(Letter_Big_A, Ansi.Slow_Blink); + Ansi.Styles.Set_Style(Letter_Big_A, Ansi.Reversed); -- We add them to the letterer. Letterer.Add( Letter_Big_A); diff --git a/src/toolbox.adb b/src/toolbox.adb new file mode 100644 index 0000000..1caa0e4 --- /dev/null +++ b/src/toolbox.adb @@ -0,0 +1,59 @@ +------------------------------------------------------------------------------- +-- -- +-- T O O L B O X . 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 . -- +-- -- +------------------------------------------------------------------------------- + +package body Toolbox is + + function To_String (Number: Positive) + return Str_Type is + Size: Natural := 1; + begin + + while Number / 10 ** Size /= 0 loop + Size := Size + 1; + end loop; + + Create_String: + declare + Str: Str_Type (1 .. Size); + begin + for I in Natural range 1 .. Size loop + Str(Size + 1 - I) := Char_Type'Val( + (Number / 10**(I-1)) mod 10 + 48); + end loop; + + return Str; + end Create_String; + + end To_String; + +end Toolbox; + + +---=======================-------------------------=========================--- +--=======================-- E N D O F F I L E --=========================-- +---=======================-------------------------=========================--- diff --git a/src/toolbox.ads b/src/toolbox.ads new file mode 100644 index 0000000..9fa432f --- /dev/null +++ b/src/toolbox.ads @@ -0,0 +1,46 @@ +------------------------------------------------------------------------------- +-- -- +-- T O O L B O X . A D S -- +-- -- +-- A D A T Y P E R -- +-- -- +-- S P E C -- +-- -- +------------------------------------------------------------------------------- +-- 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; use Ansi; + +-- This package contains functions common to all the project. +package Toolbox is + + -- This procedure converts a positive number into a string, and the results + -- are stored in a caché to speed up the execution. + function To_String (Number: Positive) + return Str_Type; + pragma Pure_Function (To_String); + + +end Toolbox; + + +---=======================-------------------------=========================--- +--=======================-- E N D O F F I L E --=========================-- +---=======================-------------------------=========================---