diff --git a/doc/specs/stdlib_ansi_cursor.md b/doc/specs/stdlib_ansi_cursor.md new file mode 100644 index 000000000..b8a9156f5 --- /dev/null +++ b/doc/specs/stdlib_ansi_cursor.md @@ -0,0 +1,235 @@ +--- +title: ansi_cursor +--- + +# The `stdlib_ansi_cursor` module + +[TOC] + +## Introduction + +Module for cursor control using ansi terminal escape sequences + +## Constants provided by `stdlib_ascii` + +### ``esc`` + +The ESC character + + +### ``home`` + +ansi escape code to move the cursor to it's home coordinates `(0,0)` + + +### ``clear_till_screen_start`` + +ansi escape code to clear the screen till the start of the terminal + + +### ``clear_till_screen_end`` + +ansi escape code to clear the screen till the end of the terminal + + +### ``clear_completetely`` + +ansi escape code to clear the terminal screen completely + + +### ``clear_till_line_end`` + +ansi escape code to clear till the current line end + + +### ``clear_till_line_start`` + +ansi escape code to clear till the current line start + + +### ``clear_entire_line`` + +ansi escape code to clear the entire line + + + +## Procedures and methods provided + + +### `move_to` + +#### Status + +Experimental + +#### Description + +moves the cursor to the specified `line` and `column` + +#### Syntax + +`code =` [[stdlib_ansi_cursor(module):move_to(function)]] `(line, col)` + +#### Class + +Pure function. + +#### Arguments + +`line`: line (row) number to move it to + +`col`: col (column) number to move it to + +#### Return value + +a default character string + +#### Examples + +```fortran +program test + use stdlib_ansi_cursor, only: move_to + implicit none + + character(len=1) :: input + + print *, move_to(0, 0) ! Same as printing the constant `home` + read (*,*), input ! Waiting for input to actually see the effect of the `move_to` function +end program test +``` + + +### `move_to_column` + +#### Status + +Experimental + +#### Description + +moves the cursor to the specified `column` + +#### Syntax + +`code =` [[stdlib_ansi_cursor(module):move_to_column(function)]] `(col)` + +#### Class + +Pure function. + +#### Arguments + +`col`: col (column) number to move it to + +#### Return value + +a default character string + + +### `move_up` + +#### Status + +Experimental + +#### Description + +moves the cursor up by `line` lines + +#### Syntax + +`code =` [[stdlib_ansi_cursor(module):move_up(function)]] `(line)` + +#### Class + +Pure function. + +#### Arguments + +`line`: number of lines to move it above by + +#### Return value + +a default character string + + +### `move_down` + +#### Status + +Experimental + +#### Description + +moves the cursor down by `line` lines + +#### Syntax + +`code =` [[stdlib_ansi_cursor(module):move_down(function)]] `(line)` + +#### Class + +Pure function. + +#### Arguments + +`line`: number of lines to move it below by + +#### Return value + +a default character string + + +### `move_left` + +#### Status + +Experimental + +#### Description + +moves the cursor to the left by `col` columns + +#### Syntax + +`code =` [[stdlib_ansi_cursor(module):move_left(function)]] `(col)` + +#### Class + +Pure function. + +#### Arguments + +`col`: number of columns to move the cursor to the left by + +#### Return value + +a default character string + + +### `move_right` + +#### Status + +Experimental + +#### Description + +moves the cursor to the right by `col` columns + +#### Syntax + +`code =` [[stdlib_ansi_cursor(module):move_right(function)]] `(col)` + +#### Class + +Pure function. + +#### Arguments + +`col`: number of columns to move the cursor to the right by + +#### Return value + +a default character string + diff --git a/src/stdlib_ansi_cursor.f90 b/src/stdlib_ansi_cursor.f90 index 70418dc32..98eb73053 100644 --- a/src/stdlib_ansi_cursor.f90 +++ b/src/stdlib_ansi_cursor.f90 @@ -2,11 +2,18 @@ module stdlib_ansi_cursor use stdlib_strings, only: to_string implicit none + private + + public :: move_to, move_up, move_down, move_left, move_right, move_to_column + public :: esc, home, clear_till_screen_end, clear_till_screen_start, clear_completely, & + & clear_till_line_end, clear_till_line_start, clear_entire_line + + !> the ESC character character(len=*), parameter :: esc = achar(27) !> moves the cursor to home => `(0,0)` character(len=*), parameter :: home = esc//"[H" !> erases from the cursor till the end of the screen - character(len=*), parameter :: clear_till_screen_end = esc//"[OJ" + character(len=*), parameter :: clear_till_screen_end = esc//"[0J" !> erases from the cursor to the beginning of the screen character(len=*), parameter :: clear_till_screen_start = esc//"[1J" !> erases the entire screen @@ -19,8 +26,11 @@ module stdlib_ansi_cursor character(len=*), parameter :: clear_entire_line = esc//"[2K" contains + !> Version: Experimental + !> !> moves the cursor to `(line, column)` !> returns an empty string if any of them is negative + !> [Specification](../page/specs/stdlib_ansi_cursor.html#move_to) pure function move_to(line, col) result(str) integer, intent(in) :: line integer, intent(in) :: col @@ -34,8 +44,11 @@ pure function move_to(line, col) result(str) end function move_to + !> Version: Experimental + !> !> moves the cursor to column `col` !> returns an empty string if `col` is negative + !> [Specification](../page/specs/stdlib_ansi_cursor.html#move_to_column) pure function move_to_column(col) result(str) integer, intent(in) :: col character(:), allocatable :: str @@ -48,8 +61,11 @@ pure function move_to_column(col) result(str) end function move_to_column + !> Version: Experimental + !> !> moves the cursor up by `line` lines !> returns an empty string if `line` is negative + !> [Specification](../page/specs/stdlib_ansi_cursor.html#move_up) pure function move_up(line) result(str) integer, intent(in) :: line character(:), allocatable :: str @@ -62,8 +78,11 @@ pure function move_up(line) result(str) end function move_up + !> Version: Experimental + !> !> moves the cursor down by `line` lines !> returns an empty string if `line` is negative + !> [Specification](../page/specs/stdlib_ansi_cursor.html#move_down) pure function move_down(line) result(str) integer, intent(in) :: line character(:), allocatable :: str @@ -76,30 +95,36 @@ pure function move_down(line) result(str) end function move_down + !> Version: Experimental + !> !> moves the cursor right by `line` lines !> returns an empty string if `line` is negative - pure function move_right(line) result(str) - integer, intent(in) :: line + !> [Specification](../page/specs/stdlib_ansi_cursor.html#move_right) + pure function move_right(col) result(str) + integer, intent(in) :: col character(:), allocatable :: str - if (line <= 0) then + if (col <= 0) then str = "" else - str = esc//"["//to_string(line)//"C" + str = esc//"["//to_string(col)//"C" end if end function move_right + !> Version: Experimental + !> !> moves the cursor left by `line` lines !> returns an empty string if `line` is negative - pure function move_left(line) result(str) - integer, intent(in) :: line + !> [Specification](../page/specs/stdlib_ansi_cursor.html#move_left) + pure function move_left(col) result(str) + integer, intent(in) :: col character(:), allocatable :: str - if (line <= 0) then + if (col <= 0) then str = "" else - str = esc//"["//to_string(line)//"D" + str = esc//"["//to_string(col)//"D" end if end function move_left diff --git a/test/terminal/test_ansi_cursor.f90 b/test/terminal/test_ansi_cursor.f90 index 4f916c029..c4f6f3a31 100644 --- a/test/terminal/test_ansi_cursor.f90 +++ b/test/terminal/test_ansi_cursor.f90 @@ -24,11 +24,21 @@ subroutine test_move_to(error) str = move_to(-10, 20) call check(error, str, "") - if (allocated(error)) return + if (allocated(error)) then + print *, "ERROR: move_to fails with negative values" + return + end if str = move_to(10, 20) call check(error, iachar(str(1:1)), 27) - if (allocated(error)) return + if (allocated(error)) then + print *, "ERROR: move_to doesn't add ESC character at the beggining" + return + end if call check(error, str(2:), "[10;20H") + if (allocated(error)) then + print *, "ERROR: move_to logically failed" + return + end if end subroutine test_move_to subroutine test_move_direction(error) @@ -38,11 +48,21 @@ subroutine test_move_direction(error) str = move_up(-15) call check(error, str, "") - if (allocated(error)) return + if (allocated(error)) then + print *, "ERROR: move_up fails with negative values" + return + end if str = move_up(15) call check(error, iachar(str(1:1)), 27) - if (allocated(error)) return + if (allocated(error)) then + print *, "ERROR: move_up doesn't add ESC character at the beggining" + return + end if call check(error, str(2:), "[15A") + if (allocated(error)) then + print *, "ERROR: move_up logically failed" + return + end if end subroutine test_move_direction subroutine test_move_to_column(error) @@ -52,11 +72,21 @@ subroutine test_move_to_column(error) str = move_to_column(-5) call check(error, str, "") - if (allocated(error)) return + if (allocated(error)) then + print *, "ERROR: move_to_column fails with negative values" + return + end if str = move_to_column(5) call check(error, iachar(str(1:1)), 27) - if (allocated(error)) return + if (allocated(error)) then + print *, "ERROR: move_to_column doesn't add ESC character at the beggining" + return + end if call check(error, str(2:), "[5G") + if (allocated(error)) then + print *, "ERROR: move_to_column logically fails" + return + end if end subroutine test_move_to_column end module test_cursor