xolatile/xscii
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added Ada version for lulz...

Browse Source
This commit is contained in:
Ognjen Milan Robovic 2023-12-11 15:51:17 -05:00
parent a210ed1527
commit ba2a70e842
1 changed files with 185 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

185
xscii.adb Normal file
View File

@ -0,0 +1,185 @@
with ada.text_io;
use ada.text_io;
function xscii return integer is
type effect_type is (EFFECT_NORMAL, EFFECT_BOLD, EFFECT_ITALIC, EFFECT_UNDERLINE, EFFECT_BLINK, EFFECT_REVERSE);
type colour_type is (COLOUR_GREY, COLOUR_RED, COLOUR_GREEN, COLOUR_YELLOW, COLOUR_BLUE, COLOUR_PINK, COLOUR_CYAN, COLOUR_WHITE);
type short_range is mod 2 ** 5;
type long_range is mod 2 ** 7;
subtype short_string is string (1 .. 3);
subtype long_string is string (1 .. 24);
type short_code_type is array (short_range) of short_string;
type long_code_type is array (long_range) of long_string;
CHARACTER_ESCAPE : constant character := character'val (27);
procedure put_align (count : natural := 0;
align : character := ' ') is
begin
for index in 1 .. count
loop
put (align);
end loop;
end put_align;
procedure put_colour (colour : colour_type := COLOUR_WHITE;
effect : effect_type := EFFECT_NORMAL) is
format : string (1 .. 6) := "[-;3-m";
begin
case effect is
when EFFECT_NORMAL => format (2) := '0';
when EFFECT_BOLD => format (2) := '1';
when EFFECT_ITALIC => format (2) := '3';
when EFFECT_UNDERLINE => format (2) := '4';
when EFFECT_BLINK => format (2) := '5';
when EFFECT_REVERSE => format (2) := '7';
when others => format (2) := '0';
end case;
case colour is
when COLOUR_GREY => format (5) := '0';
when COLOUR_RED => format (5) := '1';
when COLOUR_GREEN => format (5) := '2';
when COLOUR_YELLOW => format (5) := '3';
when COLOUR_BLUE => format (5) := '4';
when COLOUR_PINK => format (5) := '5';
when COLOUR_CYAN => format (5) := '6';
when COLOUR_WHITE => format (5) := '7';
when others => format (5) := '7';
end case;
put (CHARACTER_ESCAPE & format);
end put_colour;
procedure put_cancel is
begin
put (CHARACTER_ESCAPE & "[0m");
end put_cancel;
procedure put_bar is
begin
put_colour (COLOUR_GREY, EFFECT_BOLD);
put (" | ");
put_cancel;
end put_bar;
procedure put_base (code : long_range := 0;
base : natural := 0;
count : natural := 0;
align : character := ' ';
colour : colour_type := COLOUR_WHITE;
effect : effect_type := EFFECT_NORMAL) is
digit_array : string (1 .. 16) := "0123456789ABCDEF";
format : string (1 .. 16) := " ";
length : natural := 1;
modify : natural := natural (code);
begin
put_bar;
put_colour (colour, effect);
if code = 0 then
put_align (count - 1, align);
put ("0");
put_cancel;
return;
end if;
while modify > 0
loop
format (length) := digit_array ((modify mod base) + 1);
length := length + 1;
modify := modify / base;
end loop;
put_align (count - length + 1, align);
while length > 1
loop
put (format (length - 1));
length := length - 1;
end loop;
put_cancel;
end put_base;
procedure put_code (code : long_range := 0;
colour : colour_type := COLOUR_WHITE;
effect : effect_type := EFFECT_NORMAL) is
code_name : constant short_code_type := (
"NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", "BS ", "HT ", "LF ", "VT ", "FF ", "CR ", "SO ", "SI ",
"DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", "CAN", "EM ", "SUB", "ESC", "FS ", "GS ", "RS ", "US "
);
begin
put_bar;
put_colour (colour, effect);
if code = 2 ** 7 - 1 then
put ("DEL");
put_cancel;
return;
end if;
if code < 2 ** 5 then
put (code_name (short_range (code)));
else
put (character'val (natural (code)));
put (" ");
end if;
put_cancel;
end put_code;
procedure put_name (code : long_range := 0;
colour : colour_type := COLOUR_WHITE;
effect : effect_type := EFFECT_NORMAL) is
code_name : constant long_code_type := (
"Null ", "Start of heading ", "Start of text ", "End of text ",
"End of transmission ", "Enquiry ", "Acknowledge ", "Bell ",
"Backspace ", "Horizontal tab ", "Line feed ", "Vertical tab ",
"Form feed ", "Carriage return ", "Shift out ", "Shift in ",
"Data link escape ", "Device control 1 ", "Device control 2 ", "Device control 3 ",
"Device control 4 ", "Negative acknowledge ", "Synchronous idle ", "End transmission block ",
"Cancel ", "End of medium ", "Substitute ", "Escape ",
"File separator ", "Group separator ", "Record separator ", "Unit separator ",
"Space ", "Exclamation mark ", "Speech mark ", "Number sign ",
"Dollar sign ", "Percent ", "Ampersand ", "Quote ",
"Open parenthesis ", "Close parenthesis ", "Asterisk ", "Plus ",
"Comma ", "Minus ", "Period ", "Slash ",
"Zero ", "One ", "Two ", "Three ",
"Four ", "Five ", "Six ", "Seven ",
"Eight ", "Nine ", "Colon ", "Semicolon ",
"Open angled bracket ", "Equal ", "Close angled bracket ", "Question mark ",
"At sign ", "Uppercase A ", "Uppercase B ", "Uppercase C ",
"Uppercase D ", "Uppercase E ", "Uppercase F ", "Uppercase G ",
"Uppercase H ", "Uppercase I ", "Uppercase J ", "Uppercase K ",
"Uppercase L ", "Uppercase M ", "Uppercase N ", "Uppercase O ",
"Uppercase P ", "Uppercase Q ", "Uppercase R ", "Uppercase S ",
"Uppercase T ", "Uppercase U ", "Uppercase V ", "Uppercase W ",
"Uppercase X ", "Uppercase Y ", "Uppercase Z ", "Opening bracket ",
"Backslash ", "Closing bracket ", "Caret ", "Underscore ",
"Grave ", "Lowercase a ", "Lowercase b ", "Lowercase c ",
"Lowercase d ", "Lowercase e ", "Lowercase f ", "Lowercase g ",
"Lowercase h ", "Lowercase i ", "Lowercase j ", "Lowercase k ",
"Lowercase l ", "Lowercase m ", "Lowercase n ", "Lowercase o ",
"Lowercase p ", "Lowercase q ", "Lowercase r ", "Lowercase s ",
"Lowercase t ", "Lowercase u ", "Lowercase v ", "Lowercase w ",
"Lowercase x ", "Lowercase y ", "Lowercase z ", "Opening brace ",
"Vertical bar ", "Closing brace ", "Tilde ", "Delete "
);
begin
put_bar;
put_colour (colour, effect);
put (code_name (code));
put_cancel;
end put_name;
begin
for code in long_range
loop
put_base (code, 2, 7, '0', COLOUR_WHITE, EFFECT_NORMAL);
put_base (code, 8, 3, '0', COLOUR_CYAN, EFFECT_NORMAL);
put_base (code, 10, 3, ' ', COLOUR_CYAN, EFFECT_ITALIC);
put_base (code, 16, 2, '0', COLOUR_CYAN, EFFECT_BOLD);
put_code (code, COLOUR_BLUE, EFFECT_BOLD);
put_name (code, COLOUR_PINK, EFFECT_NORMAL);
if code mod 2 = 1 then
new_line;
end if;
end loop;
return (0);
end xscii;