Text Cursor Library Routines in SilverFrost F95

(c) 2015 by Barton Paul Levenson

Language:
Fortran

Dialect:
SilverFrost F95 Express

Discussion:
This module contains a complete set of routines for controlling the text cursor in SilverFrost F95 Express. Note the updates to the Fortran "locate" routine elsewhere on this web site. The cursorOff and cursorOn routines are new.

!---
! fCursor holds routines to manipulate the text cursor in Silverfrost
! Fortran 95.
!---
module fCursor
    implicit none



    type consoleCursorInfo
        integer :: dwSize
        logical :: bVisible
    end type consoleCursorInfo



contains
    ! cls
    ! cursorOff
    ! cursorOn
    
    ! locate
    ! putd
    ! puti
    
    ! puts
    ! str
    ! uPause



    ! cls clears the screen and homes the cursor.
    subroutine cls()
        call SYSTEM('cls')
    end subroutine cls



    ! cursorOff hides the text cursor.
    subroutine cursorOff
        include 'win32api.ins'          	! Routines.
        include 'win32prm.ins'          	! Constants.

        type(consoleCursorInfo) :: cInfo	! Cursor information.
        integer :: handleForConsole     	! From GetStdHandle routine.

        handleForConsole = GetStdHandle(STD_OUTPUT_HANDLE);
        cInfo%dwSize = 1
        cInfo%bVisible = .false.
        call SetConsoleCursorInfo(handleForConsole, cInfo)
    end subroutine cursorOff



    ! cursorOn makes the text cursor visible.
    subroutine cursorOn
        include 'win32api.ins'          	! Routines.
        include 'win32prm.ins'          	! Constants.

        type(consoleCursorInfo) :: cInfo	! Cursor information.
        integer :: handleForConsole     	! From GetStdHandle routine.

	handleForConsole = GetStdHandle(STD_OUTPUT_HANDLE);
	cInfo%dwSize = 10
        cInfo%bVisible = .true.
        call SetConsoleCursorInfo(handleForConsole, cInfo)
    end subroutine cursorOn
    
    
    
    ! locate does the Windows-API-related work of moving the text cursor.
    subroutine locate(row, col)
    	implicit none
        
        integer, intent(in) :: row			! On screen, 0-24.
        integer, intent(in) :: col			! On screen, 0-79.

        integer :: coord                	! Composite value (row, column).
        integer :: handleForConsole     	! From GetStdHandle routine.

        include 'win32api.ins'          	! Routines.
        include 'win32prm.ins'          	! Constants.

        coord = 65536 * (row-1) + (col-1)  	! Jam both values in one integer.
        handleForConsole = GetStdHandle(STD_OUTPUT_HANDLE)

        call SetConsoleCursorPosition(handleForConsole, coord)
    end subroutine locate
    
    
    
    ! putd writes a real number at row r, column c.
    subroutine putd(r, c, x, w, dec)
        implicit none
        integer, parameter  :: dbl = selected_real_kind(p=15)
        integer, intent(in) :: r, c
        real(dbl) :: x
        integer, intent(in) :: w, dec
        character(10) :: fmt
        
        fmt = '(f'//trim(str(w))//'.'//trim(str(dec))//')'
        call locate(r, c)
        write(*, fmt) x
    end subroutine putd
    
    
    
    ! puti writes an integer at row r, column c.
    subroutine puti(r, c, i, w)
        implicit none
        integer, intent(in) :: r, c, i, w
        character(8) :: fmt
        
        fmt = '(i'//trim(str(w))//')'
        call locate(r, c)
        write(*, fmt) i
    end subroutine puti
    
    
    
    ! puts writes a string at row r, column c.
    subroutine puts(r, c, st)
        implicit none
        integer, intent(in) :: r, c
        character(*), intent(in) :: st
        integer      :: length
        character(8) :: fmt
        
        length = len(st)
        fmt = '(a'//trim(str(length))//')'
        call locate(r, c)        
        write(*, fmt) st
    end subroutine puts
    
    
    
    ! str converts an integer to a left-justified string.
    character(len=20) function str(i)
        implicit none
        integer, intent(in) :: i
        
        write (str, *) i
        str = adjustl(str)
    end function str
    
    

    ! uPause lets the user read before going on.
    subroutine uPause
        implicit none
        character*(1) :: ans
    
        call locate(25, 1)
        write(*, '(''g + [Enter] to go on.  '', $)')
        read (*, *) ans
    end subroutine uPause
end module fCursor