From a8644ca3a80da474e2d7d92d04623587485cf9b9 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Tue, 12 Nov 2024 22:04:27 +0530 Subject: [PATCH 1/4] Add additional terminal escape sequences for cursor actions to expand the stdlib_ansi module --- src/CMakeLists.txt | 5 +- src/stdlib_ansi_cursor.f90 | 107 +++++++++++++++++++++++++++++ test/terminal/CMakeLists.txt | 1 + test/terminal/test_ansi_cursor.f90 | 90 ++++++++++++++++++++++++ 4 files changed, 201 insertions(+), 2 deletions(-) create mode 100644 src/stdlib_ansi_cursor.f90 create mode 100644 test/terminal/test_ansi_cursor.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index ff9f39417..bb7c808d7 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -28,13 +28,13 @@ set(fppFiles stdlib_linalg_kronecker.fypp stdlib_linalg_cross_product.fypp stdlib_linalg_eigenvalues.fypp - stdlib_linalg_solve.fypp + stdlib_linalg_solve.fypp stdlib_linalg_determinant.fypp stdlib_linalg_qr.fypp stdlib_linalg_inverse.fypp stdlib_linalg_norms.fypp stdlib_linalg_state.fypp - stdlib_linalg_svd.fypp + stdlib_linalg_svd.fypp stdlib_linalg_cholesky.fypp stdlib_optval.fypp stdlib_selection.fypp @@ -108,6 +108,7 @@ set(SRC stdlib_ansi.f90 stdlib_ansi_operator.f90 stdlib_ansi_to_string.f90 + stdlib_ansi_cursor.f90 stdlib_array.f90 stdlib_codata.f90 stdlib_error.f90 diff --git a/src/stdlib_ansi_cursor.f90 b/src/stdlib_ansi_cursor.f90 new file mode 100644 index 000000000..7e6f182e5 --- /dev/null +++ b/src/stdlib_ansi_cursor.f90 @@ -0,0 +1,107 @@ +module stdlib_ansi_cursor + use stdlib_strings, only: to_string + implicit none + + 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" + !> erases from the cursor to the beginning of the screen + character(len=*), parameter :: clear_till_screen_start = esc//"[1J" + !> erases the entire screen + character(len=*), parameter :: clear_completely = esc//"[2J" + !> erases from the cursor till the end of line + character(len=*), parameter :: clear_till_line_end = esc//"[0K" + !> erases from the cursor till the beginning of the line + character(len=*), parameter :: clear_till_line_start = esc//"[1K" + !> erases the entire line + character(len=*), parameter :: clear_entire_line = esc//"[2K" + +contains + !> moves the cursor to `(line, column)` + !> returns an empty string if any of them is negative + pure function move_to(line, col) result(str) + integer, intent(in) :: line + integer, intent(in) :: col + character(:), allocatable :: str + + if (line < 0 .or. col < 0) then + str = "" + else + str = esc//"["//to_string(line)//";"//to_string(col)//"H" + end if + + end function move_to + + !> moves the cursor to column `col` + !> returns an empty string if `col` is negative + pure function move_to_column(col) result(str) + integer, intent(in) :: col + character(:), allocatable :: str + + if (col < 0) then + str = "" + else + str = esc//"["//to_string(col)//"G" + end if + + end function move_to_column + + !> moves the cursor up by `line` lines + !> returns an empty string if `line` is negative + pure function move_up(line) result(str) + integer, intent(in) :: line + character(:), allocatable :: str + + if (line <= 0) then + str = "" + else + str = esc//"["//to_string(line)//"A" + end if + + end function move_up + + !> moves the cursor down by `line` lines + !> returns an empty string if `line` is negative + pure function move_down(line) result(str) + integer, intent(in) :: line + character(:), allocatable :: str + + if (line <= 0) then + str = "" + else + str = esc//"["//to_string(line)//"A" + end if + + end function move_down + + !> 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 + character(:), allocatable :: str + + if (line <= 0) then + str = "" + else + str = esc//"["//to_string(line)//"A" + end if + + end function move_right + + !> 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 + character(:), allocatable :: str + + if (line <= 0) then + str = "" + else + str = esc//"["//to_string(line)//"A" + end if + + end function move_left + +end module stdlib_ansi_cursor diff --git a/test/terminal/CMakeLists.txt b/test/terminal/CMakeLists.txt index 11b6c654c..5cfbe410d 100644 --- a/test/terminal/CMakeLists.txt +++ b/test/terminal/CMakeLists.txt @@ -1 +1,2 @@ ADDTEST(colors) +ADDTEST(ansi_cursor) diff --git a/test/terminal/test_ansi_cursor.f90 b/test/terminal/test_ansi_cursor.f90 new file mode 100644 index 000000000..4f916c029 --- /dev/null +++ b/test/terminal/test_ansi_cursor.f90 @@ -0,0 +1,90 @@ +module test_cursor + use stdlib_ansi_cursor, only: move_to, move_up, move_to_column + use testdrive, only: new_unittest, unittest_type, error_type, check + implicit none + +contains + + !> Collect all exported unit tests + subroutine collect_cursor_tests(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("move_to", test_move_to), & + new_unittest("move_", test_move_direction), & + new_unittest("move_to_column", test_move_to_column) & + ] + end subroutine collect_cursor_tests + + subroutine test_move_to(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + character(len=:), allocatable :: str + + str = move_to(-10, 20) + call check(error, str, "") + if (allocated(error)) return + str = move_to(10, 20) + call check(error, iachar(str(1:1)), 27) + if (allocated(error)) return + call check(error, str(2:), "[10;20H") + end subroutine test_move_to + + subroutine test_move_direction(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + character(len=:), allocatable :: str + + str = move_up(-15) + call check(error, str, "") + if (allocated(error)) return + str = move_up(15) + call check(error, iachar(str(1:1)), 27) + if (allocated(error)) return + call check(error, str(2:), "[15A") + end subroutine test_move_direction + + subroutine test_move_to_column(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + character(len=:), allocatable :: str + + str = move_to_column(-5) + call check(error, str, "") + if (allocated(error)) return + str = move_to_column(5) + call check(error, iachar(str(1:1)), 27) + if (allocated(error)) return + call check(error, str(2:), "[5G") + end subroutine test_move_to_column + +end module test_cursor + +program tester + use, intrinsic :: iso_fortran_env, only: error_unit + use test_cursor, only: collect_cursor_tests + use testdrive, only: run_testsuite, new_testsuite, testsuite_type + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("cursor ansi codes", collect_cursor_tests) & + ] + + do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if + +end program tester + From 26b010d37774cace7ee69cd32d14bb61072aa1f4 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Tue, 12 Nov 2024 22:46:31 +0530 Subject: [PATCH 2/4] Fix silly typo --- src/stdlib_ansi_cursor.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_ansi_cursor.f90 b/src/stdlib_ansi_cursor.f90 index 7e6f182e5..70418dc32 100644 --- a/src/stdlib_ansi_cursor.f90 +++ b/src/stdlib_ansi_cursor.f90 @@ -71,7 +71,7 @@ pure function move_down(line) result(str) if (line <= 0) then str = "" else - str = esc//"["//to_string(line)//"A" + str = esc//"["//to_string(line)//"B" end if end function move_down @@ -85,7 +85,7 @@ pure function move_right(line) result(str) if (line <= 0) then str = "" else - str = esc//"["//to_string(line)//"A" + str = esc//"["//to_string(line)//"C" end if end function move_right @@ -99,7 +99,7 @@ pure function move_left(line) result(str) if (line <= 0) then str = "" else - str = esc//"["//to_string(line)//"A" + str = esc//"["//to_string(line)//"D" end if end function move_left From 097d10c199f76600570dd29763ba14c1287759f7 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Mon, 18 Nov 2024 09:48:26 +0530 Subject: [PATCH 3/4] fixed typo, added specs for stdlib_ansi_cursor, added helpful error messages to tests, small fixes --- doc/specs/stdlib_ansi_cursor.md | 235 +++++++++++++++++++++++++++++ src/stdlib_ansi_cursor.f90 | 43 ++++-- test/terminal/test_ansi_cursor.f90 | 42 +++++- 3 files changed, 305 insertions(+), 15 deletions(-) create mode 100644 doc/specs/stdlib_ansi_cursor.md 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 From f21a9648a7e6e354697def6cf2b0e628e65b5827 Mon Sep 17 00:00:00 2001 From: "supritsj@Arch" Date: Mon, 18 Nov 2024 17:19:41 +0530 Subject: [PATCH 4/4] typo fixes, small documentation changes and added an example --- doc/specs/stdlib_ansi_cursor.md | 12 ++++++-- example/CMakeLists.txt | 1 + example/terminal/CMakeLists.txt | 1 + example/terminal/example_ansi_cursor.f90 | 36 ++++++++++++++++++++++++ src/stdlib_ansi_cursor.f90 | 18 ++++++------ test/terminal/test_ansi_cursor.f90 | 6 ++-- 6 files changed, 59 insertions(+), 15 deletions(-) create mode 100644 example/terminal/CMakeLists.txt create mode 100644 example/terminal/example_ansi_cursor.f90 diff --git a/doc/specs/stdlib_ansi_cursor.md b/doc/specs/stdlib_ansi_cursor.md index b8a9156f5..3b95c3b0c 100644 --- a/doc/specs/stdlib_ansi_cursor.md +++ b/doc/specs/stdlib_ansi_cursor.md @@ -10,7 +10,7 @@ title: ansi_cursor Module for cursor control using ansi terminal escape sequences -## Constants provided by `stdlib_ascii` +## Constants provided by `stdlib_ansi_cursor` ### ``esc`` @@ -19,7 +19,7 @@ The ESC character ### ``home`` -ansi escape code to move the cursor to it's home coordinates `(0,0)` +ansi escape code to move the cursor to it's home coordinates `(1,1)` ### ``clear_till_screen_start`` @@ -93,11 +93,17 @@ program test character(len=1) :: input - print *, move_to(0, 0) ! Same as printing the constant `home` + print *, move_to(1, 1) ! Same as printing the constant `home` read (*,*), input ! Waiting for input to actually see the effect of the `move_to` function end program test ``` +A more detailed example of drawing a blue box in a terminal + +```fortran +{!example/terminal/example_ansi_cursor.f90!} +``` + ### `move_to_column` diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index cbef7f075..4c87a2cf1 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -31,3 +31,4 @@ add_subdirectory(stringlist_type) add_subdirectory(strings) add_subdirectory(string_type) add_subdirectory(version) +add_subdirectory(terminal) diff --git a/example/terminal/CMakeLists.txt b/example/terminal/CMakeLists.txt new file mode 100644 index 000000000..2b2f85f53 --- /dev/null +++ b/example/terminal/CMakeLists.txt @@ -0,0 +1 @@ +ADD_EXAMPLE(ansi_cursor) diff --git a/example/terminal/example_ansi_cursor.f90 b/example/terminal/example_ansi_cursor.f90 new file mode 100644 index 000000000..36b8b1573 --- /dev/null +++ b/example/terminal/example_ansi_cursor.f90 @@ -0,0 +1,36 @@ +program ansi_cursor + use stdlib_ansi_cursor, only: move_to, clear_completely + use stdlib_ansi, only: fg_color_blue, to_string + implicit none + + character(len=1) :: input + character(len=*), parameter :: delim = "#" + + print *, clear_completely + print *, to_string(fg_color_blue) ! The box will be blue now + + call draw_box(10, 38, 77, 17, delim) + + ! read *, input ! Waiting for input to actually see the box drawn + +contains + !> Draws a box on the terminal of `width` width and `height` height + !> The topmost left vertex of the box is at `(line,col)` + subroutine draw_box(line, col, width, height, char) + integer, intent(in) :: line, col, width, height + character(len=1), intent(in) :: char + integer :: i + + do i = 0, width - 1 + write (*, "(a,a)", advance="NO") move_to(line, col + i), char + write (*, "(a,a)", advance="NO") move_to(line + height - 1, col + i), char + end do + + do i = 0, height - 1 + write (*, "(a,a)", advance="NO") move_to(line + i, col), char + write (*, "(a,a)", advance="NO") move_to(line + i, col + width - 1), char + end do + + end subroutine draw_box + +end program ansi_cursor diff --git a/src/stdlib_ansi_cursor.f90 b/src/stdlib_ansi_cursor.f90 index 98eb73053..62c7bcf79 100644 --- a/src/stdlib_ansi_cursor.f90 +++ b/src/stdlib_ansi_cursor.f90 @@ -10,7 +10,7 @@ module stdlib_ansi_cursor !> the ESC character character(len=*), parameter :: esc = achar(27) - !> moves the cursor to home => `(0,0)` + !> moves the cursor to home => `(1,1)` character(len=*), parameter :: home = esc//"[H" !> erases from the cursor till the end of the screen character(len=*), parameter :: clear_till_screen_end = esc//"[0J" @@ -29,14 +29,14 @@ module stdlib_ansi_cursor !> Version: Experimental !> !> moves the cursor to `(line, column)` - !> returns an empty string if any of them is negative + !> returns an empty string if any of them is negative or zero !> [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 character(:), allocatable :: str - if (line < 0 .or. col < 0) then + if (line <= 0 .or. col <= 0) then str = "" else str = esc//"["//to_string(line)//";"//to_string(col)//"H" @@ -47,13 +47,13 @@ end function move_to !> Version: Experimental !> !> moves the cursor to column `col` - !> returns an empty string if `col` is negative + !> returns an empty string if `col` is negative or zero !> [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 - if (col < 0) then + if (col <= 0) then str = "" else str = esc//"["//to_string(col)//"G" @@ -64,7 +64,7 @@ end function move_to_column !> Version: Experimental !> !> moves the cursor up by `line` lines - !> returns an empty string if `line` is negative + !> returns an empty string if `line` is negative or zero !> [Specification](../page/specs/stdlib_ansi_cursor.html#move_up) pure function move_up(line) result(str) integer, intent(in) :: line @@ -81,7 +81,7 @@ end function move_up !> Version: Experimental !> !> moves the cursor down by `line` lines - !> returns an empty string if `line` is negative + !> returns an empty string if `line` is negative or zero !> [Specification](../page/specs/stdlib_ansi_cursor.html#move_down) pure function move_down(line) result(str) integer, intent(in) :: line @@ -98,7 +98,7 @@ end function move_down !> Version: Experimental !> !> moves the cursor right by `line` lines - !> returns an empty string if `line` is negative + !> returns an empty string if `line` is negative or zero !> [Specification](../page/specs/stdlib_ansi_cursor.html#move_right) pure function move_right(col) result(str) integer, intent(in) :: col @@ -115,7 +115,7 @@ end function move_right !> Version: Experimental !> !> moves the cursor left by `line` lines - !> returns an empty string if `line` is negative + !> returns an empty string if `line` is negative or zero !> [Specification](../page/specs/stdlib_ansi_cursor.html#move_left) pure function move_left(col) result(str) integer, intent(in) :: col diff --git a/test/terminal/test_ansi_cursor.f90 b/test/terminal/test_ansi_cursor.f90 index c4f6f3a31..a07d7a64d 100644 --- a/test/terminal/test_ansi_cursor.f90 +++ b/test/terminal/test_ansi_cursor.f90 @@ -31,7 +31,7 @@ subroutine test_move_to(error) str = move_to(10, 20) call check(error, iachar(str(1:1)), 27) if (allocated(error)) then - print *, "ERROR: move_to doesn't add ESC character at the beggining" + print *, "ERROR: move_to doesn't add ESC character at the beginning" return end if call check(error, str(2:), "[10;20H") @@ -55,7 +55,7 @@ subroutine test_move_direction(error) str = move_up(15) call check(error, iachar(str(1:1)), 27) if (allocated(error)) then - print *, "ERROR: move_up doesn't add ESC character at the beggining" + print *, "ERROR: move_up doesn't add ESC character at the beginning" return end if call check(error, str(2:), "[15A") @@ -79,7 +79,7 @@ subroutine test_move_to_column(error) str = move_to_column(5) call check(error, iachar(str(1:1)), 27) if (allocated(error)) then - print *, "ERROR: move_to_column doesn't add ESC character at the beggining" + print *, "ERROR: move_to_column doesn't add ESC character at the beginning" return end if call check(error, str(2:), "[5G")