From 3c1f0d481ad16a0e0795d0ceeb0ae1fce11cd945 Mon Sep 17 00:00:00 2001 From: xolatile Date: Mon, 11 Dec 2023 19:47:09 -0500 Subject: [PATCH] Finished Fortran implementation... --- xscii.f90 | 204 ++++++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 160 insertions(+), 44 deletions(-) diff --git a/xscii.f90 b/xscii.f90 index 34fb90c..0047da7 100644 --- a/xscii.f90 +++ b/xscii.f90 @@ -18,69 +18,185 @@ end module vt100 program xscii use vt100 - implicit none + integer :: code = 0 - interface - subroutine print_colour (colour, effect) - character, intent (in) :: colour - character, intent (in) :: effect - end subroutine print_colour - - subroutine print_cancel - end subroutine print_cancel - - subroutine print_bar - end subroutine print_bar - end interface - - integer :: i - - call print_colour (COLOUR_BLUE, EFFECT_BOLD) - write (*, '(a)', advance='no') "Heyo!" - call print_cancel - print * - - call print_bar - print * - - do i = 1, 10 - print *, "> ", i + do while (code /= 2 ** 7) + call print_base (code, 2, 7, '0', COLOUR_WHITE, EFFECT_NORMAL) + call print_base (code, 8, 3, '0', COLOUR_CYAN, EFFECT_NORMAL) + call print_base (code, 10, 3, ' ', COLOUR_CYAN, EFFECT_ITALIC) + call print_base (code, 16, 2, '0', COLOUR_CYAN, EFFECT_BOLD) + call print_code (code, COLOUR_BLUE, EFFECT_BOLD) + call print_name (code, COLOUR_PINK, EFFECT_NORMAL) + if (modulo (code, 2) /= 0) then + call print_line + end if + code = code + 1 end do - end program xscii +subroutine print_line + print * +end subroutine print_line + +subroutine print_letter (letter) + character, intent (in) :: letter + + write (*, '(a)', advance='no') letter +end subroutine print_letter + +subroutine print_string (string) + character (len=*), intent (in) :: string + + write (*, '(a)', advance='no') string +end subroutine print_string + +subroutine print_align (limit, align) + integer, intent (in) :: limit + character, intent (in) :: align + + do i = 1, limit + call print_string (align) + end do +end subroutine print_align + subroutine print_colour (colour, effect) use vt100 - implicit none - character, intent (in) :: colour character, intent (in) :: effect - character (7) :: escape - escape = char (27) // "[" // effect // ";3" // colour // "m" - - write (*, '(a)', advance='no') escape + call print_string (char (27) // "[" // effect // ";3" // colour // "m") end subroutine print_colour subroutine print_cancel - use vt100 - - implicit none - - character (4) :: escape - - escape = char (27) // "[0m" - - write (*, '(a)', advance='no') escape + call print_string (char (27) // "[0m") end subroutine print_cancel subroutine print_bar use vt100 - implicit none - call print_colour (COLOUR_GREY, EFFECT_BOLD) write (*, '(a)', advance='no') " | " call print_cancel end subroutine print_bar + +subroutine print_base (code, base, limit, align, colour, effect) + use vt100 + + integer, intent (in) :: code + integer, intent (in) :: base + integer, intent (in) :: limit + character, intent (in) :: align + character, intent (in) :: colour + character, intent (in) :: effect + + character (16) :: cypher + character (16) :: output + integer :: length + integer :: modify + + cypher = "0123456789ABCDEF" + output = " " + length = 1 + modify = code + call print_bar + call print_colour (colour, effect) + if (modify == 0) then + call print_align (limit - 1, align) + call print_string ("0") + call print_cancel + return + end if + do while (modify /= 0) + i = modulo (modify, base) + 1 + output (length : length) = cypher (i : i) + length = length + 1 + modify = modify / base + end do + call print_align (limit - length + 1, align) + do while (length /= 1) + call print_letter (output (length - 1 : length - 1)) + length = length - 1 + end do + call print_cancel +end subroutine print_base; + +subroutine print_code (code, colour, effect) + use vt100 + + integer, intent (in) :: code + character, intent (in) :: colour + character, intent (in) :: effect + + character (3), dimension (32) :: code_name + + code_name = [ & + "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 " & + ] + + call print_bar + call print_colour (colour, effect) + if (code == 2 ** 7 - 1) then + call print_string ("DEL") + call print_cancel + return + end if + if (code <= 2 ** 5 - 1) then + call print_string (code_name (code + 1)) + else + call print_letter (char (code)) + call print_string (" ") + end if + call print_cancel +end subroutine print_code + +subroutine print_name (code, colour, effect) + use vt100 + + integer, intent (in) :: code + character, intent (in) :: colour + character, intent (in) :: effect + + character (24), dimension (128) :: code_name + + code_name = [ & + "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 " & + ] + + call print_bar + call print_colour (colour, effect) + call print_string (code_name (code + 1)) + call print_cancel +end subroutine print_name