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;