186 lines
8.1 KiB
Ada
186 lines
8.1 KiB
Ada
|
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;
|