Finished Fortran implementation...
This commit is contained in:
parent
8215c3767e
commit
3c1f0d481a
204
xscii.f90
204
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user