!=====================================================================
! NGWK: Workstation dependent, invoking C procedures, Fortran routines
!=====================================================================
!
! A. Graphics Outputs
!
! B. Binary Stream I/O
!
! C. System Utilities
!
! D. Console Keyboard
!
! E. Console Screen
!
! F. Digitizer
!
!---------------------------------------------------------------------
!
! A. Graphics Outputs
!
! SUBROUTINE NG_OPNWIN ! Open/Set graphics window NG output
! SUBROUTINE NG_CLSWIN ! Close graphics window
!
! SUBROUTINE NG_SETWIN ! Set graphics window parameters (locally)
!
! SUBROUTINE NG_WINCSR ! Inking mouse and keyboard
!
! ----------
!
! SUBROUTINE NG_OPNPS ! Open/Set postscript NG output
! SUBROUTINE NG_CLSPS ! Close postscript
!
! SUBROUTINE NG_SETPS ! Set postscript parameters (locally)
!
! ----------
!
! SUBROUTINE NG_GIFWIN ! Encode window graphics to GIF87a format single image
! SUBROUTINE NG_WINGIF ! Decode GIF87a format single image to window graphics (GIF image player)
!
! SUBROUTINE NG_GIFPIX ! Encode pixelmap array to GIF87a format single image
! SUBROUTINE NG_PIXGIF ! Decode GIF87a format single image to pixelmap array
!
! SUBROUTINE NG_MOVPIX ! Encode pixelmap arrays to GIF89a format animated movie
! SUBROUTINE NG_PIXMOV ! Decode GIF97a/GIF89a animated movie to pixelmap arrays
!
! SUBROUTINE NG_WINPIX ! Put pixel image to graphics window
!
!---------------------------------------
!
! B. Binary Stream I/O
!
! SUBROUTINE NG_BSSIZE ! Get file size (bytes)
! SUBROUTINE NG_BSUNIT ! Get free unit number
!
! SUBROUTINE NG_BSOPEN ! Open file
! SUBROUTINE NG_BSCLFI ! Close file
!
! SUBROUTINE NG_BSSEEK ! Position the indicator
!
! SUBROUTINE NG_BSRDFL ! Read in FLOATs (REALs)
! SUBROUTINE NG_BSRDIN ! Read in ITNREFERs
! SUBROUTINE NG_BSRDCH ! Read in CHARACTERs
! SUBROUTINE NG_BSRDI1 ! Read in BYTEs
!
! SUBROUTINE NG_BSRDFL_SCALAR ! Read in one FLOAT (REAL)
! SUBROUTINE NG_BSRDIN_SCALAR ! Read in one INTEGER
! SUBROUTINE NG_BSRDCH_SCALAR ! Read in one CHARACTER
! SUBROUTINE NG_BSRDI1_SCALAR ! Read in one BYTE
!
! SUBROUTINE NG_BSWRFL ! Write out FLOATs (REALs)
! SUBROUTINE NG_BSWRIN ! Write out ITNREFERs
! SUBROUTINE NG_BSWRCH ! Write out CHARACTERs
! SUBROUTINE NG_BSWRI1 ! Write out BYTEs
!
! SUBROUTINE NG_BSWRFL_SCALAR ! Write out one FLOAT (REAL)
! SUBROUTINE NG_BSWRIN_SCALAR ! Write out one INTEGER
! SUBROUTINE NG_BSWRCH_SCALAR ! Write out one CHARACTER
! SUBROUTINE NG_BSWRI1_SCALAR ! Write out one BYTE
!
!---------------------------------------
!
! C. System Utilities
!
! SUBROUTINE NG_GETENV ! Get environment variable
!
! SUBROUTINE NG_EXECMD ! Execute a system command or program
!
! SUBROUTINE NG_SOUNDW ! play windows .WAV sound file
! SUBROUTINE NG_BEEPMB ! sound the motherboard spearker
!
! SUBROUTINE NG_ARGNUM ! Get number of arguments of program
! SUBROUTINE NG_GETARG ! Get a argument of program
! SUBROUTINE NG_GETCMD ! Get entire command of program
!
! SUBROUTINE NG_SLEEP1 ! Suspend execution for specified duration time
! SUBROUTINE NG_SLEEP2 ! Suspend execution until specified wake-up time is up
!
! SUBROUTINE NG_GQDATE ! Inquire current date information
! SUBROUTINE NG_GQTIME ! Inquire current system time-of-day
!
! SUBROUTINE NG_GQUNIT ! Inquire a Fortran I/O free logical unit number (11-99)
!
!---------------------------------------
!
! D. Console Keyboard
!
! SUBROUTINE NG_KEYHIT ! check the struk of a key
! SUBROUTINE NG_KEYGET ! wait until a key pressed, and return its codes and name optionally
! SUBROUTINE NG_KEYCLR ! clear keyboard buffer
!
! SUBROUTINE NG_KEYASC ! wait until one of printable keys (ASCII=32-126) pressed
! SUBROUTINE NG_KEY123 ! wait until one of numeric keys pressed
! SUBROUTINE NG_KEYABC ! wait until one of caracter keys pressed
! SUBROUTINE NG_KEYFUN ! wait until one of function keys pressed
! SUBROUTINE NG_KEYDIR ! wait until one of direction keys pressed
!
!---------------------------------------
!
! E. Console Screen
!
! SUBROUTINE NG_SCNRST ! Reset screen attribute to initial state
!
! SUBROUTINE NG_SCNCLR ! Clear screen
!
! SUBROUTINE NG_SCNSET ! Set current cursor position, text colors, and cursor shape
! SUBROUTINE NG_SCNGET ! Get current cursor position, text colors, and cursor shape
!
! SUBROUTINE NG_SCNTXT ! Write text-string at current position and with current colors
! SUBROUTINE NG_SCNOUT ! Write text-string at specified position and with specified colors
!
! SUBROUTINE NG_SCNLIN ! Insert line, Remove line, or, Erase to end of line
!
! SUBROUTINE NG_SCNCOP ! Copy a rectangular section of the screen to another place
!
! SUBROUTINE NG_SCNBEW ! WIN32 Clone of Norton's Batch Enhancer by Jason Hood
!
!---------------------------------------
!
! F. Digitizer
!
! SUBROUTINE NG_DGTSCN ! Using Digitizer in console text mode
!
!=====================================================================
! A. Graphics Outputs
!=====================================================================
!
! SUBROUTINE NG_OPNWIN ! Open graphics window output
! SUBROUTINE NG_CLSWIN ! Close graphics window
!
! SUBROUTINE NG_SETWIN ! Set graphics window parameters (locally)
!
! SUBROUTINE NG_WINCSR ! Inking mouse and keyboard
!
! ----------
!
! SUBROUTINE NG_OPNPS ! Open postscript output
! SUBROUTINE NG_CLSPS ! Close postscript
!
! SUBROUTINE NG_SETPS ! Set postscript parameters (locally)
!
! ----------
!
! SUBROUTINE NG_GIFWIN ! Encode window graphics to GIF87a format single image
! SUBROUTINE NG_WINGIF ! Decode GIF87a format single image to window graphics (GIF image player)
!
! SUBROUTINE NG_GIFPIX ! Encode pixelmap array to GIF87a format single image
! SUBROUTINE NG_PIXGIF ! Decode GIF87a format single image to pixelmap array
!
! SUBROUTINE NG_MOVPIX ! Encode pixelmap arrays to GIF89a format animated movie
! SUBROUTINE NG_PIXMOV ! Decode GIF97a/GIF89a animated movie to pixelmap arrays
!
! SUBROUTINE NG_WINPIX ! Put pixel image to graphics window
!
!---------------------------------------------------------------------
!
! SUBROITINE NG_OPNWIN( SIZE, SHAPE, TITLE, BOW, SCN )
!
! REAL, INTENT(IN ), OPTIONAL :: SIZE, SHAPE
! CHARACTER(*), INTENT(IN ), OPTIONAL :: TITLE
! LOGICAL, INTENT(IN ), OPTIONAL :: BOW
! INTEGER, INTENT( OUT), OPTIONAL :: SCN(4)
!
! Routine to open/set graphics window for NG screen output.
!
! Variables:
!
! SIZE - Percentage size of graphics window relative to full screen,
! 0.0 < SIZE <= 1.0
!
! Default value is 0.9, if argument not present
!
! SHAPE - Value of width/height ratio of the graphics window
!
! Default value is 25.0/18.0, if argument not present
!
! TITLE - Character string of graphics window title
! (<= 256 characters)
!
! Default value is ' ' (blank), if argument not present
!
! BOW - Foreground/Background color flag
! = .TRUE., Black (foreground) on White (background)
! = .FALSE, White (foreground) on black (background)
!
! Default value is .FALSE., if argument not present
!
! SCN - Screen coordinates of the graphics window
! SCN = (/left, right, bottom, top/)
!
!---------------------------------------
!
! SUBROITINE NG_CLSWIN()
!
! Routine to close graphics window.
!
!---------------------------------------
!
! SUBROUTINE NG_SETWIN( SendBf )
!
! LOGICAL, INTENT(IN), OPTIONAL :: sendbf
!
! Routine to set Graphics window NG output parameters locally.
!
! Variables:
!
! SendBf - Whether or not sending buffered graphics output to window
!
! .TRUE., turn on clearing the screen buffer, real-time drawing
! (send bufered graphics to screen)
!
! .FALSE., turn off clearing the screen buffer
! (buffer the graphics unitl NG_FRAME invoked)
!
! note: the default is ".FALSE." while NG_OPNWIN invoked
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_WINCSR( x, y, key )
!
! REAL, INTENT(OUT) :: x, y
! INTEGER, INTENT(OUT) :: key
!
! Routine to get no-waiting mouse and keyboard messages.
!
! Variables:
!
! x - the x position, in fractional coordinate, of the mouse is returned
!
! y - the y position, in fractional coordinate, of the mouse is returned
!
! key - the returned ASCII code for the mouse/keyboard pressed key.
! = 0, if no mouse buttom or keyboard key is pressed.
! = 1, the keyboard "left" key is pressed
! = 2, the keyboard "up" key is pressed
! = 3, the keyboard "right" key is pressed
! = 4, the keyboard "down" key is pressed
! = 5, the left mouse button is clicked
! = 6, the right mouse button is clicked.
! =-1, if an error occurred
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_OPNPS( FILE, PAGE, PorL, PSWD, PSSC, NOLW )
!
! CHARACTER(*), INTENT(IN), OPTIONAL :: FILE
! INTEGER, INTENT(IN), OPTIONAL :: PAGE, PorL
! REAL, INTENT(IN), OPTIONAL :: PSWD(4), PSSC, NOLW
!
! Routine to open/set postscript NG output
!
! Variables:
!
! FILE - User specified filename for postscript output
!
! Note: if not a valid filename (for examples, blank, or fail
! in OPEN) or argument not present, PS file will be named
! according to system date/time automatically
!
! PAGE - Paper type/size
! =1, Letter, (8.5 ,11.0 ) inch, (215.0,279.4) mm, (612.0, 792.0) PS points
! =2, A4, (8.27 ,11.69) inch, (210.0,297.0) mm, (595.0, 842.0) PS points
! =3, A3, (11.69,16.54) inch, (297.0,420.0) mm, (842.0,1190.0) PS points
! Default is 1, if argument not present or not vaild values (1,2,3)
!
! PorL - Paper orientation
! =1, Portrait
! =2, landscape
! Default is 1, if argument not present or not vaild values (1,2)
!
! PSWD - Rectangle in page (PS Window, measured in PS point coordinates)
! mapped to NGVP, the effective viewport of NG frame, in the NG_FRAME call.
! Array elements ordered in (/wdl, wdr, wdb, wdt/)
! Default (consider title above viewport) is "centered" in
! "full (if PSSC not present)" page, if argument not present or invalid
! "invalid" means wdl>=wdr, 0.0<wdl, or, wdr>pagemax, ...
!
! PSSC - Scaling factor of plot in page, if "PSWD not present"
! should be >0.0 and <=1.0, 1.0 means full (100%) page
! Default value is 1.0, if argument not present
! Note: if PSWD present, argument PSSC (if present) will be ignored
!
! NOLW - Nominal line width, >0.0
! The call NG_GSLWSC can be used to set relative linewidths.
! The scale factor supplied to NG_GSLWSC is applied to a
! default nominal line width. This nominal line width is
! implementation specific. You can control the size of
! this nominal linewidth for PostScript output.
! Default is 1.0, if argument not present
!
!---------------------------------------
!
! SUBROUTINE NG_CLSPS( )
!
! Routine to close postscript NG output
!
!---------------------------------------
!
! SUBROUTINE NG_SETPS( LineCap, LineJoin, MiterLimit, NominalLW )
!
! INTEGER, INTENT(IN), OPTIONAL :: LineCap, LineJoin
! REAL, INTENT(IN), OPTIONAL :: MiterLimit, NominalLW
!
! Routine to set linecap, linejoin, miterlimit, nominal linewidth of
! postscript NG output locally.
!
! Variables:
!
! LineCap - Shape of line ends for stroke
! 0 = butt,
! 1 = round,
! 2 = square
! Default is 1
! Note: default is 2 for "screen" draw
!
! LineJoin - Shape of corners for stroke
! 0 = miter,
! 1 = round,
! 2 = bevel
! Default is 1
!
! MiterLimit - Miter length limit, >=1.0
! Default is 10.0
!
! NominalLW - Nominal line width, >0.0
! The call GSLWSC can be used to set relative linewidths.
! The scale factor supplied to GSLWSC is applied to a
! default nominal line width. This nominal line width is
! implementation specific. You can control the size of
! this nominal linewidth for PostScript output.
! Default is 1.0
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GIFWIN( GIFfile, VPdump )
!
! CHARACTER(*), INTENT(IN), OPTIONAL :: GIFfile
! REAL, INTENT(IN), OPTIONAL :: VPdump(4)
!
! Routine to encode current window graphics to GIF imagefile.
!
! Variable:
!
! GIFfile - User specified filename for GIF imagefile
!
! Note: if not a valid filename (for examples, blank, or fail
! in OPEN) or argument not present, GIF file will be named
! according to system date/time automatically
!
! VPdump - User specified dumping area, (/xmin, xmax, ymin, ymax/),
! values measured in "fraciional" coordinates.
!
! If present, shoule be a "valid" area and "inside" the current
! NG-frame specified by the routine NG_FRSET.
!
! (a) If not present, the system default will be used
!
! (b) If prsent but not form a "valid" area, then,
! Mouse-Button-1 to rubber-banding a rectangle will be invoked
!
! (c) If prsent and valid but not "inside" current NG-frame, then,
! the "ngvp" specified by the routine NG_FRSET will be used.
!
!---------------------------------------
!
! SUBROUTINE NG_WINGIF( ListingFile, GifFilePath, express )
!
! CHARACTER(*), INTENT(IN) :: ListingFile
! CHARACTER(*), INTENT(IN), OPTIONAL :: GifFilePath
! LOGICAL, INTENT(IN), OPTIONAL :: express
!
! Routine to playing (VIEWing continuously with key/mou control) GIF files.
!
! Variables:
!
! ListingFile - The file that contains list (one file per line) of GIF
! image files to be played
!
! GifFilePath - Path of GIF image files in the list file
! Default is "current directory"
!
! express - =.TRUE., Open/Close graphic window by user
! =.FALSE., Open/Close graphic window internally
! Default is .FALSE.
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GIFPIX( rgb, nw, nh, pixel, giffile )
!
! INTEGER, INTENT(IN) :: rgb(3,256)
! INTEGER, INTENT(IN) :: nw, nh
! INTEGER, INTENT(IN) :: pixel(nw,nh)
! CHARACTER(*), INTENT(IN) :: giffile
!
! Routine to encode pixelmap array to GIF87a format single image
!
! Variables:
!
! rgb - Color palette (r,g,b) array
!
! nw, nh - Width and Height of pixel-map
!
! pixel - Color indices array of pixel-map
!
! giffile - Name of gif image file
!
!---------------------------------------
!
! SUBROUTINE NG_PIXGIF( giffile, np, pixel, nw, nh, rgb )
!
! CHARACTER(*), INTENT(IN ) :: giffile
! INTEGER, INTENT(IN ) :: np
! INTEGER, INTENT( OUT) :: pixel(np)
! INTEGER, INTENT( OUT) :: nw, nh
! INTEGER, INTENT( OUT) :: rgb(3,256)
!
! Routine to decode GIF87a format single image to pixelmap array
!
! Variables:
!
! giffile - Name of gif image file
!
! np - Size of pixel array
!
! pixel - Color indices array of pixel-map
!
! nw, nh - Width and Height of pixel-map
!
! rgb - Color palette (r,g,b) array
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_MOVPIX( colormap, nw, nh, pixel, filename, finish, transparent, delay )
!
! INTEGER, INTENT(IN) :: colormap(3,256)
! INTEGER, INTENT(IN) :: nw, nh
! INTEGER, INTENT(IN) :: pixel(nw,nh)
! CHARACTER(*), INTENT(IN) :: filename
! LOGICAL, INTENT(IN), OPTIONAL :: finish
! INTEGER, INTENT(IN), OPTIONAL :: transparent
! REAL, INTENT(IN), OPTIONAL :: delay
!
! Routine to encode raster data (pixels) to GIF format single image
! or animated movie.
!
! Variables:
!
! colormap - Color palette (r,g,b) array
!
! nw, nh - Width and Height of pixel-map
!
! pixel - Color indices array of pixel-map
!
! filename - Name of (animated) gif image file
!
! finish - If finish=.FALSE. a movie frame will be written.
! The movie is finalized when finish=.TRUE.
! Default is .TRUE., if not present
!
! transparent - Transparent background color index
! Default is "0", if not present
!
! delay - Animation delay time
! DEfault is 0.1 second, if not present
!
! Notes:
!
! 1. Original code: (bin_io.f90, gif_util.f90)
! Written by Jos Bergervoet
! https://groups.google.com/forum/#!topic/comp.lang.fortran/1I08qzrKNMY
!
! Revised by chiangtp, 2017-09-20
!
! 2. No checks for consistent colormap and pixel arrays in subsequent
! frames
!
!---------------------------------------
!
! SUBROUTINE NG_PIXMOV( filename, np, pixel, nw, nh, colormap, nc,&
! transparent, iframe, verbose )
!
! Routine to decode GIF97a/GIF89a animated movie to pixelmap arrays
!
! CHARACTER(*), INTENT(IN ) :: filename
! INTEGER, INTENT(IN ) :: np
! INTEGER, INTENT( OUT) :: pixel(np)
! INTEGER, INTENT( OUT) :: nw, nh
! INTEGER, INTENT( OUT) :: colormap(3,256)
! INTEGER, INTENT( OUT) :: nc
! INTEGER, INTENT( OUT) :: transparent
! INTEGER, INTENT( OUT) :: iframe
! LOGICAL, INTENT(IN ), OPTIONAL :: verbose
!
! Variables:
!
! filename - Name of animated gif image file
!
! np - Size of pixel array
!
! pixel - Color indices array of pixel-map
!
! nw, nh - Width and Height of iframe'th image
! (runtime error while nw*nh > np)
! return "-1", if end-of-file
!
! colormap - Color palette (r,g,b) array
!
! nc - Number of colors used for iframe'th image
! return "-1" means (local) colormap not exist
!
! transparent - Transparent background color index
! return "-1" if non-transparent
!
! iframe - Frame number
! return "-1", if end-of-file
!
! verbose - .TRUE. for verbose output, defaule is .FALSE.
!
! Notes:
!
! Original code: read_gif2.f90 cgp 2010 Aug 28
! Authors: Jos Bergervoet, Van Snyder, Maurizio Cremonesi, Clive Page,
! and others (http://fortranwiki.org/fortran/show/read_gif)
!
! Revised by chiangtp, 2017-09-24
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_WINPIX( nw, nh, pixel, ix, iy, colormap )
!
! INTEGER, INTENT(IN) :: nw, nh
! INTEGER, INTENT(IN) :: pixel(nw,nh)
! INTEGER, INTENT(IN), OPTIONAL :: ix, iy
! INTEGER, INTENT(IN), OPTIONAL :: colormap(3,256)
!
! Routine to put pixel image to graphics window
!
! Variables:
!
! nw, nh - Width and Height of pixel-map
!
! pixel - Color indices array of pixel-map
!
! Note: pixel with non-positive color index value means
! transparent
!
!---------
!
! ix, iy - Starting point (upper-right corner) of pixel-image
! in screen coordinates
!
! The default is position image in the central location
! of window, if not (ix,iy) co-present
!
! colormap- Color palette (r,g,b) array
!
! ! Define color table
! DO i = 1, 256
! CALL NG_GSCR( i-1, colormap(1,i),&
! colormap(2,i),&
! colormap(3,i), warn=.FALSE. )
! END DO
!
! ! Load into system
! CALL NG_GSCRND()
!
! By user manually if argument not present, or, by
! this subroutine automatically if argument present
!
!=====================================================================
! B. Binary Stream Input/Output
!=====================================================================
!
! SUBROUTINE NG_BSSIZE ! Get file size (bytes)
!
! SUBROUTINE NG_BSUNIT ! Get free unit number
!
! SUBROUTINE NG_BSOPEN ! Open file
! SUBROUTINE NG_BSCLFI ! Close file
!
! SUBROUTINE NG_BSSEEK ! Position the indicator
!
! SUBROUTINE NG_BSRDFL ! Read in FLOATs (REALs)
! SUBROUTINE NG_BSRDIN ! Read in ITNREFERs
! SUBROUTINE NG_BSRDCH ! Read in CHARACTERs
! SUBROUTINE NG_BSRDI1 ! Read in BYTEs
!
! SUBROUTINE NG_BSRDFL_SCALAR ! Read in one FLOAT (REAL)
! SUBROUTINE NG_BSRDIN_SCALAR ! Read in one INTEGER
! SUBROUTINE NG_BSRDCH_SCALAR ! Read in one CHARACTER
! SUBROUTINE NG_BSRDI1_SCALAR ! Read in one BYTE
!
! SUBROUTINE NG_BSWRFL ! Write out FLOATs (REALs)
! SUBROUTINE NG_BSWRIN ! Write out ITNREFERs
! SUBROUTINE NG_BSWRCH ! Write out CHARACTERs
! SUBROUTINE NG_BSWRI1 ! Write out BYTEs
!
! SUBROUTINE NG_BSWRFL_SCALAR ! Write out one FLOAT (REAL)
! SUBROUTINE NG_BSWRIN_SCALAR ! Write out one INTEGER
! SUBROUTINE NG_BSWRCH_SCALAR ! Write out one CHARACTER
! SUBROUTINE NG_BSWRI1_SCALAR ! Write out one BYTE
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_BSSIZE( FILE, NBYTES )
!
! CHARACTER(*), INTENT(IN ) :: FILE
! INTEGER, INTENT( OUT) :: NBYTES
!
! Routine to get size (bytes) of a binary stream file
!
! Variables:
!
! FILE - File name
!
! NBYTES - Size (number of bytes) of file
!
!---------------------------------------
!
! SUBROUTINE NG_BSUNIT( LUN, BACK )
!
! INTEGER, INTENT( OUT) :: LUN
! LOGICAL, INTENT(IN ), OPTIONAL :: BACK
!
! Routine to return a free C I/O logical unit number
! in the range (0-99).
!
! Variables:
!
! LUN - Logical unit number, in the range (0-99)
!
! returns "-1", if no free unit numbers found
! in the range (0-99)
!
! BACK - Search direction flag
! =.FALSE., searched from 0 toward 99 (for user)
! =.TRUE., searched from 99 back to 0 (for system use)
! default is .FALSE., if not present
!
!---------------------------------------
!
! SUBROUTINE NG_BSOPEN( FILE, LUN, IRW, IER )
!
! CHARACTER(*), INTENT(IN ) :: FILE
! INTEGER, INTENT(IN ) :: LUN, IRW
! INTEGER, INTENT( OUT) :: IER
!
! Routine to open a binary stream file.
!
! Variables:
!
! FILE - The file name
!
! LUN - The logical unit number, in the range (0-99)
!
! IRW - The READ-WRITE-APPEND-Update flag
!
! 0=Read
! Open file for input operations.
! The file must exist.
!
! 1=Write
! Create an empty file for output operations.
! If a file with the same name already exists, its contents
! are discarded and the file is treated as a new empty file.
!
! 2=Append
! Open file for output at the end of a file.
! Output operations always write data at the end of the file,
! expanding it. Repositioning operations (NG_BSSEEK) are ignored.
! The file is created if it does not exist.
!
! 3=Read-Update
! Open a file for update (both for input and output).
! The file must exist.
!
! 4=Write-Update
! Create an empty file and open it for update (both for input
! and output). If a file with the same name already exists
! its contents are discarded and the file is treated as a new
! empty file.
!
! 5=Append-Update
! Open a file for update (both for input and output) with all
! output operations writing data at the end of the file.
! Repositioning operations (NG_BSSEEK) affects the next input
! operations, but output operations move the position back to
! the end of file. The file is created if it does not exist.
!
! IER - The error flag, nonzero value if error occured
!
! -4: Invalid IRW value, <0, or, >5
!
! -3: Invalid LUN value, <0, or, >99
!
! -2: Invalid LUN value, file has been opened
!
! -1: Function call fail
!
!---------------------------------------
!
! SUBROUTINE NG_BSCLFI( LUN, IER )
!
! INTEGER, INTENT(IN ) :: LUN
! INTEGER, INTENT( OUT), OPTIONAL :: IER
!
! Routine to close file opened by routine NG_BSOPEN.
!
! Variables:
!
! LUN - Logical unit number
!
! IER - Error flag, nonzero value if error occured
!
! -3: Invalid unit number
!
! -2: File not opened
!
! -1: Function call fail
!
!---------------------------------------
!
! SUBROUTINE NG_BSSEEK( LUN, NOFFS, IORIG, IER )
!
! INTEGER, INTENT(IN ) :: LUN
! INTEGER, INTENT(IN ) :: NOFFS
! INTEGER, INTENT(IN ) :: IORIG
! INTEGER, INTENT( OUT) :: IER
!
! Routine to sets the position indicator to a new position. The new
! position is defined by adding offset (NOFFS bytes) to a reference
! position specified by flag (IORIG).
!
! Variables:
!
! LUN - The logical unit number
!
! NOFFS - The desired position, given as an offset (measured in
! bytes) from the origin specified by the argument "IORIG"
!
! IORIG - The origin flag, which is a "0" to specify the beginning
! of the file, a "1" to specify the current position.
!
! IER - Error flag, nonzero value if error occured
!
! -4: Invalid "IORIG" value
!
! -3: Invalid unit number
!
! -2: File not opened
!
! -1: Function call fail
!
!
!---------------------------------------
!
! SUBROUTINE NG_BSRDFL ( LUN, RBUF, N, M ) ! read array
! SUBROUTINE NG_BSRDFL_SCALAR( LUN, SCALAR, M ) ! read scalar
!
! INTEGER, INTENT(IN ) :: LUN
! REAL, INTENT( OUT) :: SCALAR
! INTEGER, INTENT(IN ) :: N
! REAL, INTENT( OUT) :: RBUF(N)
! INTEGER, INTENT( OUT) :: M
!
! Routine to read in REAL(s) (i.e., FLOAT(s)), from a binary stream file.
!
! Variables:
!
! LUN - The logical unit number
!
! SCALAR - The REAL scalar to receive data transfered
!
! RBUF - T the REAL array to receive data transfered
! N - The number of REALs to be read
!
! M - Returned with a positive value indicating how many
! REALs were actually transferred, a zero value if
! an end-of-file was encountered, or a negative value
! if an error occurred.
!
! -3: Invalid unit number
!
! -2: File not opened or not open-for-read
!
! -1: Function call fail
!
!---------------------------------------
!
! SUBROUTINE NG_BSRDIN ( LUN, IBUF, N, M ) ! read array
! SUBROUTINE NG_BSRDIN_SCALAR( LUN, SCALAR, M ) ! read scalar
!
! INTEGER, INTENT(IN ) :: LUN
! INTEGER, INTENT( OUT) :: SCALAR
! INTEGER, INTENT(IN ) :: N
! INTEGER, INTENT( OUT) :: IBUF(N)
! INTEGER, INTENT( OUT) :: M
!
! Routine to read in INTEGER(s) from a binary stream file.
!
! Variables:
!
! LUN - The logical unit number
!
! SCALAR - The INTEGER scalar to receive data transfered
!
! IBUF - The INTEGER array to receive data transfered
! N - The number of INTEGERs to be read
!
! M - Returned with a positive value indicating how many
! INTEGERs were actually transferred, a zero value if
! an end-of-file was encountered, or a negative value
! if an error occurred.
!
! -3: Invalid unit number
!
! -2: File not opened or not open-for-read
!
! -1: Function call fail
!
!---------------------------------------
!
! SUBROUTINE NG_BSRDCH ( LUN, CBUF, N, M ) ! read array
! SUBROUTINE NG_BSRDCH_SCALAR( LUN, SCALAR, M ) ! read scalar
!
! INTEGER, INTENT(IN ) :: LUN
! CHARACTER(*), INTENT( OUT) :: SCALAR
! INTEGER, INTENT(IN ) :: N
! CHARACTER(*), INTENT( OUT) :: CBUF(N)
! INTEGER, INTENT( OUT) :: M
!
! Routine to read in CHARACTER(s) from a binary stream file.
!
! Variables:
!
! LUN - The logical unit number
!
! SCALAR - The CHARACTER scalar to receive data transfered
!
! CBUF - The CHARACTER array to receive data transfered
! N - The number of CHARACTERs to be read
!
! M - Returned with a positive value indicating how many
! CHARACTERs were actually transferred, a zero value if an
! end-of-file was encountered, or a negative value if
! an error occurred.
!
! -3: Invalid unit number
!
! -2: File not opened or not open-for-read
!
! -1: Function call fail
!
!---------------------------------------
!
! SUBROUTINE NG_BSRDI1 ( LUN, I1BUF, N, M ) ! read array
! SUBROUTINE NG_BSRDI1_SCALAR( LUN, SCALAR, M ) ! read scalar
!
! INTEGER, PARAMETER :: ibyte1 = SELECTED_INT_KIND(r=2)
! INTEGER, INTENT(IN ) :: LUN
! INTEGER(KIND=ibyte1), INTENT( OUT) :: SCALAR
! INTEGER, INTENT(IN ) :: N
! INTEGER(KIND=ibyte1), INTENT( OUT) :: I1BUF(N)
! INTEGER, INTENT( OUT) :: M
!
! Routine to read in BYTE(s) from a binary stream file.
!
! Variables:
!
! LUN - The logical unit number
!
! SCALAR - The BYTE scalar to receive data transfered
!
! I1BUF - The BYTE array to receive data transfered
! N - The number of BYTEs to be read
!
! M - Returned with a positive value indicating how many
! BYTEs were actually transferred, a zero value if an
! end-of-file was encountered, or a negative value if
! an error occurred.
!
! -3: Invalid unit number
!
! -2: File not opened or not open-for-read
!
! -1: Function call fail
!
!---------------------------------------
!
! SUBROUTINE NG_BSWRFL ( LUN, RBUF, N, M ) ! write array
! SUBROUTINE NG_BSWRFL_SCALAR( LUN, SCALAR, M ) ! write scalar
!
! INTEGER, INTENT(IN ) :: LUN
! REAL, INTENT(IN ) :: SCALAR
! INTEGER, INTENT(IN ) :: N
! REAL, INTENT(IN ) :: RBUF(N)
! INTEGER, INTENT( OUT) :: M
!
! Routine to write out REAL(s) (i.e., FLOAT(s)) to a binary stream file.
!
! Variables:
!
! LUN - The logical unit number
!
! SCALAR - The REAL scalar of data to be transferred
!
! RBUF - The REAL array of data to be transferred
! N - The number of REALs to be transferred.
!
! M - Returned with a positive value indicating how many
! REALs were actually transferred or a value less than
! or equal to zero if an error occurred.
!
! -3: Invalid unit number
!
! -2: File not opened or not open-for-write
!
! -1: Function call fail
!
!---------------------------------------
!
! SUBROUTINE NG_BSWRIN ( LUN, IBUF, N, M ) ! write array
! SUBROUTINE NG_BSWRIN_SCALAR( LUN, SCALAR, M ) ! write scalar
!
! INTEGER, INTENT(IN ) :: LUN
! INTEGER, INTENT(IN ) :: SCALAR
! INTEGER, INTENT(IN ) :: N
! INTEGER, INTENT(IN ) :: IBUF(N)
! INTEGER, INTENT( OUT) :: M
!
! Routine to write out INTEGER(s) to a binary stream file.
!
! Variables:
!
! LUN - The logical unit number
!
! SCALAR - The INTEGER scalar of data to be transferred
!
! IBUF - The INTEGER array of data to be transferred
! N - The number of INTEGERs to be transferred.
!
! M - Returned with a positive value indicating how many
! INTEGERs were actually transferred or a value less than
! or equal to zero if an error occurred.
!
! -3: Invalid unit number
!
! -2: File not opened or not open-for-write
!
! -1: Function call fail
!
!---------------------------------------
!
! SUBROUTINE NG_BSWRCH ( LUN, CBUF, N, M ) ! write array
! SUBROUTINE NG_BSWRCH_SCALAR( LUN, SCALAR, M ) ! write scalar
!
! INTEGER, INTENT(IN ) :: LUN
! CHARACTER(*), INTENT(IN ) :: SCALAR
! INTEGER, INTENT(IN ) :: N
! CHARACTER(*), INTENT(IN ) :: CBUF(N)
! INTEGER, INTENT( OUT) :: M
!
! Routine to write out CHARACTER(s) to a binary stream file.
!
! Variables:
!
! LUN - The logical unit number
!
! SCALAR - The CHARACTER scalar of data to be transferred
!
! CBUF - The CHARACTER array of data to be transferred
! N - The number of CHARACTERs to be transferred.
!
! M - Returned with a positive value indicating how many
! CHARACTERs were actually transferred or a value less than
! or equal to zero if an error occurred.
!
! -3: Invalid unit number
!
! -2: File not opened or not open-for-write
!
! -1: Function call fail
!
!---------------------------------------
!
! SUBROUTINE NG_BSWRI1 ( LUN, I1BUF, N, M ) ! write array
! SUBROUTINE NG_BSWRI1_SCALAR( LUN, SCALAR, M ) ! write scalar
!
! INTEGER, PARAMETER :: ibyte1 = SELECTED_INT_KIND(r=2)
! INTEGER, INTENT(IN ) :: LUN
! INTEGER(KIND=ibyte1), INTENT(IN ) :: SCALAR
! INTEGER, INTENT(IN ) :: N
! INTEGER(KIND=ibyte1), INTENT(IN ) :: I1BUF(N)
! INTEGER, INTENT( OUT) :: M
!
! Routine to write out BYTE(s) to a binary stream file.
!
! Variables:
!
! LUN - The logical unit number
!
! SCALAR - The BYTE scalar of data to be transferred
!
! I1BUF - The BYTE array of data to be transferred
! N - The number of BYTEs to be transferred.
!
! M - Returned with a positive value indicating how many
! BYTEs were actually transferred or a value less than
! or equal to zero if an error occurred.
!
! -3: Invalid unit number
!
! -2: File not opened or not open-for-write
!
! -1: Function call fail
!
!=====================================================================
! C. System
!=====================================================================
!
! SUBROUTINE NG_GETENV ! Get environment variable
!
! SUBROUTINE NG_EXECMD ! Execute a system command
!
! SUBROUTINE NG_SOUNDW ! play windows .WAV sound file
! SUBROUTINE NG_BEEPMB ! sound the motherboard spearker
!
! SUBROUTINE NG_ARGNUM ! Get number of arguments of program
! SUBROUTINE NG_GETARG ! Get a argument of program
! SUBROUTINE NG_GETCMD ! Get entire command of program
!
! SUBROUTINE NG_SLEEP1 ! Suspend execution for specified duration time
! SUBROUTINE NG_SLEEP2 ! Suspend execution until specified wake-up time is up
!
! SUBROUTINE NG_GQDATE ! Inquire current date information
! SUBROUTINE NG_GQTIME ! Inquire current system time-of-day
!
! SUBROUTINE NG_GQUNIT ! Inquire a Fortran I/O free logical unit number (11-99)
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_GETENV( envname, envval )
!
! CHARACTER(*), INTENT(IN ) :: envname
! CHARACTER(*), INTENT( OUT) :: envval
!
! Routine to get environment variable
!
! Variables:
!
! ENVNAME - Name of the environment variable
!
! ENVVAL - Content of the environment variable
!
!---------------------------------------
!
! SUBROUTINE NG_EXECMD( commandline )
!
! CHARACTER(*), INTENT(IN) :: commandline
!
! Routine to execute a system command or program by passing a command
! string to the operating system's command interpreter
!
! Variables:
!
! commandline - The specified command or program
!
!---------------------------------------
!
! SUBROUTINE NG_SOUNDW( wavfile )
!
! CHARACTER(*), INTENT(IN) :: wavfile
!
! Routine to play windows .WAV sound file
!
! Variables:
!
! wavfile - Specified .WAV sound file
!
!---------------------------------------
!
! SUBROUTINE NG_BEEPMB( n, frequency, duration )
!
! INTEGER, INTENT(IN) :: n, frequency, duration
!
! Routine to sound the motherboard speaker n times at the specified
! frequency in Hertz for the specified duration in milliseconds
!
! Variables:
!
! n - Number of beeps
!
! frequency - Frequency in Hertz
!
! duration - Duration in milliseconds
!
!---------------------------------------
!
! SUBROUTINE NG_ARGNUM( narg )
!
! INTEGER, INTENT(OUT) :: narg
!
! Routine to get the number of arguments of program.
!
! Variables:
!
! narg - The number of arguments
!
!---------------------------------------
!
! SUBROUTINE NG_GETARG( iarg, string )
!
! INTEGER, INTENT(IN ) :: iarg
! CHARACTER(*), INTENT( OUT) :: string
!
! Routine to get a argument of program.
!
! Variables:
!
! iarg - The order of command argument
!
! string - The string of command argument
!
!---------------------------------------
!
! SUBROUTINE NG_GETCMD( string )
!
! CHARACTER(*), INTENT(OUT) :: string
!
! Routine to get the entire command of program.
!
! Variables:
!
! string - The string of entire command
!
!---------------------------------------
!
! SUBROUTINE NG_SLEEP1( duration )
!
! INTEGER, INTENT(IN) :: duration
!
! Routine to suspend execution for the specified duration time.
!
! Variables:
!
! duration - Specified duration in milliseconds
!
!---------------------------------------
!
! SUBROUTINE NG_SLEEP2( waketime )
!
! INTEGER, INTENT(IN) :: waketime
!
! Routine to suspend execution until the specified wake-up time is up.
!
! Variables:
!
! waketime - wake-up time or reset flag
!
! > 0: the wake-up time (in milliseconds) at which the control
!
!
! <= 0: reset the time of internal clock to zero.
!
! Notes:
!
! The time (>0, in milliseconds) is measured with the internal clock.
!
! If value waketime <= 0 is specified, the time of the internal clock
! is reset to zero and the control is returned immediately.
!
! If the wake-up time specified with waketime (> 0) is earlier than
! the current time of internal clock, the control is returned immediately.
!
!---------------------------------------
!
! SUBROUTINE NG_GQDATE( iyr, imon, iday, iweek )
!
! INTEGER, INTENT(OUT) :: iyr, imon, iday, iweek
!
! Routine to get current date information.
!
! Variables:
!
! iyr - The Year (xxxx AD)
!
! imon - The Month (1-12)
!
! iday - The Day (1-31)
!
! iweek - The Day-of-Week (0-6)
!
!---------------------------------------
!
! SUBROUTINE NG_GQTIME( ihr, imin, isec, i1000th )
!
! INTEGER, INTENT(OUT) :: ihr, imin, isec, i1000th
!
! Routine to get current system time-of-day.
!
! Variables:
!
! ihr - The Hour (0-23)
!
! imin - The Minute (0-59)
!
! isec - The Second (0-59)
!
! i1000th - The Milliseconds of the Second (0-999)
!
!---------------------------------------
!
! SUBROUTINE NG_GQUNIT( LUN, BACK )
!
! INTEGER, INTENT( OUT) :: LUN
! LOGICAL, INTENT(IN ), OPTIONAL :: BACK
!
! Routine to return a Fortran I/O free logical unit number
! in the range (11-99).
!
! Variables:
!
! LUN - The logical unit number, in the range (11-99)
!
! returns "-1", if no free unit numbers found
! in the range (11-99)
!
! BACK - Search direction flag
! =.FALSE., searched from 11 toward 99 (for user)
! =.TRUE., searched from 99 back to 11 (for system use)
! default is .FALSE., if not present
!
!=====================================================================
! D. Console Keyboard
!=====================================================================
!
! SUBROUTINE NG_KEYHIT ! check the struk of a key
! SUBROUTINE NG_KEYGET ! wait until a key pressed, and return its codes and name optionally
! SUBROUTINE NG_KEYCLR ! clear keyboard buffer
!
! SUBROUTINE NG_KEYASC ! wait until one of printable keys (ASCII=32-126) pressed
! SUBROUTINE NG_KEY123 ! wait until one of numeric keys pressed
! SUBROUTINE NG_KEYABC ! wait until one of caracter keys pressed
! SUBROUTINE NG_KEYFUN ! wait until one of function keys pressed
! SUBROUTINE NG_KEYDIR ! wait until one of direction keys pressed
!
! Note: used in text console, not in graphics window
!
!---------------------------------------
!
! SUBROUTINE NG_KEYHIT( pressed )
!
! LOGICAL, INTENT(OUT) :: pressed
!
! Routine to check the struck of a operational key on the keyboard.
!
! Variables:
!
! pressed - Flag
!
! = .TRUR. if struck,
!
! = .FALSE., if not struck
!
!--------------------------------------
!
! SUBROUTINE NG_KEYGET( ascii_code, scan_code, key_name )
!
! INTEGER, INTENT(OUT), OPTIONAL :: ascii_code, scan_code
! CHARACTER(*), INTENT(OUT), OPTIONAL :: key_name
!
! Routine to wait until a key on the keyboard is struck, then return
! its codes and name optionally.
!
! Variable:
!
! ascii_code - The ascii code of pressed key
!
! scan_code - The scan code of pressed key
!
! key_name - The name of pressed key
!
!--------------------------------------
!
! SUBROUTINE NG_KEYCLR()
!
! Routine to clear keyboard buffer. This is useful in situations
! where an error is deteted in the input and subsequent information
! is to be ignored. !
!
!---------------------------------------
!
! SUBROUTINE NG_KEYASC( iasc )
!
! INTEGER, INTENT(OUT) :: iasc
!
! Routine to wait until one of printable keys (ASCII=32-126) on the
! keyboard is struck, then return its ASCII code.
!
! Variables:
!
! iasc - The key value as following
!
! = 32-126, for a printable key pressed
!
! = -1, for <Enter> key pressed
!
! = -2, for <Esc> key pressed
!
!--------------------------------------
!
! SUBROUTINE NG_KEY123( num )
!
! INTEGER, INTENT(OUT) :: num
!
! Routine to wait until one of numeric keys (0,1-9) on the keyboard
! is struck, then return its value (0,1-9)
!
! Variables:
!
! num - The key value as following
!
! = 0-9, for a numeric key 0-9 pressed
!
! = -1, for <Enter> key pressed.
!
! = -2, for <Esc> key pressed.
!
!---------------------------------------
!
! SUBROUTINE NG_KEYABC( letter )
!
! CHARACTER(1), INTENT(OUT) :: letter
!
! Routine to wait until one of Character keys ('A'-'Z','a'-'z') on
! the keyboard is struck, then return its value ('A'-'Z','a'-'z').
!
! Variables:
!
! letter - The key value as following
!
! = ['A'-'Z'], ['a'-'z'], the character of key
!
! = '1', for <Enter> pressed
!
! = '2', for <Esc> pressed
!
!---------------------------------------
!
! SUBROUTINE NG_KEYFUN( ifun )
!
! INTEGER, INTENT(OUT) :: ifun
!
! Routine to wait until one of function keys (F1-F12) on the keyboard
! is struck, then return its value (1-12)
!
! Variables:
!
! ifun - The key value as following
!
! = 1-12, a function key struck
!
! = -1, for <Enter> key pressed
!
! = -2, for <Esc> key pressed
!
!--------------------------------------
!
! SUBROUTINE NG_KEYDIR( idir )
!
! INTEGER, INTENT(OUT) :: idir
!
! Routine to wait until one of direction keys on the keyboard is
! struck, then EXIT its corresponding value as followings:
!
! Up : DIRKEY = 8 Page Up : DIRKEY= 9
! Down : DIRKEY = 2 Page Down : DIRKEY= 3
!
! Left : DIRKEY = 4 Home : DIRKEY= 7
! Right : DIRKEY = 6 End : DIRKEY= 1
!
! Ins : DIRKEY = 0
!
! Variables:
!
! idir - The key value as following
!
! = 0, Insert
! = 1, End
! = 2, Down
! = 3, Page Down
! = 4, Left
! = 6, Right
! = 7, Home
! = 8, Up
! = 9, Page Up
!
! = -1, for <Enter> pressed
! = -2, for <Esc> pressed
!
!---------------------------------------------------------------------
! Keyboard Key Codes (acsii-code and scan-code) in Console mode
!---------------------------------------------------------------------
!
! ========================================================
! Table of Prtintable ASCII Character Codes (32-126)
! ========================================================
! 032 | 048 0 | 058 : | 065 A | 097 a
! 033 ! | 049 1 | 059 ; | 066 B | 098 b
! 034 | 050 2 | 060 < | 067 C | 099 c
! 035 # | 051 3 | 061 = | 068 D | 100 d
! 036 $ | 052 4 | 062 > | 069 E | 101 e
! 037 % | 053 5 | 063 ? | 070 F | 102 f
! 038 & | 054 6 | 064 @ | 071 G | 103 g
! 039 ' | 055 7 | | 072 H | 104 h
! 040 ( | 056 8 | 091 [ | 073 I | 105 i
! 041 ) | 057 9 | 092 \ | 074 J | 106 j
! 042 * | | 093 ] | 075 K | 107 k
! 043 + | | 094 ^ | 076 L | 108 l
! 044 , | | 095 _ | 077 M | 109 m
! 045 - | | 096 ` | 078 N | 110 n
! 046 . | | | 079 O | 111 o
! 047 / | | 123 { | 080 P | 112 p
! | | 124 | | 081 Q | 113 q
! | | 125 } | 082 R | 114 r
! | | 126 ~ | 083 S | 115 s
! | | 127 | 084 T | 116 t
! | | | 085 U | 117 u
! | | | 086 V | 118 v
! | | | 087 W | 119 w
! | | | 088 X | 120 x
! | | | 089 Y | 121 y
! | | | 090 Z | 122 z
! ========================================================
! 1. Codes 0-31, and 127 are non-printable ASCII codes
! 2. SCAN code is zero for all printable ASCII codes
!
!
! ============= | ==============
! Function Keys | Direction Keys
! ============= | ==============
! |
! ASCII SCAN | ASCII SCAN
! code code | code code Pad
! |
! F01 - 000 059 1 | Delete - 224 83 (5)
! F02 - 000 060 2 | Insert - 224 82 0
! F03 - 000 061 3 |
! F04 - 000 062 4 | Home - 224 71 7
! F05 - 000 063 5 | End - 224 79 1
! F06 - 000 064 6 | PgUp - 224 73 9
! F07 - 000 065 7 | PgDn - 224 81 3
! F08 - 000 066 8 |
! F09 - 000 067 9 | Left - 224 75 4
! F10 - 000 068 10 | Right - 224 77 6
! | Up - 224 72 8
! F11 - 224 133 11 | Down - 224 80 2
! F12 - 224 134 12 |
! |
! ---------------------------- | -------------------------------
! |
! S-F01-F10 000 084-093 | C-Delete - 224 147
! S-F11-F12 224 135-136 | C-Insert - 224 146
! |
! ---------------------------- | C-Home - 224 119
! | C-End - 224 117
! C-F01-F10 000 094-103 | C-PgUp - 224 134* (same as F12)
! C-F11-F12 224 137-138 | C-PgDn - 224 118
! |
! ---------------------------- | C-Left - 224 115
! | C-Right - 224 116
! A-F01-F10 000 104-113 | C-Up - 224 141
! A-F11-F12 224 139-140 | C-Down - 224 145
! |
! | -------------------------------
! ============ |
! Special Keys | A-Delete - 000 163
! ============ | A-Insert - 000 162
! |
! ASCII SCAN | A-Home - 000 151
! code code | A-End - 000 159
! | A-PgUp - 000 153
! Backspace - 8 none | A-PgDn - 000 161
! Enter - 13 none |
! Tab - 9 none | A-Left - 000 155
! Esc - 27 none | A-Right - 000 157
! | A-Up - 000 152
! ------------------------- | A-Down - 000 160
! |
! C-Backspace - 127 none |
! C-Enter - 10 none |
! C-Tab - 000 148 |
! C-Esc - Windows key |
! |
! ------------------------- |
! |
! A-Backspace - 8 none |
! A-Enter - windows key |
! A-Tab - windows key |
! A-Esc - Windows key |
!
!=====================================================================
! E. Console Screen
!=====================================================================
!
! SUBROUTINE NG_SCNRST ! Reset screen attribute to initial state
!
! SUBROUTINE NG_SCNCLR ! Clear screen
!
! SUBROUTINE NG_SCNSET ! Set current cursor position, text colors, and cursor shape
! SUBROUTINE NG_SCNGET ! Get current cursor position, text colors, and cursor shape
!
! SUBROUTINE NG_SCNTXT ! Write text-string at current position and with current colors
! SUBROUTINE NG_SCNOUT ! Write text-string at specified position and with specified colors
!
! SUBROUTINE NG_SCNLIN ! Insert line, Remove line, or, Erase to end of line
!
! SUBROUTINE NG_SCNCOP ! Copy a rectangular section of the screen to another place
!
! SUBROUTINE NG_SCNBEW ! WIN32 Clone of Norton's Batch Enhancer by Jason Hood
!
! Notes:
!
! 1. used in text console, not graphics window
!
! 2. Ref: Jason Hood's "TCCONIO" and "BEW", http://adoxa.altervista.org
!
!---------------------------------------------------------------------
!
! SUBROUTINE NG_SCNRST()
!
! Routine to reset screen attribute (foreground and background colors)
! to initial (program startup) state, clear screen, and, set cursor
! type to normal shape (underscore).
!
!---------------------------------------
!
! SUBROUTINE NG_SCNCLR( bc )
!
! INTEGER, OPTIONAL, INTENT(IN) :: bc
!
! Routine to clear screen with optional background color.
!
! Variables:
!
! bc - The background color (0-15)
!
!---------------------------------------
!
! SUBROUTINE NG_SCNSET( row, col, bc, fc, cur )
!
! INTEGER, INTENT(IN), OPTIONAL :: row, col, bc, fc, cur
!
! Routine to set current position (row, column) of cursor, screen
! attribute (foreground and background colors) of text, and, type
! of cursor shape.
!
! Variables:
!
! row - Row position of cursor
!
! col - Column position of cursor
!
! bc - Background color of screen
!
! fc - Foreground color of screen
!
! cur - Shape type of cursor
!
! Notes:
!
! 1. Valid values ranges of cursor position are: row(0-24), col(0-79),
! (row=0, col=0) is the upper left corner of the screen.
!
! 2. Each (bc,fc) Color can be any one of the following (0-15):
!
! Low Color High Color
! ----------- -------------------
! 0 = Black 8 = Light Gray
! 1 = Blue 9 = Light Blue
! 2 = Green 10 = Light Green
! 3 = Cyan 11 = Light Cyan
! 4 = Red 12 = Light Red
! 5 = Magenta 13 = Light Magenta
! 6 = Yellow 14 = Light Yellow
! 7 = White 15 = Light White
!
! The first 8 (0-7) colors are in low video, while the last 8
! (8-15) are in high video.
!
! 3. Valid Values of cursor type are:
!
! 0 - makes the cursor invisible.
! 1 - makes the cursor look like an full block.
! 2 - makes the cursor look like an underscore (the default).
!
!---------------------------------------
!
! SUBROUTINE NG_SCNGET( row, col, bc, fc, cur )
!
! INTEGER, INTENT(OUT), OPTIONAL :: row, col, bc, fc, cur
!
! Routine to get current position (row, column) of cursor, screen
! attribute (foreground and background colors) of text, and, type
! of cursor shape.
!
! Variables:
!
! row - Row position of cursor
!
! col - Column position of cursor
!
! bc - Background color of screen
!
! fc - Foreground color of screen
!
! cur - Shape type of cursor
!
!---------------------------------------
!
! SUBROUTINE NG_SCNTXT( string )
!
! CHARACTER(*), INTENT(IN) :: string
!
! Routine to put text-string starting at current position with current
! background/foreground colors.
!
! Variables:
!
! string - The text-string to be put to screen
!
!---------------------------------------
!
! SUBROUTINE NG_SCNOUT( row, col, bc, fc, string )
!
! INTEGER, INTENT(IN) :: row, col, bc, fc
! CHARACTER(*), INTENT(IN) :: string
!
! Routine to put text (string) starting at specified position (row,col)
! with given background color (bc) and foreground color (fc).
!
! Variables:
!
! row - Row of starting positionM (0-24)
!
! col - Column of starting position (0-79)
!
! bc - Background color (0-15)
!
! fc - Foregrounf color (0-15)
!
! string - Text-string to be put to screen
!
!---------------------------------------
!
! SUBROUTINE NG_SCNLIN( ic )
!
! INTEGER, INTENT(IN) :: ic
!
! Routine to insert line (ic=1), remove line (ic=2), or, erase to end
! of line i(ic=3)
!
! Variables:
!
! ic : Operation flag
!
! =1, insert a blank line at the current cursor position,
! scrolling down all lines below.
!
! =2, remove the current line at the current cursor positin,
! scrolling up all lines below, and inserting a balnk
! line at the screen bottom.
!
! =3, clear all text from the current cursor position up to
! the right console margin (end of line)
!
! Otherwise, nothing happens
!
!---------------------------------------
!
! SUBROUTINE NG_SCNCOP( row1, col1, row2, col2, torow, tocol )
!
! Routine to copy a rectangular section of the screen to another place
!
! INTEGER, INTENT(IN) :: row1, row2, torow
! INTEGER, INTENT(IN) :: col1, col2, tocol
!
! Variables:
!
! (row1,col1) and (row2,col2) are the upper-left and lower-right
! corner of the source rectangle separately
!
! (torow,tocol) is the upper left corner of the destination
! rectangle
!
! The destination rectangle has the same size of the source one.
!
!---------------------------------------
!
! SUBROUTINE NG_SCNBEW( bew_cmd, key )
!
! CHARACTER(*), INTENT(IN ) :: bew_cmd
! INTEGER, OPTIONAL, INTENT( OUT) :: key
!
! Routine to execute the "BEW" commands (bew_cmd), For command ASK,
! the position in the keylist for a matching key will be returned
! through the optional argument (key).
!
! Variables:
!
! bew_cmd - The character string of BEW commands
!
! key - Returned position in the keylist for a matching key
! (used for command ASK)
!
! Notes:
!
! 1. BEW - a WIN32 Clone of Norton's Batch Enhancer by Jason Hood
!
! 2. ASK prompts the user for a response to a question. ASK will
! return the position in the list (plus adjust) for a matching
! key; or 255 if it timed out with no default.
!
!-------------
! BEW command: CLS, ASK, ROWCOL, WINDOW, (/?, --help), --version
!-------------
!
! 1. to clear the current screen.
!
! CLS
!
! 2. to prompt the user for a response to a question.
!
! ASK "prompt" <keylist> [match] [default=key] [timeout=n] [adjust=n] [sa]
!
! 3. to position the cursor at the specified location, and if required,
! print some text in a given colour.
!
! ROWCOL row col ["string" [sa]]
!
! 4. to display a window on the text screen.
!
! WINDOW top left bottom right [single] [sa]
!
! 5. to display the help information
!
! /? or --help
!
! 6. to display the version number
!
! --version
!
!-------------
!
! Notes:
!
! 0. http://adoxa.altervista.org/bew/index.html
!
! 1. Specify a file name to read these commands from that file.
!
! 2. ASK prompts the user for a response to a question. ASK will
! return the position in the list (plus adjust) for a matching
! key; or 255 if it timed out with no default.
!
! 3. Row and column are zero-based - (0,0) is top-left corner.
! Specify a sign to treat that coordinate as relative to the
! current cursor position.
!
! 4. SA specify the screen attributes or colours must be last, but
! other options can be in any order.
!
! 5. Format of optional [sa] is: SA [bright] [blinking] [fg] [on bg]
!
! Foreground and background (fg/bg) colors can be one of:
!
! black blue green cyan red magenta yellow white
!
! Bright will set bright fg; blinking will set bright background.
!
!=====================================================================
! F. Digitizer
!=====================================================================
!
! SUBROUTINE NG_DGTSCN( icom, irate, mode, cfile, beep )
!
! INTEGER, INTENT(IN) :: icom, irate, mode
! CHARACTER(*), INTENT(IN) :: cfile
! LOGICAL, INTENT(IN) :: beep
!
! Routine to digitizing data points in simple text (console) mode
! for SummaGraph MM1201 Compatible Digitizer.
!
! Variables:
!
! icom - Serial COM port Selector
! 1, 2, 3, or, 4 for COM1, COM2, COM3, or COM4
!
! irate - Data transfer rate selector
! =1, 100 points per second
! =2, 50 points per second
! =3, 20 points per second
! =4, 7 points per second
! lower rate, more stable, 7 points may fast enough
!
! mode - Operation mode selector
! =1, Use Digitizer Buttons
! =2, Use Keyboard Funtion Keys
!
! cfile - Name of output data file
!
! beep - Whether or not sound the motherboard speaker to hint
!
!=====================================================================