On Monday, August 14, 2023 at 4:06:39 AM UTC-6, Jeffrey R.Carter wrote:
On 2023-08-13 18:16, Micah Waddoups wrote:
I tried to compile the Unifont hex file, converted with a script into variable Ada code, but it went on forever, gradually blowing up my memory. I used an .ads file and aimed for a static build, but I suspect I would have hit the stack size limit for
executables if I succeeded
As I understand it, the file in question is for code points 0 .. 16#FFFF#, with
a maximum of 32 bytes per code point. A straightforward representation of this is
package Unifont is
type Byte is mod 2 ** 8 with Size => 8;
type Line is array (1 .. 2) of Byte with Size => 16;
type Bitmap is array (1 .. 16) of Line with Size => 256;
function Width_8 (Map : in Bitmap) return Boolean is
(for all L of Map => L (2) = 0);
type Code_Point is mod 16#FFFF# + 1;
type Font_Map is array (Code_Point) of Bitmap with Size => 2 ** 24;
Font : constant Font_Map := (others => (others => (others => 0) ) );
end Unifont;
Font will occupy 2 MB.
We can test this with
with Ada.Text_IO;
with Unifont;
procedure Unifont_Test is
-- Empty
begin -- Unifont_Test
Ada.Text_IO.Put_Line (Item => Unifont.Font (0) (1) (1)'Image);
end Unifont_Test;
and see what happens:
$ gnatmake -m -j0 -gnat12 -gnatan -gnato2 -O2 -fstack-check unifont_test.adb x86_64-linux-gnu-gcc-12 -c -gnat12 -gnatan -gnato2 -O2 -fstack-check unifont_test.adb
x86_64-linux-gnu-gcc-12 -c -gnat12 -gnatan -gnato2 -O2 -fstack-check unifont.ads
x86_64-linux-gnu-gnatbind-12 -x unifont_test.ali x86_64-linux-gnu-gnatlink-12 unifont_test.ali -O2 -fstack-check
$ ./unifont_test
0
so this representation seems to be workable. It should be trivial to write a program to read the file and produce the real array aggregate for Font.
--
Jeff Carter
"I wave my private parts at your aunties."
Monty Python & the Holy Grail
13
Thank you all for replying while I was working away from home.
Jeff, you missed a digit - it's five F's 16#FFFFF# because that is as high as Unifont goes in my copy of the hex file. Of course the technique should be able to go higher if that changes, but Unicode is pretty exhaustive as it is and Unifont is meant
to keep up with every version and addition to the Unicode code points, so I sincerely hope for no trouble for a while yet. I checked, and it seem my system has about 8 megabytes as the stack size limit, so with the ranges left empty it is not 32
megabytes, but still pretty big. Good looking code, by the way. Very easy to read. Mine is appended, but it was really a quick hack of a job with too little sleep. I probably should have done a Z Shell script (maybe take 20 seconds?), but I thought
the two second efficiency of writing a compiled composer was worth it ...somehow...
Niklas, I think you have the most actionable suggestions for me to test. Thank you.
Dmitry, Thank you for trying to understand. Since both methods of rendering fonts made available by GTK, I consider it GTK providing it. I don't want any more imports than I can provide easily with a static compile or as accompanying dynamic modules (
reason hereafter mentioned), and Licensing needs to be the most permissive possible. The idea is to be able to create a shell or a variety of other programs using my library as a very focused kind of interface that supports more characters and more
languages that my other most available options, so the font is important, even if I'm just drawing to the Linux frame buffer. I meant a transfer of code from one platform to another. Sometimes in a graphical window that acts like a text interface
window, sometimes on the linux frame buffer, and in the extreme case some times on the text console without any particular font support. The main collection of code is supposed to support all that with very limited modification to say transfer from
Linux to macOS or MS Windows? I hope this s answered your questions.
Oh, and to all, I have already abandon the idea of using Boolean with Pack, since it no longer seems to work and was a bit *too* verbose
pragma Ada_2012;
pragma Wide_Character_Encoding (UTF8);
with Ada.Text_IO;
use Ada.Text_IO;
procedure Unifont_Hex_To_Ada is
Target_Name: String := "./src/unifont.ads";
Source_Name: String := "unifont_all-15.0.06.hex";
Target: aliased File_Type;
Source: aliased File_Type;
Buffer: aliased String (1 .. 96) := (others=>' ');
Index, F: Positive := 1;
Previous, Current, Length, L: Natural := 0;
Finished: aliased Boolean:= False;
subtype Hex_Character is Character range '0' .. 'f'
with Static_Predicate=> (Hex_Character in '0' .. '9') or (Hex_Character in 'A' .. 'F') or (Hex_Character in 'a' .. 'f');
type Byte is mod 2 **8;
type Bit is mod 8;
--type Bytes is array (Natural range <>) of aliased Byte;
Bit_X: Bit := 0;
Byte_X: Byte := 0;
function Find (Item: Character)
return Natural
is
begin
for
N in Buffer'Range
loop
if Item = Buffer(N)
then return N;
end if;
end loop;
return 0;
end Find;
function Enum return Natural
is
First: Positive := 1;
Last: Natural := Integer'Max ((Find (':') -1), 0);
begin
return R: Natural
do
R := Natural'Value ("16#" &Buffer (First..Last) &'#');
end return;
end Enum;
procedure Next_Byte
is
S: String renames Buffer (F .. L);
begin
loop
if
(Index in S'Range) and (Index +1 in S'Range)
then
exit;
else
Index := S'First;
if
(Index in S'Range) and (Index +1 in S'Range)
then
exit;
else
raise Program_Error with "Next_Byte-> Somehow there are no Hex codes in string... line " &Current'Img &", string => " & S;
end if;
end if;
end loop;
if
S (Index) in Hex_Character
and
S (Index +1) in Hex_Character
then
Byte_X := Byte'Value ("16#" &S (Index..Index +1) &"#");
Bit_X := 0;
Index := Index +2;
end if;
end Next_Byte;
procedure Next_Line
is
begin
for
N in Buffer'First .. Length
loop
Buffer (N):= ' ';
end loop;
begin
Get_Line (Source, Buffer, Length);
exception
when others => null;
end;
if
Length < 32
then
Put_Line (Standard_Error, "empty or incomplete line at code point " &Natural'Image (Enum) &" (" &Current'Img &" + 1)");
else
Previous:= Current;
Current:= Enum;
if
((Previous + 1) = Current)
or else (Current = 0)
then
F:= Find (':') +1;
L:= Length;
Next_Byte;
else
F:= Find (':') +1;
L:= Length;
Next_Byte;
Put_Line (Standard_Error, " Missing character range in Source: " &Previous'Img &" .. " &Current'Img);
end if;
end if;
end Next_Line;
subtype Index_Type is Natural range 0 .. 16#FFFFF#;
subtype Y_Type is Integer range 1 .. 16;
subtype X_Type is Integer range 1 .. 16;
type Size_Type is
record
Y: aliased Y_Type:= Y_Type'First;
X: aliased X_Type:= X_Type'First;
end record;
type Size_Set_Type is array (Index_Type) of aliased Size_Type;
type Size_Set_Access is access all Size_Set_Type;
function Dot return String is
begin
if
1 = ((Byte_X / 2 **(7 - Natural(Bit_X))) and 1)
then
if
Bit_X = Bit'Last
then
Next_Byte;
else
Bit_X := Bit_X +1;
end if;
return "True";
else
if
Bit_X = Bit'Last
then
Next_Byte;
else
Bit_X := Bit_X +1;
end if;
return "False";
end if;
end Dot;
Cache_Size: Size_Set_Access := new Size_Set_Type'(others => (16, 8));
Size: Size_Set_Type renames Cache_Size.all;
begin
begin
Open (Source, In_File, Source_Name);
exception
when others =>
raise Status_Error with " Source File not found: " &Source_Name;
end;
begin
Create (Target, Out_File, Target_Name);
exception
when others =>
Open (Target, Out_File, Target_Name);
end;
begin
Put_Line (Target, "pragma Ada_2012;");
Put_Line (Target, "pragma Wide_Character_Encoding (UTF8);");
New_Line (Target, 2);
--Put_Line (Target, "with ada.unchecked_conversion;");
--New_Line (Target, 2);
Put_Line (Target, "package Unifont is");
Put_Line (Target, "subtype Index_Type is Wide_Wide_Character range Wide_Wide_Character'Val (0) .. Wide_Wide_Character'Val (16#FFFFF#);");
Put_Line (Target, "subtype Y_Type is Integer range 1 .. 16;");
Put_Line (Target, "subtype X_Type is Integer range 1 .. 16;");
Put_Line (Target, "type Size_Type is record Y: aliased Y_Type := 1; X: aliased X_Type := 1; end record;");
Put_Line (Target, "type Size_Set_Type is array (Index_Type) of aliased Size_Type;");
Put_Line (Target, "type Glyph_Type is array (Y_Type, X_Type) of Boolean");
Put_Line (Target, "with Pack, Size=> 256;");
Put_Line (Target, "type Glyph_Set_Type is array (Index_Type) of aliased Glyph_Type;");
Put_Line (Target, "Glyph: constant Glyph_Set_Type :=");
Put (Target, "(");
loop
exit when End_Of_File (Source);
Next_Line; -- Load Next Line and extract Code Point index
if
Length > 64
then
Size (Current) := (16, 16);
Put_Line (Target, "Wide_Wide_Character'Val (" &Integer'Image(Current) &") =>");
Put (Target, "(");
for Y in 1 .. 16
loop
Put_Line (Target, Y'Img &" =>");
Put (Target, "(");
for X in 1 .. 16
loop
if
X < 16
then
Put (Target, Dot &", ");
else
Put (Target, Dot &")");
end if;
end loop;
if
Y < 16
then
Put_Line (Target, ",");
else
Put_Line (Target, "),");
end if;
end loop;
elsif
Length > 32
then
Put_Line (Target, "Wide_Wide_Character'Val (" &Integer'Image(Current) &") =>");
Put (Target, "(");
for Y in 1 .. 16
loop
Put_Line (Target, Y'Img &" =>");
Put (Target, "(");
for X in 1 .. 8
loop
Put (Target, Dot &", ");
end loop;
for X in 9 .. 16
loop
if
X < 16
then
Put (Target, "False, ");
else
Put (Target, "False)");
end if;
end loop;
if
Y < 16
then
Put_Line (Target, ",");
else
Put_Line (Target, "),");
end if;
end loop;
end if;
end loop;
Close (Source);
Put_Line (Target, "others => (others => (others => False)));");
New_Line (Target);
Put_Line (Target, "Size: constant Size_Set_Type :=");
Put (Target, "(");
for N in Index_Type'Range
loop
Put (Target, "Wide_Wide_Character'Val (" &Integer'Image(N) &") =>");
Put (Target, "(" &Integer'Image(Size(N).Y) &", " &Integer'Image(Size(N).X) &")");
if
N < Index_Type'Last
then
Put_Line (Target, ",");
else
Put_Line (Target, ");");
end if;
end loop;
Put_Line (Target, "end Unifont;");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Put_Line (Target, "");
Close (Target);
end;
end Unifont_Hex_To_Ada;
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)