diff --git a/xscii.adb b/xscii.adb new file mode 100644 index 0000000..d29bbd2 --- /dev/null +++ b/xscii.adb @@ -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;