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
|
program xscii
|
||||||
use vt100
|
use vt100
|
||||||
|
|
||||||
implicit none
|
integer :: code = 0
|
||||||
|
|
||||||
interface
|
do while (code /= 2 ** 7)
|
||||||
subroutine print_colour (colour, effect)
|
call print_base (code, 2, 7, '0', COLOUR_WHITE, EFFECT_NORMAL)
|
||||||
character, intent (in) :: colour
|
call print_base (code, 8, 3, '0', COLOUR_CYAN, EFFECT_NORMAL)
|
||||||
character, intent (in) :: effect
|
call print_base (code, 10, 3, ' ', COLOUR_CYAN, EFFECT_ITALIC)
|
||||||
end subroutine print_colour
|
call print_base (code, 16, 2, '0', COLOUR_CYAN, EFFECT_BOLD)
|
||||||
|
call print_code (code, COLOUR_BLUE, EFFECT_BOLD)
|
||||||
subroutine print_cancel
|
call print_name (code, COLOUR_PINK, EFFECT_NORMAL)
|
||||||
end subroutine print_cancel
|
if (modulo (code, 2) /= 0) then
|
||||||
|
call print_line
|
||||||
subroutine print_bar
|
end if
|
||||||
end subroutine print_bar
|
code = code + 1
|
||||||
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
|
|
||||||
end do
|
end do
|
||||||
|
|
||||||
end program xscii
|
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)
|
subroutine print_colour (colour, effect)
|
||||||
use vt100
|
use vt100
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
character, intent (in) :: colour
|
character, intent (in) :: colour
|
||||||
character, intent (in) :: effect
|
character, intent (in) :: effect
|
||||||
character (7) :: escape
|
|
||||||
|
|
||||||
escape = char (27) // "[" // effect // ";3" // colour // "m"
|
call print_string (char (27) // "[" // effect // ";3" // colour // "m")
|
||||||
|
|
||||||
write (*, '(a)', advance='no') escape
|
|
||||||
end subroutine print_colour
|
end subroutine print_colour
|
||||||
|
|
||||||
subroutine print_cancel
|
subroutine print_cancel
|
||||||
use vt100
|
call print_string (char (27) // "[0m")
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
character (4) :: escape
|
|
||||||
|
|
||||||
escape = char (27) // "[0m"
|
|
||||||
|
|
||||||
write (*, '(a)', advance='no') escape
|
|
||||||
end subroutine print_cancel
|
end subroutine print_cancel
|
||||||
|
|
||||||
subroutine print_bar
|
subroutine print_bar
|
||||||
use vt100
|
use vt100
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
call print_colour (COLOUR_GREY, EFFECT_BOLD)
|
call print_colour (COLOUR_GREY, EFFECT_BOLD)
|
||||||
write (*, '(a)', advance='no') " | "
|
write (*, '(a)', advance='no') " | "
|
||||||
call print_cancel
|
call print_cancel
|
||||||
end subroutine print_bar
|
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