SLIB77 *H% SUBROUTINE WRTRCD( DATA, FORMAT, ROW, COLUMN, VIEW, LENGTH,  1 WCOLMS, IFIELD, SAVK, ROWKH )  C---->SUBROUTINE WRTRCD ( WRITE RECORD ) WRITES ONE LINE TO THE SCREEN C BUFFER ( SCRBUF ) IN COMMON /WINBUF/ AND WRITES THE THE LINE OF C OF DATA TO THE TERMINAL SCREEN. SCRBUF, A CHARACTER ARRAY, ISC COFLDATT 8/12/85 FSED 8/12/85FSEDIT 8/12/85SPECAL 8/12/85STAINF 8/12/85SYSPAR 8/12/85VARS 8/12/85!WINDOW 8/12/85$ FSCREN 8/12/85-$CLRSCR 8/12/85QCURDWN 8/12/85VDELETE 8/12/85fEDCHAR 8/12/85v EDTEXT 8/12/85FSEND 8/12/85FSETUP 8/12/85 FSOUT 8/12/85FSSIZE 8/12/85 GETKEY 8/12/85HOMCUR 8/12/85 KEYPAD 8/12/85LTAROW 8/12/85OVRTYP 8/12/85PRTCHR 8/12/85 PUTSCR 8/12/85 RDRECD 8/12/85! REBUFF 8/12/85*RFRSCR 8/12/85/ RTAROW 8/12/85<SCANOF 8/12/85K SCREEN 8/12/85U*SPECHR 8/12/85STRFOR 8/12/85TABOVR 8/12/85TRMCHN 8/12/85UPAROW 8/12/85WRTRCD 8/12/85* ***** UNREFERENCED ARGUMENTS ***** "* #* $* WCOLMS INT MAXIMUM SCREEN COLUMN WIDTH %* &* '* FSE002 8/12/85FSE003 8/27/85RCD( DATA, FORMAT, ROW, COLUMN, VIEW, LENGTH,  1 WCOLMS, IFIELD, SAVK, ROWKH )  C---->SUBROUTINE WRTRCD ( WRITE RECORD ) WRITES ONE LINE TO THE SCREEN C BUFFER ( SCRBUF ) IN COMMON /WINBUF/ AND WRITES THE THE LINE OF C OF DATA TO THE TERMINAL SCREEN. SCRBUF, A CHARACTER ARRAY, ISC COFLDATT 8/12/85 * *-----------------------------------------------------------------------* LABELLED COMMON : FLDATT : FIELD ATTRIBUTES *-----------------------------------------------------------------------*  COMMON /FLDATT/ RECTYP( Z1 ), FLDCO1( Z1 ), FLDCO2( Z1 ),  1 TABSPC( Z1 ), DISCHR( Z1 ), FMTTYP( Z1 ),  2 TITLE( Z1 ), LOVAL( Z1 ), HIVAL( Z1 ),  3 FLDHLP( Z1 ), NFIELD   CHARACTER DISCHR*32, TITLE*32, FLDDIS*32, FLDHLP*32 CHARACTER FMTTYP*32, HIVAL*10, LOVAL*10, RECTYP*8  INTEGER FLDCO1, FLDCO2, TABSPC, NFIELD * * * NAME TYPE COMMON DESCRIPTION* ------ ---- ------ -----------* * DISCHR CHAR FLDATT ARRAY OF FIELD FORMAT SPECIFICATION/ * DESCRIPTOR * CONTAINS: * FLDFMR [..........++ ] * STATUS-REPORT VARIABLE "++" MARKS * END OF STRING.* FLDCO1 INT FLDATT START COLUMN OF FIELD * FLDCO2 INT FLDATT END COLUMN OF FIELD* FLDDIS CHAR FLDATT ARRAY OF FIELD DISPLAY ATTRIBUTES OTHER* THAN FORMAT OF TYPE/INTENSITY/HIGH-* LIGHT. * CONTAINS: * FLDDSP [..........++ ]  * STATUS REPORT VARIABLE "++" MARKS !* END OF STRING."* FLDHLP CHAR FLDATT ANY ADDITIONAL HELP INFORMATION ABOUT #* FIELD $* CONTAINS: %* FLDHLR [..........++ ] &* STATUS-REPORT VARIABLE "++" MARKS '* END OF STRING.(* HIVAL CHAR FLDATT HIGH VALUE OF DATA FIELD )* CONTAINS: ** HIFLD [..........++ ] +* STATUS-REPORT VARIABLE "++" MARKS ,* END OF STRING.-* LOVAL CHAR FLDATT LOW-VALUE OF DATA IN FIELD .* CONTAINS: /* LOFLD [..........++ ] 0* STATUS-REPORT VARIABLE "++" MARKS 1* END OF STRING.2* NFIELD INT FLDATT NUMBER OF FORMATS SENT TO FSCREN 3* 4* RECTYP CHAR FLDATT AN ARRAY OF FIELD FORMAT TYPES 5* TABSPC INT FLDATT AN ARRAY OF TABULATION SPACES 6* TITLE CHAR FLDATT ARRAY OF TITLE (DESCRIPTION) OF THE7* FIELD 8* CONTAINS: 9* FLDESR [..........++ ] :* STATUS-REPORT VARIABLE "++" MARKS ;* END OF STRING.<* FSED 8/12/85* *-----------------------------------------------------------------------* LABELLED COMMON : FSED : FULL SCREEN EDIT MODE*-----------------------------------------------------------------------*  COMMON /FSED/ BUF, MODE   CHARACTER BUF*256, MODE*8  *  * NAME TYPE COMMON DESCRIPTION * ------ ---- ------ ----------- *  * BUF CHAR FSED SCRATCH BUFFER * MODE CHAR FSED EDIT MODE: OVERSTRIKES OR INSERT * AL*10, RECTYP*8  INTEGER FLDCO1, FLDCO2, TABSPC, NFIELD * * * NAME TYPE COMMON DESCRIPTIONFSEDIT 8/12/85* *-----------------------------------------------------------------------* PARAMETERS*-----------------------------------------------------------------------* * * *  INTEGER Z1, Z2, Z3, Z4, Z5  *  *  * PARAMETER (Z1=84)  PARAMETER (Z2=256)  PARAMETER (Z3=10)  PARAMETER (Z4=Z2)  PARAMETER (Z5=8) * * * ***** PARAMETER DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * Z1 INT Maximum Number of File Records * Z2 INT File Record Length: 0 margin* Z3 INT Number of File Record Types * Z4 INT Maximum Number of Fields in any record * Z5 INT Length of record key (RECTYP, REKTYP) * ATUS-REPORT VARIABLE "++" MARKS SPECAL 8/12/85  * *-----------------------------------------------------------------------* LABELLED COMMON : SPECAL : SPECIAL CHARACTERS *-----------------------------------------------------------------------*     COMMON / SPECAL / NUL, ESC, DEL, BS, TAB, CR, LF, BELL, INS, BEE    CHARACTER BELL*1, BS*1, CR*1, DEL*1 CHARACTER ESC*1, INS*1, LF*1, NUL*1 CHARACTER TAB*1, BEE*1  DATA BELL / 7 /  * * * * NAME TYPE COMMON DESCRIPTION* ------ ---- ------ -----------* * BEE CHAR SPECAL ALPHA B CHARACTER * BELL CHAR SPECAL BELL CHARACTER * BS CHAR SPECAL BACKSPACE CHARACTER * CR CHAR SPECAL CARRIAGE RETURN CHARACTER * DEL CHAR SPECAL DELETE CHARACTER * ESC CHAR SPECAL ESCAPE CHARACTER  * INS CHAR SPECAL INSERT ON/OFF CHARACTER !* LF CHAR SPECAL LINE FEED CHARACTER "* NUL CHAR SPECAL ASCII NULL CHARACTER #* TAB CHAR SPECAL TAB CHARACTER $* LIGHT. * CONTAINS: STAINF 8/12/85* *-----------------------------------------------------------------------* LABELLED COMMON : STAINF : EDITOR STATUS INFORMATION*-----------------------------------------------------------------------*  COMMON /STAINF/ FLDNUM, FLDESR, FLDFMR, FLDHLR, LOFLD, HIFLD,  1 CFLAG, INSERT   CHARACTER FLDESR*10, FLDFMR*10, FLDHLR*32, HIFLD*10 CHARACTER LOFLD*10  INTEGER FLDNUM   LOGICAL CFLAG, INSERT * * * NAME TYPE COMMON DESCRIPTION* ------ ---- ------ -----------* * CFLAG LOG STAINF CHANGE FLAG FOR STATUS LINE REFRESH* FLDESR CHAR STAINF HOLDS FIELD TITLE * FLDFMR CHAR STAINF HOLDS FIELD FORMAT SPECIFICATION/ * DESCRIPTOR * FLDHLR CHAR STAINF HOLDS FIELD HELP INFO * HIFLD CHAR STAINF HOLDS FIELD HIGH DATA VALUE* LOFLD CHAR STAINF HOLDS FIELD LOW DATA VALUE * FLDNUM INT STAINF FIELD (INDEX) NUMBER * INSERT LOG STAINF MODE OF EDIT (OVERTYPE OR INSERT) * CHAR SPECAL LINE FEED CHARACTER "* NUL CHAR SPECAL ASCII NULL CHARACTER #* TAB CHAR SPECAL TAB CHARACTER $* LIGHT. * CONTAINS: SYSPAR 8/12/85  * *-----------------------------------------------------------------------* LABELLED COMMON : SYSPAR : FOR SYSTEM SERVICE CALLS *-----------------------------------------------------------------------*   COMMON /SYSPAR/ TERMCH   COMMON /SYSPAR/ TERMNL, TERMCH, IOSB(4), KEY  INTEGER*2 TERMCH      CHARACTER KEY*1, TERMNL*2/'TT'/  INTEGER*2 IOSB, TERMCH  * * * * ***** READ-ONLY VARIABLES ***** * * * NAME TYPE COMMON DESCRIPTION* ------ ---- ------ -----------* * KEY CHAR SYSPAR $ASCII SYMBOL OF KEY PRESSED * TERMNL CHAR SYSPAR $TERMINAL * IOSB INT SYSPAR $I/O STATUS BYTE * TERMCH INT SYSPAR $TERMINAL CHANNEL * TERMCH INT SYSPAR TERMINAL CHANNEL * VARS 8/12/85* *----------------------------------------------------------------------- * LABELLED COMMON : VARS : *-----------------------------------------------------------------------*  COMMON /VARS/ ENDEDT, FLDINF, KEYNUM   CHARACTER FLDINF*71  INTEGER KEYNUM  LOGICAL ENDEDT  * * NAME TYPE COMMON DESCRIPTION* ------ ---- ------ -----------* * FLDINF CHAR VARS FIELD STATUS ( HELP ) INFORMATION * KEYNUM INT VARS ASCII VALUE OF CURRENT KEY SYMBOL FOR * KEYBOARD * ENDEDT LOG VARS END-CALL FLAG * $ASCII SYMBOL OF KEY PRESSED * TERMNL CHAR SYSPAR $TERMINAL * IOSB INT SYSPAR $I/O STATUS BYTE * TERMCH INT SYSPAR $TERMINAL CHANNEL * * HIFLD CHAR STAINF HOLDS FIELD HIGH DATA VALUE* LOFLD CHAR STAINF HOLDS FIELD LOW DATA VALUE WINDOW 8/12/85 * * *-----------------------------------------------------------------------* LABELLED COMMON : WINBUF : WINDOW BUFFER *-----------------------------------------------------------------------   COMMON /WINBUF/ SCRBUF, SCRFOR, RCDCHG(25), FORMS, 1 MAPSCR(25, 133), SAVBUF, OFFSET   CHARACTER FORMS(25)*133, SAVBUF(25)*140, SCRBUF(25)*140, 1 SCRFOR(25)*140   INTEGER MAPSCR, OFFSET, RCDCHG  * * * * * ***** VARIABLES ***** * * * NAME TYPE COMMON DESCRIPTION* ------ ---- ------ -----------* * FORMS CHAR WINBUF ARRAY HOLDING SCREEN FORMATS * MAPSCR INT WINBUF A MAP OF THE SCREEN WITH AN INTEGER IN * EACH CELL DESIGNATING WHICH FORMAT IS * USED WHEN WRITING TO THAT CELL, i.e., * THE INTEGER IS A SUBSCRIPT FOR * ARRAYS FORMS  * OFFSET INT WINBUF NUMBER OF SPACES FROM LEFT MARGIN !* USED BY FORMATS OTHER THAN CURRET "* ONE#* RCDCHG INT WINBUF RECORD CHANGED ARRAY. IF RECORDS IS $* CHANGED, i.e., EDITED, SET = 1 FOR %* SUBSCRIPT EQUAL TO ROW NUMBER, OTHER- &* WISE SET = 0. '* SCRFOR CHAR WINBUF SCREEN FORMAT FOR EACH LINE IN SCRBUF (* DISPLAY)* SAVBUF CHAR WINBUF SAVE BUFFER IS A SET OF UNEDITED ** RECORDS SENT TO FSCREN +* SCRBUF CHAR WINBUF SCREEN BUFFER CONTAINS CURRENT SCREEN ,* DISPLAY-* . /*----------------------------------------------------------------------- 0* LABELLED COMMON : WINDOW1*-----------------------------------------------------------------------2 3 4 COMMON /WINDOW/ FWBOT, FWTOP, SWTOP, SWBOT, TERMCL, TERMRO5 6 INTEGER FWBOT, FWTOP, SWBOT, SWTOP, TERMCL, TERMRO 7 8* 9* :* ***** VARIABLES *****;* <* =* NAME TYPE COMMON DESCRIPTION>* ------ ---- ------ -----------?* @* FWBOT INT WINDOW BOTTOM DATA FILE BOUNDARY A* FWTOP INT WINDOW TOP OF DATA FILE BOUNDARY B* MARGIN INT WINDOW TOP DATA FILE BOUNDARY C* SWBOT INT WINDOW BOTTOM OF SCREEN WINDOW BOUNDARY D* SWTOP INT WINDOW TOP OF SCREEN WINDOW BOUNDARY E* TERMCL INT WINDOW NUM OF TERMINAL COLUMNS AVAILABLE F* TERMRO INT WINDOW NUMBER OF TERMINAL ROWSG* ] :* STATUS-REPORT VARIABLE "++" MARKS ;* END OF STRING.<* FSCREN 8/12/85$ SUBROUTINE FSCREN( ICODE, IFIELD, ROW, COLUMN, LENGTH, VIEW,  1 IQUERY, DATA, RCDTYP,  2 NDIM, LERROR, NERROR, REMARK, QREM, QREADY, 3 QERROR, LEVEL ) *-----------------------------------------------------------------------* ROUTINE : FSCREN MODULE : $ DATE : 11-FEB-85 *----------------------------------------------------------------------- *  *  * PURPOSE: To display a number of rows to a video screen for modi-  * fication by the user. When the user hits the RETURN * key, or one of the BUTTON keys (1-12), the displayed* data,as modified, is returned to the calling program. * * THIS ROUTINE IS THE INTERFACE ROUTINE BETWEEN THE * APPLICATION DRIVER AND THE INTERACTIVE TERMINAL.* * IT IS PART OF THE NON-PORTABLE SERVICES LIBRARY.* *-----------------------------------------------------------------------  IMPLICIT INTEGER ( A - Z )  *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER DATA(*)*(*), RCDTYP*(*), REMARK*(*) * ! INTEGER COLUMN, ICODE, IFIELD, IQUERY, LENGTH, LERROR " INTEGER LEVEL, NDIM, NERROR, ROW, VIEW #* $ LOGICAL QERROR, QREADY, QREM %* &* '* ***** INPUT ARGUMENT DESCRIPTIONS ***** (* )* ** NAME TYPE DESCRIPTION +* ------ ---- ----------- ,* -* DATA CHAR WHEN ICODE=0, INPUT AND OUTPUT LINES OF TEXT..* WHEN ICODE=5, INPUT LINE FORMAT DESCRIPTIONS./* 0* ICODE INT 0 TO WRITE DISPLAY BUFFER CONTENTS TO SCREEN AND 1* MONITOR USER INPUT 2* 1 TO INITIALIZE THE INTERFACE. 3* 2 TO TERMINATE THE FULL SCREEN INTERFACE.4* 3 TO QUERY THE NUMBER OF ROWS AND COLUMNS AVAILAB5* 4 ... NOT USED6* 5 TO STORE RECORD FORMATS THAT WILL BE USED TO 7* DISPLAY THE DATA, WILL BE USED TO FORMAT THE8* ROWS OF THE SCREEN 9* 6 TO WRITE A RECORD TO A LOCATION ON THE SCREEN :* 7 TO READ A RECORD FROM THE SCREEN BUFFER;* <* RCDTYP CHAR WHEN ICODE=0, DEFINES WHICH RECORD FORMAT TO USE =* WITH EACH LINE ON THE SCREEN >* ?* @* ***** OUTPUT ARGUMENT DESCRIPTIONS ***** A* B* C* NAME TYPE DESCRIPTION D* ------ ---- ----------- E* IQUERY INT NUM OF THE BUTTON KEY PUSHED,F* ZERO IF RETURN KEY PUSHED (ICODE=0). G* NUMBER OF ROWS AVAILABLE (ICODE=3). H* I* COLUMN INT NUMBER OF COLUMNS TO BE DISPLAYED. J* K* ROW INT NUMBER OF LINES TO BE DISPLAYED. L* M* QREM LOG TRUE IF REMARK CONTAINS A MESSAGE. N* O* REMARK CHAR SYSTEM-DEPENDENT CODES AND ERROR MESSAGES. P* Q* R* S* T* ***** VARIABLES NOT SET IN THIS ROUTINE ***** U* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** V* W* X* NAME TYPE DESCRIPTION Y* ------ ---- ----------- Z* [* \* LENGTH INT NUMBER OF CHARACTERS IN DATA FOR ICODE = 6 ]* LERROR INT N.P.S. ERROR ARGUMENT. ^* LEVEL INT N.P.S. ERROR ARGUMENT. _* NDIM INT N.P.S. ERROR ARGUMENT. `* NERROR INT N.P.S. ERROR ARGUMENT. a* QERROR LOG N.P.S. ERROR ARGUMENT. b* QREADY LOG N.P.S. ERROR ARGUMENT. c* d e* f*-----------------------------------------------------------------------g* LOCAL VARIABLES h*-----------------------------------------------------------------------i* j* k LOGICAL FORMAT, SCRIPL l* m* n* o* ***** SET VARIABLES ***** p* q* r* NAME TYPE DESCRIPTION s* ------ ---- ----------- t* u* FORMAT LOG SCREEN HAS BEEN FORMATTEDv* SCRIPL LOG SCREEN HAS BEEN INITIALIZED w* x* y* ***** VARIABLES NOT SET IN THIS ROUTINE ***** z* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** {* |* }* NAME TYPE DESCRIPTION ~* ------ ---- ----------- * * WCOLMS INT WINDOW COLUMNS AVAILABLE TO THE APPLICATION * WLINES INT WINDOW LINES (ROW) " " " " * SAVE WCOLMS, WLINES * * *-----------------------------------------------------------------------* PROCEDURES*-----------------------------------------------------------------------* * * ============ SUBROUTINES CALLED ============* * EXTERNAL EDTEXT  EXTERNAL ERRORS EXTERNAL FSEND EXTERNAL FSETUP  EXTERNAL PROLOG EXTERNAL RDRECD EXTERNAL STRFOR EXTERNAL WRTRCD * * * ***** SUBROUTINE DESCRIPTIONS ****** * * NAME DESCRIPTION * ------ ----------- * * EDTEXT START THE RECORD EDITING PORTION OF FSCREN * ERRORS AN NPS SUBROUTINE* FSEND TERMINATES FSCREN* FSETUP INITIALIZES THE FSCREN * PROLOG AN NPS SUBROUTINE* RDRECD READS A RECORD FROM FSCREN * STRFOR STORES RECORD FORMATS FOR RECORD DISPLAY * WRTRCD WRITES A RECORD FOR EDITING * *-----------------------------------------------------------------------* DATA INITIALIZATION*-----------------------------------------------------------------------* * DATA FORMAT / .FALSE. / DATA SCRIPL / .FALSE. / * * *-----------------------------------------------------------------------* END OF DECLARATIONS*-----------------------------------------------------------------------* *  * BEGIN : FSCREN * CHECK AND INITIALIZE THE NPS ERROR ARGUMENTS  CALL PROLOG( NDIM, NERROR, LEVEL, QREADY, QREM, QERROR )  NERROR = 0  LEVEL = 0  QREADY = .TRUE.  QREM = .FALSE.  QERROR = .FALSE.  IF ( QERROR ) RETURN  * --- CHECK THE INPUT. ---   IF ( ICODE .LT. 0 .OR. ICODE .GT. 7 ) THEN CALL ERRORS( 140, 3, NDIM, NERROR, LERROR, LEVEL, QERROR ) QREM = .TRUE.  REMARK = ' FULL SCREEN INTERFACE OP CODE UNDEFINED' RETURN  END IF * --- INITIALIZE RETURN CODE --- * BEG, END, SIZ, ---, FMT, WRT, RED  GO TO ( 100, 200, 300, 400, 500, 600, 700 ), ICODE * DROP THROUGH FOR ICODE = 0, DISPLAY AND EDIT SCREEN BUFFER   IF ( .NOT. SCRIPL ) THEN  CALL ERRORS( 2, 2, NDIM, NERROR, LERROR, LEVEL, QERROR ) QREM = .TRUE.  REMARK = ' FULL SCREEN INTERFACE NOT INITIALIZED' RETURN END IF   IF ( .NOT. FORMAT ) THEN  CALL ERRORS( 2, 2, NDIM, NERROR, LERROR, LEVEL, QERROR ) QREM = .TRUE.  REMARK = ' FULL SCREEN INTERFACE NOT FORMATTED' RETURN END IF C IQUERY = 0   IF ( ROW .EQ. 0 .OR. COLUMN .EQ. 0 )THEN ROW = ROWKH COLUMN = FSTCOL END IF   CALL EDTEXT( ROW, COLUMN, WCOLMS, IQUERY )   RETURN   ************ **************** --- INITIALIZE FULL SCREEN INTERFACE --- ************ *************** 100 CONTINUE   IF ( SCRIPL ) THEN  CALL ERRORS( 2, 2, NDIM, NERROR, LERROR, LEVEL, QERROR ) QREM = .TRUE.  REMARK = ' FULL SCREEN INTERFACE ALREADY INITIALIZED' ELSE  * --- INITIALIZE ---  SCRIPL = .TRUE.  CALL FSETUP( WLINES, WCOLMS ) ROW = WLINES COLUMN = WCOLMS END IF  RETURN     ************ **************** --- TERMINATE FULL SCREEN INTERFACE ---************ ***************  200 CONTINUE   IF ( .NOT. SCRIPL ) THEN  CALL ERRORS( 2, 2, NDIM, NERROR, LERROR, LEVEL, QERROR )  QREM = .TRUE.   REMARK = ' FULL SCREEN INTERFACE NOT INITIALIZED'  RETURN  ELSE  SCRIPL = .FALSE.  FORMAT = .FALSE.  CALL FSEND  END IF  RETURN     ************ **************** --- QUERY NUMBER OF ROWS AND COLUMNS --- * --- AVAILABLE IN THE SCREEN WINDOW --- ************ ***************  300 CONTINUE   IF ( .NOT. SCRIPL ) THEN  CALL ERRORS( 2, 2, NDIM, NERROR, LERROR, LEVEL, QERROR )  QREM = .TRUE.   REMARK = ' FULL SCREEN INTERFACE NOT INITIALIZED' ! ELSE " #* --- RETURN NUMBER OF ROWS AND COLUMNS IN THE USEABLE WINDOW ---$ % ROW = WLINES & COLUMN = WCOLMS 'C IQUERY = ROW ( END IF ) * + RETURN , - .************ ***************/* --- UNUSED OP CODE --- 0************ ***************1 2 400 CONTINUE 3 RETURN4 5 6 7************ ***************8* --- FORMAT SCREEN --- 9************ ***************: ; 500 CONTINUE < = > IF ( .NOT. SCRIPL ) THEN ? CALL ERRORS( 2, 2, NDIM, NERROR, LERROR, LEVEL, QERROR ) @ QREM = .TRUE. A REMARK = ' FULL SCREEN INTERFACE NOT INITIALIZED' B ELSE C D* --- FORMATTING SCREEN --- E F CALL STRFOR( DATA, IFIELD, FSTCOL, SAVK ) G FORMAT = .TRUE. H END IF I RETURNJ K L************ ***************M* --- WRITE A RECORD TO THE SCREEN --- *N************ ***************O P 600 CONTINUE Q R CALL WRTRCD( DATA(1), RCDTYP, ROW, COLUMN, VIEW, LENGTH, WCOLMS, S 1 IFIELD, SAVK, ROWKH )T U RETURNV W************ ***************X* --- READ A RECORD FROM THE SCREEN BUFFER --- *Y************ ***************Z [ 700 CONTINUE \ ] CALL RDRECD( IFIELD, ROW, COLUMN, LENGTH, IQUERY, DATA(1) ) ^ _ RETURN` END CLRSCR 8/12/85  SUBROUTINE CLRSCR  C---->SUBROUTINE CLRSCR ( CLEAR SCREEN ) CLEARS THE SCREEN, THE SCREEN C BUFFER ( SCRBUF ), AND THE SAVE BUFFER ( SAVBUF ).  IMPLICIT INTEGER( A - Z )     *----------------------------------------------------------------------- * ROUTINE : CLRSCR MODULE : FSCREN DATE : 6-AUG-85 *----------------------------------------------------------------------- * *CALL WINDOW* *-----------------------------------------------------------------------* PROCEDURES*-----------------------------------------------------------------------* * * ============ SUBROUTINES CALLED ============* *  EXTERNAL SCREEN * * * ***** SUBROUTINE DESCRIPTIONS ****** * * NAME DESCRIPTION * ------ -----------  * !* SCREEN MANIPULATES SCREEN ATTRIBUTES"* #* $*-----------------------------------------------------------------------%* END OF DECLARATIONS&*-----------------------------------------------------------------------'* (* ) * +C BEGIN : CLRSCR, - DO 200 K = 1, 25 . SAVBUF( K ) = ' ' / SCRBUF( K ) = ' ' 0 RCDCHG( K ) = 1 1 200 CONTINUE 2 3 CALL SCREEN( 1, 0, 0 )4 5 RETURN6 7 END - ----------- ,* -* DATA CURDWN 8/12/85 SUBROUTINE CURDWN( CURROW, CURCOL, WCOLMS )  SUBROUTINE CURDWN( CURROW, CURCOL, KEY, WCOLMS )  C---->SUBROUTINE CURDWN ( CURSOR DOWN ) MOVES THE CURSOR EITHER DOWNC ONE LINE OR TO THE BOTTOM TEXT LINE ON THE SCREEN PROVIDING THAT C THERE IS ROOM. THE CURSOR IS ALSO MOVED TO THE LEFT-MOST C COLUMN OF THE TEXT.   IMPLICIT INTEGER( A - Z )   *----------------------------------------------------------------------- * ROUTINE : CURDWN MODULE : FSCREN DATE : 7-AUG-85  *----------------------------------------------------------------------- * * * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER KEY*1  INTEGER CURCOL, CURROW, WCOLMS * * * * * ***** INPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * KEY CHAR ASCII SYMBOL OF KEY PRESSED  * WCOLMS INT COLUMN WIDTH, i.e., NUMBER OF SPACES !* "* #* ***** OUTPUT ARGUMENT DESCRIPTIONS ***** $* %* &* NAME TYPE DESCRIPTION '* ------ ---- ----------- (* )* CURCOL INT CURRENT COLUMN POSITION ** CURROW INT CURRENT ROW POSITION +* ,* -*CALL FSEDIT .*CALL SYSPAR/*CALL SPECAL0*CALL FLDATT1*CALL WINDOW2* 3*-----------------------------------------------------------------------4* PROCEDURES5*-----------------------------------------------------------------------6* 7* 8* ============ INTRINSIC FUNCTIONS ============ 9* :* ;* <* = INTEGER INDEX >* ?* ***** INTRINSIC FUNCTION DESCRIPTIONS *****@* A* B* NAME TYPE DESCRIPTION C* ------ ---- ----------- D* E* INDEX INT STANDARD FORTRAN INDEX FUNCTION F* G* H* ============ SUBROUTINES CALLED ============I* J* K EXTERNAL SCREEN L* M* N* ***** SUBROUTINE DESCRIPTIONS *****O* P* Q* NAME DESCRIPTION R* ------ ----------- S* T* SCREEN MANIPULATES SCREEN ATTRIBUTESU* V* W*-----------------------------------------------------------------------X* END OF DECLARATIONSY*-----------------------------------------------------------------------Z* [* \ ] ^C BEGIN : CURDWN_ ` IF ( CURROW .LT. SWBOT ) THEN a b IF ( KEY .EQ. LF .OR. KEY .EQ. 'E' .OR. KEY .EQ. 'Z' ) THENcC KEY .EQ. 'E' IS FOR CURSOR DOWN ONE LINE ANDdC DO NOT CHANGE COLUMN. KEY IS SET IN SUBROUTINE SPECHR e f ROW = CURROW + 1g 100 FORM = MAPSCR( ROW, CURCOL )h i IF ( FORM .EQ. 0 ) THEN j ROW = ROW + 1 k GO TO 100 l END IF m n I = INDEX( DISCHR( FORM ), 'TP' ) o IF ( I .NE. 0 ) THEN p ROW = ROW + 1q IF ( ROW .GT. SWBOT ) THEN r PRINT 200, BELL s 200 FORMAT( '+', $, A ) t RETURN u ELSE v GO TO 100 w END IF x ELSE y CURROW = ROW z { IF ( KEY .EQ. 'Z' ) THEN | FORM = MAPSCR( CURROW, 1 )} I = INDEX( DISCHR( FORM ), 'TP' ) ~ IF ( I .EQ. 0 ) THEN  CURCOL = 1 ELSE  CURCOL = FLDCO2( FORM ) + 1 END IF END IF   CALL SCREEN( 12, CURROW, CURCOL ) END IF ELSE   IF ( KEY .EQ. 'B' ) THENC MOVE CURSOR TO BOTTOM LINE OF SCREEN TEXT ANDC TO LEFT-MOST COLUMN  TRYROW = SWBOT + 1  250 TRYROW = TRYROW - 1  IF ( TRYROW .LT. SWTOP ) RETURN TRYCOL = 1  260 FORM = MAPSCR( TRYROW, TRYCOL )  IF ( FORM .EQ. 0 ) GO TO 250  I = INDEX( DISCHR( FORM ), 'TP' )  IF ( I .NE. 0 ) THEN  TRYCOL = FLDCO2( FORM ) + 1  IF ( TRYCOL .GT. WCOLMS ) GO TO 250 GO TO 260 END IF  CURROW = TRYROW CURCOL = TRYCOL  CALL SCREEN( 12, CURROW, CURCOL ) END IF  END IF   ELSE PRINT 200, BELL END IF  RETURN END  IF ( .NOT. SCRIPL ) THEN ? CALL ERRORS( 2, 2, NDIM, NERROR, LERROR, LEVEL, QERROR ) @DELETE 8/12/85 SUBROUTINE DELETE( CURROW, CURCOL )  C---->SUBROUTINE DELETE DELETES ONE CHARACTER TO THE LEFT OF THEC CURSOR. IN THE OVERTYPE MODE, THE CHARACTER IS SET TO BLANK, C AND THE CURSOR MOVES ONE SPACE TO THE LEFT. IN THE INSERT MODE C THE CHARACTER IS ALSO SET TO BLANK, BUT THE REST OF THE LINE, C i.e., THAT PORTION TO THE RIGHT OF THE CURSOR IS 'DRAGGED ALONG' C TO THE LEFT ONE SPACE WITH THE CURSOR. THEN END OF THE FIELD IS  C SET TO ONE BLANKD SPACE ' '  IMPLICIT INTEGER( A - Z )  *----------------------------------------------------------------------- * ROUTINE : DELETE MODULE : FSCREN DATE : 7-AUG-85 *-----------------------------------------------------------------------* * * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER CURCOL, CURROW * * * * * ***** OUTPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION  * ------ ---- ----------- !* "* CURCOL INT CURRENT CURSOR COLUMN POSITION #* $* %* ***** VARIABLES NOT SET IN THIS ROUTINE ***** &* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** '* (* )* NAME TYPE DESCRIPTION ** ------ ---- ----------- +* ,* CURROW INT CURRENT CURSOR ROW POSITION - .*CALL FSEDIT/*CALL FSED 0*CALL FLDATT1*CALL WINDOW2 3*-----------------------------------------------------------------------4* LOCAL VARIABLES 5*-----------------------------------------------------------------------6* 7* 8 CHARACTER BELL*1 9* : INTEGER FORM, I, J, TRYCOL ;* <* =* >* ***** READ-ONLY VARIABLES ***** ?* @* A* NAME TYPE DESCRIPTION B* ------ ---- ----------- C* D* BELL INT ASCII CHARACTER NUMBER FOR 'BEL' E* F DATA BELL / 7 / G* H* ***** SET VARIABLES ***** I* J* K* NAME TYPE DESCRIPTION L* ------ ---- ----------- M* N* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR O* I INT FROM USING INDEX FUNCTIONP* J INT FROM USING INDEX FUNCTIONQ* TRYCOL INT TRIAL COLUMN NUMBER FOR FINDING AN UNPROTECTED R* COLUMN S* T* U*-----------------------------------------------------------------------V* PROCEDURESW*-----------------------------------------------------------------------X* Y* Z* ============ INTRINSIC FUNCTIONS ============ [* \* ]* ^* _ INTEGER INDEX `* a* ***** INTRINSIC FUNCTION DESCRIPTIONS *****b* c* d* NAME TYPE DESCRIPTION e* ------ ---- ----------- f* g* INDEX INT STANDARD FORTRAN INDEX FUNCTION h* i* j* ============ SUBROUTINES CALLED ============k* l* m EXTERNAL FSOUTn* o* p* ***** SUBROUTINE DESCRIPTIONS *****q* r* s* NAME DESCRIPTION t* ------ ----------- u* v* FSOUT WRITES A (PARTIAL) RECORD TO SCREEN AND SCREEN w* BUFFER x* y* z*-----------------------------------------------------------------------{* END OF DECLARATIONS|*-----------------------------------------------------------------------}* ~*   C BEGIN : DELETE RCDCHG( CURROW ) = 1 IF ( CURCOL .GT. 1 ) THEN TRYCOL = CURCOL - 1 FORM = MAPSCR( CURROW, TRYCOL ) I = INDEX( DISCHR( FORM ), 'TP' ) IF ( I .EQ. 0 ) THEN  IF ( MODE .EQ. 'OVERTYPE' ) THEN CURCOL = TRYCOL  SCRBUF( CURROW )(CURCOL:CURCOL) = ' ' CALL FSOUT( ' ', CURROW, CURCOL, DISCHR( FORM ) ) ELSE IF ( MODE .EQ. ' INSERT ' ) THEN  J = INDEX( DISCHR( FORM ), 'HR' ) IF ( CURCOL .LE. ( FLDCO2( FORM ) + OFFSET ) .AND.  1 CURCOL .GT. ( FLDCO1( FORM ) + OFFSET ) .AND.  2 J .EQ. 0 ) THEN CURCOL = TRYCOL  SCRBUF( CURROW ) = SCRBUF( CURROW )(1:CURCOL-1)//  1 SCRBUF( CURROW )(CURCOL+1:FLDCO2(FORM)+OFFSET ) CALL FSOUT( SCRBUF( CURROW )(CURCOL:FLDCO2(FORM)+  1 OFFSET ), CURROW, CURCOL, DISCHR( FORM ) ) END IF END IF ELSE PRINT 200, BELL 200 FORMAT( A ) END IF  ELSE PRINT 200, BELL END IF  RETURN  END  EXTERNAL WRTRCD * * * EDCHAR 8/12/85  SUBROUTINE EDCHAR( CURROW, CURCOL, WCOLMS, IQUERY )  SUBROUTINE EDCHAR( CURROW, CURCOL, KEY, WCOLMS, IQUERY )  C---->SUBROUTINE EDCHAR ( EDIT CHARACTER ) INITIATES THE PROCESSING C OF A PRINTABLE OR NONPRINTABLE CHARACTER SENT FROM THE KEYBOARD.   IMPLICIT INTEGER ( A - Z ) *----------------------------------------------------------------------- * ROUTINE : EDCHAR MODULE : FSCREN DATE : 7-AUG-85 *----------------------------------------------------------------------- *  *  * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER KEY*1  INTEGER CURCOL, CURROW, IQUERY, WCOLMS * * * * * ***** VARIABLES NOT SET IN THIS ROUTINE ***** * ***** WHICH ARE PASSED TO OTHER ROUTINES ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * CURCOL INT CURRENT CURSOR COLUMN POSITION  * CURROW INT CURRENT CURSOR ROW POSITION !* IQUERY INT RETURNS BUTTON NUMBER TO DRIVER PROGRAM * KEY CHAR ASCII SYMBOL OF KEY PRESSED "* WCOLMS INT MAXIMUM COLUMN WIDTH IN USABEL SPACES# $*CALL VARS % &* '*-----------------------------------------------------------------------(* PROCEDURES)*-----------------------------------------------------------------------** +* ,* ============ SUBROUTINES CALLED ============-* .* / EXTERNAL PRTCHR 0 EXTERNAL SPECHR 1* 2* 3* ***** SUBROUTINE DESCRIPTIONS *****4* 5* 6* NAME DESCRIPTION 7* ------ ----------- 8* 9* PRTCHR PRINTS A CHARACTER TO SCREEN AND SCREEN BUFFER :* AT CURROW, CURCOL;* SPECHR HANDLES NONPRINTABLE, ASCII CHARACTER(S) WHEN<* ENTERED FROM KEYBOARD=* >* ?*-----------------------------------------------------------------------@* END OF DECLARATIONSA*-----------------------------------------------------------------------B* C* D EC BEGIN : EDCHARF G IF ( KEYNUM .GT. 31 .AND. KEYNUM .NE. 127 ) THEN H IC A PRINTABLE CHARACTER SENT FROM KEYBOARD J K CALL PRTCHR( CURROW, CURCOL )  CALL PRTCHR( CURROW, CURCOL, KEY ) L ELSE M NC A NONPRINTABLE OR SPECIAL CHARACTER SENT FROM KEYBOARD O P CALL SPECHR( CURROW, CURCOL, WCOLMS, IQUERY )  CALL SPECHR( CURROW, CURCOL, KEY, WCOLMS, IQUERY ) Q END IFR S RETURNT U END *-------------------------------------------EDTEXT 8/12/85 SUBROUTINE EDTEXT( ROW, COLUMN, WCOLMS, IQUERY )  C---->SUBROUTINE EDTEXT ( EDIT TEXT ) IS THE ENTRY SUBROUTINE FOR C EDITING THE TEXT, BOTH ON THE SCREEN AND THE SCREEN BUFFER. C SEVERAL VARIABLE ARE INITIALIZED, THE STATUS LINE IS ESTABLISHED C AND UPDATED, AND CURSOR IS MOVED TO ITS INITIAL POSITION.   IMPLICIT INTEGER( A - Z )   *----------------------------------------------------------------------- * ROUTINE : EDTEXT MODULE : FSCREN DATE : 7-AUG-85 *----------------------------------------------------------------------- * * * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER COLUMN, IQUERY, ROW, WCOLMS * * * * * ***** INPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- *  * COLUMN INT CURSOR COLUMN!* ROW INT CURSOR ROW "* #* $* ***** VARIABLES NOT SET IN THIS ROUTINE ***** %* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** &* '* (* NAME TYPE DESCRIPTION )* ------ ---- ----------- ** +* IQUERY INT HAS 'BUTTON' NUMBER FOR DRIVER PROGRAM ,* WCOLMS INT MAXIMUM USABLE WIDTH OF SCREEN -* . /*CALL FSEDIT0*CALL STAINF 1*CALL SYSPAR2*CALL FLDATT3*CALL FSED 4*CALL VARS 5*CALL WINDOW6* 7*-----------------------------------------------------------------------8* LOCAL VARIABLES 9*-----------------------------------------------------------------------:* ;* < CHARACTER TABNO*1  CHARACTER TABNO*1, KEY*1=* > INTEGER CURCOL, CURROW, FORM, SHOCOL ?* @ LOGICAL NWFLAG, WFLAG A* B* C* D* ***** SET VARIABLES ***** E* F* G* NAME TYPE DESCRIPTION H* ------ ---- ----------- I* J* CURCOL INT CURRENT CURSOR COLUMN POSITION K* CURROW INT CURRENT CURSOR ROW POSITION L* FORM INT SUBSCRIPT FOR ARRAYS FORM FROM ARRAY MAPSCR * KEY CHAR ASCII SYMBOL OF KEY PRESSED M* NWFLAG LOG NO-WRITE FLAG FOR STATUS LINEN* SHOCOL INT CALCULATED COLUMN FOR CURSOR POSITIONO* TABNO CHAR NUMBER OF TAB SPACES FOR CURRENT FIELD P* WFLAG LOG WRITE FLAG FOR STATUS LINE Q* R* S*-----------------------------------------------------------------------T* PROCEDURESU*-----------------------------------------------------------------------V* W* X* ============ INTRINSIC FUNCTIONS ============ Y* Z* [* \* ] INTEGER INDEX ^* _* ***** INTRINSIC FUNCTION DESCRIPTIONS *****`* a* b* NAME TYPE DESCRIPTION c* ------ ---- ----------- d* e* INDEX INT STANDARD FORTRAN INDEX FUNCTION f* g* h* ============ SUBROUTINES CALLED ============i* j* k EXTERNAL EDCHAR l EXTERNAL GETKEY m EXTERNAL PUTSCR n EXTERNAL SCANOF o EXTERNAL SCREEN p* q* r* ***** SUBROUTINE DESCRIPTIONS *****s* t* u* NAME DESCRIPTION v* ------ ----------- w* x* EDCHAR EDIT CHARACTER y* GETKEY THE ASCII EQUIVALENT OF LAST KEYSTROKE z* PUTSCR WRITES CHARACTER STRING TO SCREEN AND SCREEN {* BUFFER AT DESIGNATED POSITION AND FORMAT |* SCANOF CALCULATES CURSOR COLUMN OFFSET }* SCREEN MANIPULATES THE SCREEN ATTRIBUTES~* * *-----------------------------------------------------------------------* END OF DECLARATIONS*-----------------------------------------------------------------------* *  C BEGIN : EDTEXT C... PRINT STATUS LINE  BUF = ' '  CALL PUTSCR( BUF(1:TERMCL), SWBOT+1, 1, 2 )  CALL PUTSCR( 'LINE', SWBOT+1, 9, 2 )  CALL PUTSCR( 'COL', SWBOT+1, 22, 2 )  CALL PUTSCR( 'MODE', SWBOT+1, 40, 2 )  C... PRINT HELP LINE BUF = 'HELP:' BUF(TERMCL:TERMCL) = ']'  CALL PUTSCR( BUF(:TERMCL), SWBOT+2, 1, 8 ) C ... INITIALIZE VARIABLES C CURROW AND CURCOL AR CURRENT ROW AND CURRENT COLUMN VARIABLES C FOR FSCREN. THEY ARE UPDATED FOR EVERY CURSOR MOVEMENT.  CURROW = ROW CURCOL = COLUMN OFFSET = 0 SHOCOL = COLUMN - OFFSET CFLAG = .FALSE. NWFLAG = .FALSE. ENDEDT = .FALSE. MODE = 'OVERTYPE' INSERT = .FALSE.  C---->THE 'LOOP' STARTING AT LABEL 100 DOWN TO THE 'GO TO 100' STATEMENTC IS OPERATIVE UNTIL ENDEDT GOES 'TRUE'. ENDEDT IS SET IN SUBROUTINC SPECHR ( SPECIAL CHARACTER ).  C---->ANNOTATE STATUS LINE WITH CURRENT CURSOR POSITION AND EDIT MODE   100 CALL SCREEN( 12, SWBOT+1, 14 ) PRINT 200, CURROW 200 FORMAT( '+', $, I2 )  CALL SCREEN( 12, SWBOT+1, 26 ) PRINT 200, SHOCOL  CALL PUTSCR( MODE, SWBOT+1, 45, 0 )   IF ( CFLAG .AND. .NOT. WFLAG ) THEN  CALL PUTSCR( ' ', SWBOT+1, 60, 2 )  CALL PUTSCR( ' FIELD FULL ', SWBOT+1, 60, 0 ) WFLAG = .TRUE. NWFLAG =.FALSE. END IF IF ( .NOT. CFLAG .AND. .NOT. NWFLAG ) THEN CALL PUTSCR( ' ', SWBOT+1, 60, 2 ) WFLAG = .FALSE. NWFLAG = .TRUE. END IF CFLAG = .FALSE.  C---->COMPOSE 'HELP/INFORMATION' LINE AND PRINT TO SCREEN  FLDINF = ' ' FLDINF(71:71) = ']' FORM = MAPSCR( CURROW, CURCOL ) FLDESR = RECTYP( FORM ) FLDFMR = FMTTYP( FORM ) LOFLD = LOVAL( FORM ) HIFLD = HIVAL( FORM ) FLDHLR = TITLE( FORM )  WRITE( TABNO, FMT = 300 ) TABSPC( FORM ) 300 FORMAT( I1 )  IF ( TABNO .EQ. '0' ) TABNO = '*' FLDINF = '['//  1 FLDESR(1:8)//'] '//  2 FLDFMR(:INDEX(FLDFMR, '++')-1)//' ['// 3 LOFLD(:INDEX(LOFLD, '++')-1)//'] ['//  4 HIFLD(:INDEX(HIFLD, '++')-1)//'] ['//  5 FLDHLR(:INDEX(FLDHLR, '++')-1)//'] ['//  6 'TAB SPACES = '//TABNO(1:1)//']'  CALL PUTSCR( FLDINF, SWBOT+2, 9, 8 )  C---->POSITION CURSOR   CALL SCREEN( 12, CURROW, CURCOL )  C---->USER STRIKES A KEY ON THE KEYBOARD TO FURTHER THE EDITING PROCESS   CALL GETKEY  CALL GETKEY( KEY ) KEYNUM = ICHAR( KEY )  C---->EDIT TEXT CHARACTER-BY-CHARACTER AND/OR MOVE CURSOR AND OPERATE C 'BUTTON' KEYS.  CALL EDCHAR( CURROW, CURCOL, WCOLMS, IQUERY )   C---->GET OFFSET FOR WRITING TO SCREEN   CALL SCANOF( CURROW, CURCOL, WCOLMS )   SHOCOL = CURCOL - OFFSET  IF ( .NOT. ENDEDT ) GO TO 100   RETURN  END  CALL EDCHAR( CURROW, CURCOL, KEY, WCOLMS, IQUERY )  C---->GET OFFSET FOR WRITING TO SCREEN   CALL SCANOF( CURROW, CURCOL, WCOLMS )   SHOCOL = CURCOL - OFFSET  IF ( .NOT. ENDEDT ) GO TO 100   RETURN END OR LOG N.P.S. ERROR ARGUMENT. b* QREADY LOG N.P.S. ERROR ARGUMENT. c* d e* f*-----------------------------------------------------------------------g* LOCAL VARIABLES h*-----------------------------------------------------------------------i* j* kFSEND 8/12/85  SUBROUTINE FSEND  C END FULL SCREEN EDITOR C SET KEYPAD TO NUMERIC, CLEAR SCREEN, AND CLEAR SCRBUF ( SCREENC BUFFER ) AND SAVBUF ( SAVE BUFFER )   IMPLICIT INTEGER( A - Z )  *----------------------------------------------------------------------- * ROUTINE : FSEND MODULE : $ DATE : 7-AUG-85  *----------------------------------------------------------------------- *  * *CALL WINDOW* *-----------------------------------------------------------------------* LOCAL VARIABLES *-----------------------------------------------------------------------* *  INTEGER K * * * * * ***** SET VARIABLES ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- *  * K INT DO-LOOP INDEX!* "* #*-----------------------------------------------------------------------$* PROCEDURES%*-----------------------------------------------------------------------&* '* (* ============ SUBROUTINES CALLED ============)* ** + EXTERNAL SCREEN ,* -* .* ***** SUBROUTINE DESCRIPTIONS *****/* 0* 1* NAME DESCRIPTION 2* ------ ----------- 3* 4* SCREEN MANIPULATES SCREEN ATTRIBUTES5* 6* 7*-----------------------------------------------------------------------8* END OF DECLARATIONS9*-----------------------------------------------------------------------:* ;* < = >C BEGIN : FSEND ? @ CALL SCREEN( 20 ) A CALL SCREEN( 22, 2 ) B C DO 100 K = 1, 25 D SCRBUF( K ) = ' ' E SAVBUF( K ) = ' ' F 100 CONTINUE G H RETURNI END ABLES ***** E* F* G* NAME TYPE DESCRIPTION H* ------ ---- ----------- I* J* CURCOL INT CURRENT CURSOR COLUMN POSITION K* CURROW INT FSETUP 8/12/85  SUBROUTINE FSETUP( WLINES, WCOLMS ) * * FULL SCREEN SET UP ROUTINE*   IMPLICIT INTEGER( A - Z )  *----------------------------------------------------------------------- * ROUTINE : FSETUP MODULE : FSCREN DATE : 7-AUG-85 *----------------------------------------------------------------------- *  *  * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER WCOLMS, WLINES * * * * * ***** OUTPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * WCOLMS INT MAXIMUM NUMBER OF USABLE SCREEN COLUMN * WLINES INT MAXIMUM NUMBER OF USABLE SCREEN ROWS  * !* "*CALL SPECAL#*CALL STAINF$*CALL WINDOW%* &*-----------------------------------------------------------------------'* LOCAL VARIABLES (*-----------------------------------------------------------------------)* ** + INTEGER CURLOC, I, K ,* -* .* ***** SET VARIABLES ***** /* 0* 1* NAME TYPE DESCRIPTION 2* ------ ---- ----------- 3* 4* I INT DO-LOOP INDEX5* K INT DO-LOOP INDEX6* 7* 8*-----------------------------------------------------------------------9* PROCEDURES:*-----------------------------------------------------------------------;* <* =* ============ SUBROUTINES CALLED ============>* ?* @ EXTERNAL FSSIZE A EXTERNAL SCREEN B EXTERNAL TRMCHN C* D* E* ***** SUBROUTINE DESCRIPTIONS *****F* G* H* NAME DESCRIPTION I* ------ ----------- J* K* FSSIZE GET NUMBER OF COLUMNS AND ROWS OF THE VIDEO L* TERMINAL FROM THE SYSTEM M* SCREEN MANIPULATES SCREEN ATTRIBUTESN* TRMCHN ASSIGNS A CHANNEL TO THE TERMINALO* P* Q*-----------------------------------------------------------------------R* END OF DECLARATIONSS*-----------------------------------------------------------------------T* U* V WC BEGIN : FSETUPX YC... SET DEFAULT VALUES, RESERVING BOTTOM 2 ROWS FOR STATUS LINES Z [ CALL FSSIZE( TERMRO, TERMCL ) \ TERMCL = TERMCL - 1 ] MARGIN = 0 ^ SWTOP = 1 _ SWBOT = TERMRO-2 ` FWTOP = 1 a FWBOT = SWBOT b WLINES = SWBOT c WCOLMS = TERMCL d eC... BLANK OUT THE SCREEN IMAGE DATA STRUCTURE f DO 10 I = SWTOP, SWBOT g SCRBUF(I) = ' ' h SCRFOR(I) = ' ' i 10 CONTINUE j kC... SET SPECIAL (CONTROL) CHARACTERS l NUL = CHAR( 0) m BS = CHAR( 8) n TAB = CHAR( 9) o LF = CHAR(10) p CR = CHAR(13) q ESC = CHAR(27) r DEL = CHAR(127) s BELL = CHAR(7) t BEE = CHAR( 66 ) u vC---->ASSIGN AN I/O CHANNEL FOR DIRECT I/O TO VIDEO TERMINALw x CALL TRMCHN y zC... Set keypad to application { | CALL SCREEN( 19 ) } ~C... CLEAR SCREEN  CALL SCREEN( 1 )  * Initial Current Cursor Location * 1 -- Home Base * 2 -- Margin * 3 -- Data/File Text Area  DO 30 I = 1, 25  DO 20 K = 1, 133 MAPSCR( I, K ) = 0 20 CONTINUE  30 CONTINUE   RETURN END  ------------------------------------------------* *  C BEGIN : EDTEXT C... PRINT STATUS LINE  FSOUT 8/12/85 SUBROUTINE FSOUT( TEXT, CURROW, CURCOL, FLDHLT )  C... Purpose: To write text to screen with WSCC attributes  IMPLICIT INTEGER( A - Z )  *-----------------------------------------------------------------------* ROUTINE : FSOUT MODULE : FSOUT DATE : 7-AUG-85  *----------------------------------------------------------------------- *  *  *  *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER FLDHLT*(*), TEXT*(*) *  INTEGER CURCOL, CURROW * * * * * ***** INPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * FLDHLT CHAR FIELD ATTRIBUTES TO BE USED IN PRINTING TEXT  * TEXT CHAR STRING TO BE WRITTEN AT CURROW, CURCOL !* "* #* ***** VARIABLES NOT SET IN THIS ROUTINE ***** $* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** %* &* '* NAME TYPE DESCRIPTION (* ------ ---- ----------- )* ** CURCOL INT CURRENT CURSOR COLUMN POSITION +* CURROW INT CURRENT CURSOR ROW POSITION ,* -*-----------------------------------------------------------------------.* LOCAL VARIABLES /*-----------------------------------------------------------------------0* 1* 2 INTEGER EIGHT, FOUR, ONE, TWO, ZERO 3* 4* 5* ***** READ-ONLY VARIABLES ***** 6* 7* 8* NAME TYPE DESCRIPTION 9* ------ ---- ----------- :* ;* EIGHT INT INTEGER 8 <* FOUR INT INTEGER 4 =* ONE INT INTEGER 1 >* TWO INT INTEGER 2?* ZERO INT ZERO ( 0 ) @* A* B*-----------------------------------------------------------------------C* PROCEDURESD*-----------------------------------------------------------------------E* F* G* ============ INTRINSIC FUNCTIONS ============ H* I* J* K* L INTEGER INDEX M* N* ***** INTRINSIC FUNCTION DESCRIPTIONS *****O* P* Q* NAME TYPE DESCRIPTION R* ------ ---- ----------- S* T* INDEX INT STANDARD FORTRAN INDEX FUNCTION U* V* W* ============ SUBROUTINES CALLED ============X* Y* Z EXTERNAL SCREEN [* \* ]* ***** SUBROUTINE DESCRIPTIONS *****^* _* `* NAME DESCRIPTION a* ------ ----------- b* c* SCREEN MANIPULATES SCREEN ATTRIBUTESd* e* f*-----------------------------------------------------------------------g* DATA INITIALIZATIONh*-----------------------------------------------------------------------i* j* k DATA EIGHT /8/ l DATA FOUR /4/ m DATA ONE /1/ n DATA TWO /2/ o DATA ZERO /0/ p* q* r*-----------------------------------------------------------------------s* END OF DECLARATIONSt*-----------------------------------------------------------------------u* v* wC BEGIN : FSOUT x yC... Do not print invisible information z IF ( INDEX(FLDHLT,'TI') .GT. 0 ) RETURN { |C... Turn off all attributes } CALL SCREEN( 11, 0 ) ~ C... Turn on bold  IF ( INDEX(FLDHLT,'HB') .GT. 0 ) CALL SCREEN( 11, 1 )  C... Turn on reverse IF ( INDEX(FLDHLT,'HR') .GT. 0 ) CALL SCREEN( 11, 7 )  C... Turn on blink  IF ( INDEX(FLDHLT,'HF') .GT. 0 ) CALL SCREEN( 11, 5 )  C... Turn on underscore  IF ( INDEX(FLDHLT,'HU') .GT. 0 ) CALL SCREEN( 11, 4 )    CALL SCREEN( 12, CURROW, CURCOL ) PRINT 10, TEXT 10 FORMAT( '+', $, A )  C... Turn off all attributes CALL SCREEN( 11, 0 )   RETURN END  ', SWBOT+1, 40, 2 )  C... PRINT HELP LINE BUF = 'HELP:' BUF(TERMCL:TERMCL) = ']'  CALL PUTSCR( BUF(:TERMCL),FSSIZE 8/12/85  SUBROUTINE FSSIZE( TERMRO, TERMCL )  C---->SUBROUTINE FSSIZE ( FULL-SCREEN SIZE ) GET FROM THE SYSTEMC THE NUMBER OF ROWS AND COLUMNS OF THE VIDEO TERMINAL THAT C CAN BE DISPLAYED.  *-----------------------------------------------------------------------* ROUTINE : FSSIZE MODULE : FSCREN DATE : 7-AUG-85 *----------------------------------------------------------------------- *  *  *  *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER TERMCL, TERMRO * * * * * ***** OUTPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * TERMCL INT NUMBER OF TERMINAL COLUMNS * TERMRO INT NUMBER OF TERMINAL ROWS *  * !*-----------------------------------------------------------------------"* LOCAL VARIABLES #*-----------------------------------------------------------------------$* %* & INTEGER*2 COLS, DEVTYP, FLAGS, ROWS '* (* )* ** +* ***** VARIABLES NOT SET IN THIS ROUTINE ***** ,* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** -* .* /* NAME TYPE DESCRIPTION 0* ------ ---- ----------- 1* 2* COLS INT NUMBER OF TERMINAL COLUMNS FROM SYSTEM 3* DEVTYP INT PARAMETER REQUIRED BY LIB$SCREEN_INFO4* FLAGS INT PARAMETER REQUIRED BY LIB$SCREEN_INFO5* ROWS INT NUMBER OF TERMINAL ROWS FROM SYSTEM 6* 7*-----------------------------------------------------------------------8* PROCEDURES9*-----------------------------------------------------------------------:* ;* <* ============ INTRINSIC FUNCTIONS ============ =* >* ?* @* ***** INTRINSIC FUNCTION DESCRIPTIONS *****A* B* C* NAME TYPE DESCRIPTION D* ------ ---- ----------- E* F* SCREEN FUNC RETURNS SCREEN INFORMATION FROM THE SYSTEM G* H* I*-----------------------------------------------------------------------J* END OF DECLARATIONSK*-----------------------------------------------------------------------L* M* N OC BEGIN : FSSIZEP Q CALL LIB$SCREEN_INFO( FLAGS, DEVTYP, COLS, ROWS ) R TERMRO = ROWS S TERMCL = COLS T U RETURNV END * Z EXTERNAL SCREEN [* \* ]* ***** SUBROUTINE DESCRIPTIONS *****^* _* `* NAME DESCRIPTION a* ------ ----------- GETKEY 8/12/85  SUBROUTINE GETKEY  SUBROUTINE GETKEY( KEY )  C... Purpose: To get any key that has been struck on the C keyboard.  *-----------------------------------------------------------------------* ROUTINE : GETKEY MODULE : FSCREN DATE : 7-AUG-85 *----------------------------------------------------------------------- *  *  *CALL SYSPAR *  *-----------------------------------------------------------------------* LOCAL VARIABLES *-----------------------------------------------------------------------* *  INTEGER IO_RDN   CHARACTER KEY*1 * * * * * ***** SET VARIABLES ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * IO_RDNE INT PARAMETER REQUIRED BY SYS$QIOW FUNCTION * KEY CHAR CHARACTER FROM KEYBOARD * *  *-----------------------------------------------------------------------!* PROCEDURES"*-----------------------------------------------------------------------#* $* %* ============ SUBROUTINES CALLED ============&* '* ( EXTERNAL IO$M_NOECHO ) EXTERNAL IO$M_NOFILTR * EXTERNAL IO$_READLBLK +* ,* -* ***** SUBROUTINE DESCRIPTIONS *****.* /* 0* NAME DESCRIPTION 1* ------ ----------- 2* 3* NOECHO 'NO ECHO' PARAMETER DIRECTIVE4* NOFILTR 'NO FILTER' PARAMETER DIRECTIVE 5* READLBLK READ LOGICAL BLOCK PARAMETER DIRECTIVE 6* 7* 8*-----------------------------------------------------------------------9* END OF DECLARATIONS:*-----------------------------------------------------------------------;* <* = > ? IO_RDNE = %LOC( IO$_READLBLK ) .OR. %LOC( IO$M_NOECHO ) .OR. @ 1 %LOC( IO$M_NOFILTR )A B CALL SYS$QIOW( , %VAL( TERMCH ), %VAL( IO_RDNE ), C 1 IOSB,,, %REF( KEY ), D 2 %VAL(1),,,, )E F 100 RETURNG END C ... INITIALIZE VARIABLES C CURROW AND CURCOL AR CURRENT ROW AND CURRENT COLUMN VARIABLES C FOR FSCREN. THEY ARE UPDATED FOR EVERY CURSOR MOVEMENT.  CURROW = ROW CURCOL = COLUMN OFFSET = 0 SHOCOL = COLUMN - OFFSET CFLAG = .FALSE. HOMCUR 8/12/85  SUBROUTINE HOMCUR( CURROW, CURCOL, WCOLMS )  C---->SUBROUTINE HOMCUR ( HOME CURSOR ) MOVES THE CURSOR FROM ITS C CURRENT POSITION TO THE UPPER MOST AND LEFT MOST OPEN POSITIONC AVAILABLE, i.e., NOT PROTECTED AND ALLOWED CHARACTER SPACE.   IMPLICIT INTEGER( A - Z ) *----------------------------------------------------------------------- * ROUTINE : HOMCUR MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  *  * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER CURCOL, CURROW, WCOLMS * * * * * ***** INPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * WCOLMS INT MAXIMUM SCREEN COLUMNS WIDTH *  * !* ***** OUTPUT ARGUMENT DESCRIPTIONS ***** "* #* $* NAME TYPE DESCRIPTION %* ------ ---- ----------- &* '* CURCOL INT CURRENT CURSOR COLUMN POSITION (* CURROW INT CURRENT CURSOR ROW POITION )* ** +*-----------------------------------------------------------------------,* LOCAL VARIABLES -*-----------------------------------------------------------------------.* /* 0* 1 INTEGER FORM, I, TRYCOL, TRYROW 2* 3* 4* 5* ***** SET VARIABLES ***** 6* 7* 8* NAME TYPE DESCRIPTION 9* ------ ---- ----------- :* ;* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR <* I INT VALUE FROM INDEX FUNCTION=* TRYCOL INT TRIAL COLUMN NUMBER USED FOR FINDING UNPROTECTED >* SPACE?* TRYROW INT TRIAL ROW NUMBER USED FOR FINDING UNPORTECTED @* SPACEA* B C*CALL FSEDITD*CALL FLDATTE*CALL WINDOWF G* H*-----------------------------------------------------------------------I* PROCEDURESJ*-----------------------------------------------------------------------K* L* M* ============ INTRINSIC FUNCTIONS ============ N* O* P* Q* R INTEGER INDEX S* T* ***** INTRINSIC FUNCTION DESCRIPTIONS *****U* V* W* NAME TYPE DESCRIPTION X* ------ ---- ----------- Y* Z* INDEX INT STANDARD FORTRAN INDEX FUNCTION [* \* ]* ============ SUBROUTINES CALLED ============^* _* ` EXTERNAL SCREEN a* b* c* ***** SUBROUTINE DESCRIPTIONS *****d* e* f* NAME DESCRIPTION g* ------ ----------- h* i* SCREEN MANIPULATES SCREEN ATTRIBUTESj* k* l*-----------------------------------------------------------------------m* END OF DECLARATIONSn*-----------------------------------------------------------------------o* p* qC BEGIN : HOMCURr s TRYROW = 0 t 100 TRYROW = TRYROW + 1 u IF ( TRYROW .GT. SWBOT ) RETURN v TRYCOL = 1w 200 FORM = MAPSCR( TRYROW, TRYCOL ) x IF ( FORM .EQ. 0 ) GO TO 100 y I = INDEX( DISCHR( FORM ), 'TP' ) z { IF ( I .NE. 0 ) THEN | TRYCOL = FLDCO2( FORM ) + 1} IF ( TRYCOL .GT. WCOLMS ) GO TO 100 ~ GO TO 200  END IF CURROW = TRYROW CURCOL = TRYCOL  CALL SCREEN( 12, CURROW, CURCOL )   RETURN  END  'HF') .GT. 0 ) CALL SCREEN( 11, 5 )  C... Turn on underscore  IF ( INDEX(FLDHLT,'HU') .GT. 0 ) CALL SCREEN( 11, 4 )    CALL SCREEN( 12, CURROW, CURCOL ) PRINT 10, TEXT 1KEYPAD 8/12/85 SUBROUTINE KEYPAD( CURROW, CURCOL, WCOLMS, IQUERY )  SUBROUTINE KEYPAD( CURROW, CURCOL, KEY, WCOLMS, IQUERY )  C---->SUBROUTINE KEYPAD PROCESSES KEYPAD AND 'BUTTON' KEYS FOR THE C SLIB FULL SCREEN EDITOR   IMPLICIT INTEGER( A - Z ) *-----------------------------------------------------------------------* ROUTINE : KEYPAD MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  *  *  *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER KEY*1  INTEGER CURCOL, CURROW, IQUERY, WCOLMS * * * * * ***** OUTPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * IQUERY INT RETURNS 'BUTTON' KEY VALUE TO DRIVER * KEY CHAR ASCII SYMBOL FOR KEY PRESSED * *  * ***** VARIABLES NOT SET IN THIS ROUTINE ***** !* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** "* #* $* NAME TYPE DESCRIPTION %* ------ ---- ----------- &* '* CURCOL INT CURRENT CURSOR COLUMN POSITION (* CURROW INT CURRENT CURSOR ROW POSITION )* WCOLMS INT MAXIMUM SCREEN COLUMN WIDTH ** + ,*CALL FSEDIT-*CALL FLDATT .*CALL SYSPAR/*CALL FSED 0*CALL STAINF1*CALL VARS 2*CALL WINDOW3 4* 5*-----------------------------------------------------------------------6* LOCAL VARIABLES 7*-----------------------------------------------------------------------8* 9* : INTEGER ENDCOL, FORM, I, K ;* <* =* >* ?* ***** SET VARIABLES ***** @* A* B* NAME TYPE DESCRIPTION C* ------ ---- ----------- D* E* ENDCOL INT END COLUMN OF CURRENT FIELD OF CURRENT RECORDF* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR G* I INT VALUE FROM INDEX FUNCTIONH* K INT DO-LOOP RUNNING INDEXI* J* K*-----------------------------------------------------------------------L* PROCEDURESM*-----------------------------------------------------------------------N* O* P* ============ INTRINSIC FUNCTIONS ============ Q* R* S* T* U INTEGER INDEX V* W* ============ SUBROUTINES CALLED ============X* Y* Z EXTERNAL CURDWN [ EXTERNAL HOMCUR \ EXTERNAL RFRSCR ] EXTERNAL SCANOF ^ EXTERNAL SCREEN _* `* a* ***** SUBROUTINE DESCRIPTIONS *****b* c* d* NAME DESCRIPTION e* ------ ----------- f* g* CURDWN TRACKS AND MOVES CURSOR DOWN h* HOMCUR TRACKS AND MOVES CURSOR TO HOME POSITION i* RFRSCR REFRESHES SCREEN FROM SAVBUF (SAVE BUFFER) j* SCANOF SCANS CURRENT ROW FOR POSSIBLE CURSOR OFFSET k* SCREEN MANIPULATES SCREEN ATTRIBUTESl* m* n*-----------------------------------------------------------------------o* END OF DECLARATIONSp*-----------------------------------------------------------------------q* r* sC BEGIN : KEYPADt u IF ( INDEX('qrstuvwxymPQ', KEY) .NE. 0 ) THEN vC 1, 2, ..., 9, -, PF1, PF2 KEY ON KEYPAD; a 'BUTTON' keyw IQUERY = INDEX('qrstuvwxymPQ', KEY) x ENDEDT = .TRUE.y z ELSE IF ( INDEX( 'plnMRS', KEY ) .EQ. 1 ) THEN{C 0, ,, ., ENTER, PF3, PF4 KEY ON KEYPAD |C CURSOR DOWN 1 LINE AND TO LEFT MARGIN, KEYPAD 'ENTER' KEY } KEY = 'Z' ~ CALL CURDWN( CURROW, CURCOL, WCOLMS )  CALL CURDWN( CURROW, CURCOL, KEY, WCOLMS )   ELSE IF ( INDEX( 'plnMRS', KEY ) .EQ. 2 ) THENC RESTORE ORIGINAL TEXT TO SCREEN SINCE LAST 'REFRESH'. CALL RFRSCR( WCOLMS )  CALL SCREEN( 12, CURROW, CURCOL ) IQUERY = 0 ENDEDT = .FALSE.   ELSE IF ( INDEX( 'plnMRS', KEY ) .EQ. 3 ) THENC BLANK FILL FROM CURSOR TO END OF CURRENT LINE  FORM = MAPSCR( CURROW, CURCOL ) CALL SCANOF( CURROW, CURCOL, WCOLMS )   IF ( OFFSET .EQ. FLDCO2( FORM ) ) THEN  ENDCOL = FLDCO2( FORM ) ELSE  ENDCOL = FLDCO2( FORM ) + OFFSET END IF   SCRBUF( CURROW )( CURCOL:ENDCOL ) = ' ' I = INDEX( DISCHR( FORM ), 'HR' )  IF ( I .NE. 0 ) CALL SCREEN( 11, 7, 0 )  DO 200 K = CURCOL, ENDCOL  CALL SCREEN( 12, CURROW, K ) PRINT 100, ' ' 100 FORMAT( '+', $, A1 ) 200 CONTINUE  CALL SCREEN( 11, 0, 0 ) CALL SCREEN( 12, CURROW, CURCOL ) RCDCHG( CURROW ) = 1  ELSE IF ( INDEX( 'plnMRS', KEY ) .EQ. 4 ) THENC TOGGLE 'INSERT' <---> 'OVERTYPE', ENTER KEYPAD KEY  IF ( MODE .EQ. 'OVERTYPE' ) THEN MODE = ' INSERT ' INSERT = .TRUE. ELSE MODE = 'OVERTYPE' INSERT = .FALSE. END IF  ELSE IF ( INDEX( 'plnMRS', KEY ) .EQ. 5 ) THENC GO TO BOTTOM-LEFT MOST COLUMN OF SCREEN AREA C SET KEY = 'B' FOR BOTTOM OF TEXT AREA KEY = 'B'  CALL CURDWN( CURROW, CURCOL, WCOLMS )  CALL CURDWN( CURROW, CURCOL, KEY, WCOLMS )   ELSE IF ( INDEX('plnMRS', KEY) .EQ. 6 ) THEN C PF4 KEY STRUCK ON KEYPAD, 'HOME' CURSOR MODE = 'OVERTYPE' INSERT = .FALSE.  CALL HOMCUR( CURROW, CURCOL, WCOLMS )   END IF  RETURN END WBOT+1, 9, 2 )  CALL PUTSCR( 'COL', SWBOT+1, 22, 2 )  CALL PUTSCR( 'MODE', SWBOT+1, 40, 2 )  C... PRINT HELP LINE LTAROW 8/12/85 SUBROUTINE LTAROW( CURROW, CURCOL )  C---->SUBROUTINE LTAROW ( LEFT ARROW ) MOVE THE CURSOR LEFT ONE C COLUMN IN THE TEXT AREA IF A 'LEGAL' SPACE IS AVAILABLE C WHEN THE LEFT ARROW KEY IS STRUCK   IMPLICIT INTEGER( A - Z ) *----------------------------------------------------------------------- * ROUTINE : LTAROW MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  *  * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER CURCOL, CURROW * * * * * ***** OUTPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * CURCOL INT CURRENT CURSOR COLUMN POSITION *  * !* ***** VARIABLES NOT SET IN THIS ROUTINE ***** "* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** #* $* %* NAME TYPE DESCRIPTION &* ------ ---- ----------- '* (* CURROW INT CURRENT CURSOR ROW POSITION )* * +*CALL FSEDIT,*CALL FLDATT-*CALL WINDOW. /* 0*-----------------------------------------------------------------------1* LOCAL VARIABLES 2*-----------------------------------------------------------------------3* 4* 5 CHARACTER BELL*1 6* 7 INTEGER FORM, I, TRYCOL 8* 9* :* ;* ***** READ-ONLY VARIABLES ***** <* =* >* NAME TYPE DESCRIPTION ?* ------ ---- ----------- @* A* BELL CHAR ASCII EQUIVALENT FOR 'BEL' B* C* D* ***** SET VARIABLES ***** E* F* G* NAME TYPE DESCRIPTION H* ------ ---- ----------- I* J* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR K* I INT VALUE OF INDEX FUNCTION L* TRYCOL INT TRIAL COLUMN USED TO FIND UNPROTECTED COLUMN M* N* O*-----------------------------------------------------------------------P* PROCEDURESQ*-----------------------------------------------------------------------R* S* T* ============ INTRINSIC FUNCTIONS ============ U* V* W* X* Y INTEGER INDEX Z* [* ***** INTRINSIC FUNCTION DESCRIPTIONS *****\* ]* ^* NAME TYPE DESCRIPTION _* ------ ---- ----------- `* a* INDEX INT STANDARD INDEX FUNCTION b* c* d* ============ SUBROUTINES CALLED ============e* f* g EXTERNAL SCREEN h* i* j* ***** SUBROUTINE DESCRIPTIONS *****k* l* m* NAME DESCRIPTION n* ------ ----------- o* p* SCREEN MANIPULATES SCREEN ATTRIBUTESq* r* s*-----------------------------------------------------------------------t* DATA INITIALIZATIONu*-----------------------------------------------------------------------v* w* x DATA BELL / 7 / y* z* {*-----------------------------------------------------------------------|* END OF DECLARATIONS}*-----------------------------------------------------------------------~* * C BEGIN : LTAROW TRYCOL = CURCOL  100 IF ( TRYCOL .GT. 1 ) THEN TRYCOL = TRYCOL - 1 FORM = MAPSCR( CURROW, TRYCOL ) I = INDEX( DISCHR( FORM ), 'TP' )  IF ( I .EQ. 0 ) THEN CURCOL = TRYCOL  CALL SCREEN( 12, CURROW, CURCOL ) ELSE GO TO 100 END IF   ELSE PRINT 200, BELL 200 FORMAT( '+', $, A )  END IF  RETURN END  )   IF ( OFFSET .EQ. FLDCO2( FORM ) ) THEN  ENDCOL = FLDCO2( FORM ) ELSE  ENDCOL = FLDCO2( FORM ) + OFFSET END IF  OVRTYP 8/12/85 SUBROUTINE OVRTYP( CURROW, CURCOL )  SUBROUTINE OVRTYP( CURROW, CURCOL, KEY )  C---->SUBROUTINE OVRTYP ( OVERTYPE ) OVER TYPES THE TEXT AT THE CURSOR C LOCATION WITH THE INPUT CHARACTER.  IMPLICIT INTEGER( A - Z ) *-----------------------------------------------------------------------* ROUTINE : OVRTYP MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  *  *  *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER KEY*1  INTEGER CURCOL, CURROW * * * * * ***** VARIABLES NOT SET IN THIS ROUTINE ***** * ***** WHICH ARE PASSED TO OTHER ROUTINES ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * CURCOL INT CURRENT CURSOR COLUMN POSITION * CURROW INT CURRENT CURSOR ROW POSITION * KEY CHAR ASCII SYMBOL OF KEY PRESSED  !*CALL FSEDIT"*CALL FLDATT#*CALL FSED $*CALL SYSPAR%*CALL STAINF&*CALL SPECAL'*CALL WINDOW( )* **-----------------------------------------------------------------------+* LOCAL VARIABLES ,*------------------------------------------------------------------------* .* / INTEGER FLDC1W, FLDC2W, FORM 0* 1* 2* 3* ***** SET VARIABLES ***** 4* 5* 6* NAME TYPE DESCRIPTION 7* ------ ---- ----------- 8* 9* FLDC1W INT BEGINNING COLUMN OF CURRENT FIELD:* FLDC2W INT END COLUMN OF CURRENT FIELD ;* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR <* =* >*-----------------------------------------------------------------------?* PROCEDURES@*-----------------------------------------------------------------------A* B* C* ============ SUBROUTINES CALLED ============D* E* F EXTERNAL FSOUT G EXTERNAL RTAROW H* I* J* ***** SUBROUTINE DESCRIPTIONS *****K* L* M* NAME DESCRIPTION N* ------ ----------- O* P* FSOUT WRITE (PARTIAL) RECORD TO SCREEN Q* RTAROW TRACKS AND MOVES CURSOR ONE SPACE RIGHT R* S* T*-----------------------------------------------------------------------U* END OF DECLARATIONSV*-----------------------------------------------------------------------W* X* YC BEGIN : OVRTYPZ [ CFLAG = .FALSE. \ FORM = MAPSCR( CURROW, CURCOL ) ] ^ IF ( MODE .EQ. 'OVERTYPE' ) THEN _ CALL FSOUT ( KEY, CURROW, CURCOL, DISCHR( FORM ) ) ` SCRBUF(CURROW)(CURCOL:CURCOL) = KEY a RCDCHG( CURROW ) = 1b IF ( MAPSCR( CURROW, CURCOL+1 ) .NE. 0 ) THEN c CALL RTAROW( CURROW, CURCOL ) d ELSE e CFLAG = .TRUE. f PRINT 1000, BELL g END IF h ELSE IF ( MODE .EQ. ' INSERT ' ) THEN i IF ( CURCOL .EQ. 1 ) THEN j FLDC2W = FLDCO2( FORM ) k IF ( SCRBUF(CURROW)(FLDC2W:FLDC2W) .EQ. ' ' ) THEN l SCRBUF( CURROW )(2:FLDC2W) = SCRBUF(CURROW) m 1 (1:FLDC2W-1) n SCRBUF( CURROW )(1:FLDC2W) = KEY o CALL FSOUT( SCRBUF(CURROW)(1:FLDC2W), CURROW,p 1 1, DISCHR(FORM) )q RCDCHG( CURROW ) = 1 r CALL RTAROW( CURROW, CURCOL ) s ELSE t PRINT 1000, BELL u CFLAG = .TRUE. v END IF w ELSE x FLDC1W = FLDCO1( FORM ) + OFFSETy FLDC2W = FLDCO2( FORM ) + OFFSETz IF ( SCRBUF( CURROW )(FLDC2W:FLDC2W) .EQ. ' ' )THEN { SCRBUF(CURROW)(:FLDC2W) = SCRBUF(CURROW)(:CURCOL-1) | 1 //KEY//SCRBUF(CURROW)(CURCOL:FLDC2W) } CALL FSOUT( SCRBUF(CURROW)(CURCOL:FLDC2W), ~ 1 CURROW, CURCOL, DISCHR( FORM ) )  RCDCHG( CURROW ) = 1  CALL RTAROW( CURROW, CURCOL ) ELSE PRINT 1000, BELL CFLAG = .TRUE. END IF END IF  ELSE PRINT 1000, BELL 1000 FORMAT( '+', $, A ) CFLAG = .TRUE.  END IF  RETURN END  MANIPULATES SCREEN ATTRIBUTESl* m* n*-----------------------------------------------------------------------o* END OF DECLARATIONSp*-------------------------------------------------------PRTCHR 8/12/85  SUBROUTINE PRTCHR( CURROW, CURCOL )  SUBROUTINE PRTCHR( CURROW, CURCOL, KEY )  C---->SUBROUTINE PRTCHR ( PRINT CHARACTER ) TAKES AN INCOMING C PRINTABLE (ASCII) CHARACTER AND WRITES IT TO THE SCREEN C TEXT AT THE CURRENT CURSOR POSITION AND TO THE SCREEN C BUFFER  IMPLICIT INTEGER( A - Z )  *----------------------------------------------------------------------- * ROUTINE : PRTCHR MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  * * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER KEY*1  INTEGER CURCOL, CURROW * * * * * ***** VARIABLES NOT SET IN THIS ROUTINE ***** * ***** WHICH ARE PASSED TO OTHER ROUTINES ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- *  * CURCOL INT CURRENT CURSOR COLUMN POSITION !* CURROW INT CURRENT CURSOR ROW POSITION * KEY CHAR ASCII SYMBOL OF KEY PRESSED "* #* $*-----------------------------------------------------------------------%* LOCAL VARIABLES &*-----------------------------------------------------------------------'* (* ) CHARACTER BELL*1 ** + INTEGER FORM, I ,* -* .* ***** READ-ONLY VARIABLES ***** /* 0* 1* NAME TYPE DESCRIPTION 2* ------ ---- ----------- 3* 4* BELL CHAR ASCII EQUIVALENT OF 'BEL'5* 6* 7* ***** SET VARIABLES ***** 8* 9* :* NAME TYPE DESCRIPTION ;* ------ ---- ----------- <* =* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR >* I INT VALUE FROM INDEX FUNCTION?* @ A*CALL FSEDITB*CALL FLDATTC*CALL WINDOWD E* F*-----------------------------------------------------------------------G* PROCEDURESH*-----------------------------------------------------------------------I* J* K* ============ INTRINSIC FUNCTIONS ============ L* M* N* O* P INTEGER INDEX Q* R* ***** INTRINSIC FUNCTION DESCRIPTIONS *****S* T* U* NAME TYPE DESCRIPTION V* ------ ---- ----------- W* X* INDEX INT STANDARD FORTRAN INDEX FUNCTION Y* Z* [* ============ SUBROUTINES CALLED ============\* ]* ^ EXTERNAL OVRTYP _* `* a* ***** SUBROUTINE DESCRIPTIONS *****b* c* d* NAME DESCRIPTION e* ------ ----------- f* g* OVRTYP INSERTS TEXT INTO SCREEN AND SCREEN BUFFER h* i* j*-----------------------------------------------------------------------k* DATA INITIALIZATIONl*-----------------------------------------------------------------------m* n* o DATA BELL / 7 / p* q* r*-----------------------------------------------------------------------s* END OF DECLARATIONSt*-----------------------------------------------------------------------u* v* wC BEGIN : PRTCHRx yC CHECK TO SEE IF CURRENT LOCATION HAS AN 'A' FORMATz { FORM = MAPSCR( CURROW, CURCOL ) | I = INDEX( FMTTYP( FORM ), 'A' ) } ~ IF ( I .NE. 0 ) THEN  CALL OVRTYP( CURROW, CURCOL )  CALL OVRTYP( CURROW, CURCOL, KEY )  ELSE PRINT 100, BELL 100 FORMAT( '+' $, A )  END IF RCDCHG( CURROW ) = 1   RETURN END PRINT 1000, BELL u CFLAG = .TRUE. v END IF w PUTSCR 8/12/85  SUBROUTINE PUTSCR( TEXT, LINE, COL, ATT )  C... Purpose: To simulate vax system service routine SYS$PUT_SCREEN   IMPLICIT INTEGER( A - Z )  *-----------------------------------------------------------------------* ROUTINE : PUTSCR MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  *  *  *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER TEXT*(*) *  INTEGER ATT, COL, LINE * * * * * ***** INPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * ATT BYTE A VT-100 TERMINAL ATTRIBUTE  * TEXT CHAR A CHARACTER STRING TO BE WRITTEN TO THE !* SCREEN AT POSITION LINE, COL "* #* $* ***** VARIABLES NOT SET IN THIS ROUTINE ***** %* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** &* '* (* NAME TYPE DESCRIPTION )* ------ ---- ----------- ** +* COL INT CURSOR COLUMN POSITION ,* LINE INT CURSOR ROW POSITION -* .*-----------------------------------------------------------------------/* LOCAL VARIABLES 0*-----------------------------------------------------------------------1* 2* 3 BYTE EIGHT, FOUR, ONE, TWO, ZERO 4* 5* 6* 7* 8* ***** READ-ONLY VARIABLES ***** 9* :* ;* NAME TYPE DESCRIPTION <* ------ ---- ----------- =* >* EIGHT BYTE INTEGER 8 ?* FOUR BYTE INTEGER 4 @* ONE BYTE INTEGER 1 A* TWO BYTE INTEGER 2B* ZERO BYTE ZERO ( 0 ) C* D* E*-----------------------------------------------------------------------F* PROCEDURESG*-----------------------------------------------------------------------H* I* J* ============ SUBROUTINES CALLED ============K* L* M EXTERNAL SCREEN N* O* P* ***** SUBROUTINE DESCRIPTIONS *****Q* R* S* NAME DESCRIPTION T* ------ ----------- U* V* SCREEN MANIPULATES SCREEN ATTRIBUTESW* X* Y*-----------------------------------------------------------------------Z* DATA INITIALIZATION[*-----------------------------------------------------------------------\* ]* ^ DATA EIGHT / 8 / _ DATA FOUR / 4 / ` DATA ONE / 1 / a DATA TWO / 2 / b DATA ZERO / 0 / c* d* e*-----------------------------------------------------------------------f* END OF DECLARATIONSg*-----------------------------------------------------------------------h* i* j kC BEGIN : PUTSCRl m IF ( ATT .NE. ZERO ) THEN n CALL SCREEN (11,0) o IF ( (ATT .AND. ONE) .EQ. ONE ) CALL SCREEN( 11, 1 ) p IF ( (ATT .AND. TWO) .EQ. TWO ) CALL SCREEN( 11, 7 ) q IF ( (ATT .AND. FOUR) .EQ. FOUR ) CALL SCREEN( 11, 5 ) r IF ( (ATT .AND. EIGHT) .EQ. EIGHT ) CALL SCREEN( 11, 4 ) s END IFt u CALL SCREEN( 12, LINE, COL ) v PRINT 10, TEXT w 10 FORMAT( '+', $, A ) x y CALL SCREEN( 11, 0 ) z { RETURN| END } SE PRINT 100, BELL 100 FORMAT( '+' $, A )  END IF RCRDRECD 8/12/85  SUBROUTINE RDRECD( IFIELD, ROW, COLUMN, LENGTH, IQUERY, DATA ) C---->SUBROUTINE RDRECD ( READ A RECORD ) READS ONE RECORD FROM ARRAY C SCRBUF ( SCREEN BUFFER ) AT LINE ROW STARTING AT COLUMN FOR A C RANGE OF LENGTH. IF LINE HAS BEEN EDITED, IQUERY IS SET TO 1.  IMPLICIT INTEGER ( A - Z )  *----------------------------------------------------------------------- * ROUTINE : RDRECD MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  * * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER DATA*(*) *  INTEGER COLUMN, IFIELD, IQUERY, LENGTH, ROW* * * * * ***** UNREFERENCED ARGUMENTS ***** * * * IFIELD INT A FSCREN PARAMETER *  * !* ***** INPUT ARGUMENT DESCRIPTIONS ***** "* #* $* NAME TYPE DESCRIPTION %* ------ ---- ----------- &* '* COLUMN INT CURSOR COLUMN POSITION (* LENGTH INT LENGTH OF STRING PUT INTO PARAMETER DATA )* ROW INT CURSOR ROW POSITION ** +* ,* ***** OUTPUT ARGUMENT DESCRIPTIONS ***** -* .* /* NAME TYPE DESCRIPTION 0* ------ ---- ----------- 1* 2* DATA CHAR STRING RETURNED TO FSCREN DRIVER FROM SCRBUF 3* IQUERY INT INDICATES WHETHER DATA RECORD HAS BEEN EDITED4* 5 6*CALL WINDOW7 8* 9*-----------------------------------------------------------------------:* LOCAL VARIABLES ;*-----------------------------------------------------------------------<* =* >* ?* @* A* ***** SET VARIABLES ***** B* C* D* NAME TYPE DESCRIPTION E* ------ ---- ----------- F* G* LAST INT LAST COLUMN NUMBER OF STRING LOADED INTO DATAH* I* J*-----------------------------------------------------------------------K* END OF DECLARATIONSL*-----------------------------------------------------------------------M* N* OC BEGIN : RDRECDP Q IF ( RCDCHG( ROW ) .EQ. 1 ) IQUERY = 1 R LAST = COLUMN + LENGTH - 1S DATA = SCRBUF(ROW)(COLUMN:LAST) T SAVBUF(ROW)(COLUMN:LAST) = SCRBUF(ROW)(COLUMN:LAST) U RETURNV W END *-----------------------------------------------------------------------Z* DATA INITIALIZATION[*-----------------------------------------------------------------------\* ]* ^ DATA EIGHT / 8 / _ DATA FOUR / 4 / ` DATA OREBUFF 8/12/85  SUBROUTINE REBUFF  C---->SUBROUTINE REBUFF TAKES LINES IN SCRBUF THAT HAVE BEEN CHANGED, C i.e., EDITED AND COPYS THEM INTO SAVBUF.   IMPLICIT INTEGER( A - Z ) *-----------------------------------------------------------------------* ROUTINE : REBUFF MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *   *CALL WINDOW * *-----------------------------------------------------------------------* LOCAL VARIABLES *-----------------------------------------------------------------------* * * * ***** SET VARIABLES ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * I INT DO-LOOP RUNNING INDEX* * *-----------------------------------------------------------------------* END OF DECLARATIONS *-----------------------------------------------------------------------!* "* #C BEGIN : REBUFF$ % DO 100 I = 1, FWBOT & IF ( RCDCHG( I ) .EQ. 1 ) SAVBUF( I ) = SCRBUF( I ) ' 100 CONTINUE ( ) RETURN* + END ROW INT CURSOR ROW POSITION ** +* ,* ***** OUTPUT ARGUMENT DESCRIPTIONS ***** -* .* /* NAME TYPE DESCRIPTION 0* ------ ---- ----------- 1* 2* DATA CHAR STRING RETURNED TO FSCREN DRIVER FROM SCRBUF 3* IQUERY INT INDICRFRSCR 8/12/85  SUBROUTINE RFRSCR( WCOLMS )  C---->SUBROUTINE RFRSCR ( REFRESH SCREEN ) WRITES SAVBUF ( SAVEDC BUFFER )TO THE SCRBUF ( SCREEN BUFFER ) AND TO THE SCREEN.C THE WRITING IS MADE IF AND ONLY IF THE LINES HAVE BEEN EDITED.  IMPLICIT INTEGER( A - Z ) *----------------------------------------------------------------------- * ROUTINE : RFRSCR MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  *  * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER WCOLMS * * * * * ***** VARIABLES NOT SET IN THIS ROUTINE ***** * ***** WHICH ARE PASSED TO OTHER ROUTINES ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * WCOLMS INT MAXIMUM COLUMN WIDTH ON TERMINAL SCREEN  * ! "*CALL FSEDIT#*CALL FLDATT$*CALL WINDOW% &* '*-----------------------------------------------------------------------(* LOCAL VARIABLES )*-----------------------------------------------------------------------** +* , INTEGER BEG, FIN, FORM, I, K, OLDFRM -* . LOGICAL FIRST /* 0* 1* 2* 3* ***** SET VARIABLES ***** 4* 5* 6* NAME TYPE DESCRIPTION 7* ------ ---- ----------- 8* 9* BEG INT BEGINNING SCREEN COLUMN OF CURRENT FIELD :* FIN INT END SCREEN COLUMN OF CURRENT FIELD ;* FIRST LOG TRUE FOR FIRST FIELD IN CURRENT RECORD <* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR =* I INT DO-LOOP RUNNING INDEX>* K INT HOLDS FIRST COLUMN POSITION OF NEXT FIELD?* OLDFRM INT HOLDS LAST RECORD TYPE USED @* A* B*-----------------------------------------------------------------------C* PROCEDURESD*-----------------------------------------------------------------------E* F* G* ============ SUBROUTINES CALLED ============H* I* J EXTERNAL FSOUT K EXTERNAL SCANOF L* M* N* ***** SUBROUTINE DESCRIPTIONS *****O* P* Q* NAME DESCRIPTION R* ------ ----------- S* T* FSOUT WRITE (PARTIAL) RECORD TO VIDEO SCREEN U* SCANOF SCANS CURRENT ROW FOR COLUMN OFFSET V* W* X*-----------------------------------------------------------------------Y* END OF DECLARATIONSZ*-----------------------------------------------------------------------[* \* ]C BEGIN : RFRSCR^ _ IF ( FWBOT .GT. SWBOT ) FWBOT = SWBOT ` OLDFRM = 0a bC---->WRITE SAVBUF TO SCRBUF AND SCREEN IF CORRESPONDING LINES ARE cC NOT IDENTICAL d e DO 200 I = SWTOP, SWBOT f FIRST = .TRUE. g K = 1 h IF ( RCDCHG( I ) .EQ. 0 ) GO TO 200i SCRBUF( I ) = SAVBUF( I ) j RCDCHG( I ) = 0 k 100 FORM = MAPSCR( I, K ) l IF ( FORM .EQ. 0 ) GO TO 200 m IF ( FORM .NE. OLDFRM .AND. n 1 ( RECTYP( FORM ) .NE. 'DEFAULT' ) ) THEN o OLDFRM = FORM p CALL SCANOF( I, K, WCOLMS ) q r IF ( OFFSET .GT. 0 .AND. FIRST ) THEN s CALL FSOUT( SCRBUF(I)(1:2), I, 1, DISCHR( FORM ) ) t FIRST = .FALSE. u END IF v w BEG = FLDCO1( FORM ) + OFFSET x FIN = FLDCO2( FORM ) + OFFSET y CALL FSOUT( SCRBUF(I)(BEG:FIN), I, BEG, DISCHR(FORM) ) z K = FIN + 1 { GO TO 100 | END IF } 200 CONTINUE ~  RETURN END CALL FSOUT( SCRBUF(CURROW)(CURCOL:FLDC2W), ~ 1 CURROW, CURCOL, DISCHR( FORM ) )  RCDCHG( CURROW ) = 1  CALL RTAROW( CURROW, CURCOL ) RTAROW 8/12/85 SUBROUTINE RTAROW( CURROW, CURCOL )  C---->SUBROUTINE RTAROW ( RIGHT ARROW ) MOVES THE CURSOR RIGHT ONE C COLUMN IN THE TEXT AREA IF THERE IS A 'LEGAL' SPACE WHEN THE C RIGHT ARROW KEY IS STRUCK.  IMPLICIT INTEGER( A - Z )   *----------------------------------------------------------------------- * ROUTINE : RTAROW MODULE : RTAROW DATE : 8-AUG-85  *----------------------------------------------------------------------- *  * * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER CURCOL, CURROW * * * * * ***** OUTPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * CURCOL INT CURRENT CURSOR COLUMN POSITION  * !* "* ***** VARIABLES NOT SET IN THIS ROUTINE ***** #* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** $* %* &* NAME TYPE DESCRIPTION '* ------ ---- ----------- (* )* CURROW INT CURRENT CURSOR ROW POSITION ** + ,*CALL FSEDIT-*CALL FLDATT.*CALL STAINF/*CALL WINDOW0 1* 2*-----------------------------------------------------------------------3* LOCAL VARIABLES 4*-----------------------------------------------------------------------5* 6* 7 CHARACTER BELL*1 8* 9 INTEGER FORM, I, K, SAVCOL :* ;* <* =* ***** READ-ONLY VARIABLES ***** >* ?* @* NAME TYPE DESCRIPTION A* ------ ---- ----------- B* C* BELL CHAR ASCII EQUIVALENT OF 'BEL'D* E* F* ***** SET VARIABLES ***** G* H* I* NAME TYPE DESCRIPTION J* ------ ---- ----------- K* L* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR M* I INT VALUE FROM INDEX FUNCTIONN* K INT DO-LOOP RUNNING INDEXO* SAVCOL INT SAVES VALUE OF CURCOLP* Q* R*-----------------------------------------------------------------------S* PROCEDUREST*-----------------------------------------------------------------------U* V* W* ============ INTRINSIC FUNCTIONS ============ X* Y* Z* [* \ INTEGER INDEX ]* ^* ***** INTRINSIC FUNCTION DESCRIPTIONS *****_* `* a* NAME TYPE DESCRIPTION b* ------ ---- ----------- c* d* INDEX INT STANDARD FORTRAN INDEX FUNCTION e* f* g* ============ SUBROUTINES CALLED ============h* i* j EXTERNAL SCREEN k* l* m* ***** SUBROUTINE DESCRIPTIONS *****n* o* p* NAME DESCRIPTION q* ------ ----------- r* s* SCREEN MANIPULATES TERMINAL SCREEN ATTRIBUTES t* u* v*-----------------------------------------------------------------------w* DATA INITIALIZATIONx*-----------------------------------------------------------------------y* z* { DATA BELL / 7 / |* }* ~*-----------------------------------------------------------------------* END OF DECLARATIONS*-----------------------------------------------------------------------* * C BEGIN : RTAROW  IF ( CURCOL .EQ. TERMCL ) THEN PRINT 100, BELL 100 FORMAT( '+', $, A ) RETURN  ELSE C ADVANCE TO RIGHT UNTIL AN UNPROTECTED SPACE IS FOUND. C SAVE CURRENT COLUMN SAVCOL = CURCOL 200 CURCOL = CURCOL + 1  DO 300 K = CURCOL, TERMCL  IF ( MAPSCR( CURROW, K ) .NE. 0 ) THEN CURCOL = K GO TO 400 END IF 300 CONTINUE  PRINT 100, BELLC END OF PERMISSIBLE COLUMNS IN CURRENT ROW CURCOL = SAVCOL RETURN   400 FORM = MAPSCR( CURROW, CURCOL ) I = INDEX( DISCHR( FORM ), 'TP' )  IF ( I .EQ. 0 ) THEN  CALL SCREEN( 12, CURROW, CURCOL ) ELSE GO TO 200 END IF   END IF  RETURN END 200 CONTINUE  SCANOF 8/12/85  SUBROUTINE SCANOF( CURROW, CURCOL, WCOLMS )  C---->SUBROUTINE SCANOF ( SCAN FOR OFFSET ) SCANS CURRENT ROW OF SCRMAP,C MOVING LEFT FROM WCOLMS ( TOTAL COLUMNS ),TO FIND THE FIRST C COLUMN WITH A DIFFERENT RECTYP ( RECORD TYPE ) THAN THE CURRENT C COLUMN. IF A DIFFEERNT RECTYP IS NOT FOUND OFFSET IS ZERO.   IMPLICIT INTEGER( A - Z )  *----------------------------------------------------------------------- * ROUTINE : SCANOF MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  * * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER CURCOL, CURROW, WCOLMS * * * * * ***** UNREFERENCED ARGUMENTS ***** * * * CURCOL INT CURRENT CURSOR COLUMN POSITION * * * ***** INPUT ARGUMENT DESCRIPTIONS *****  * !* "* NAME TYPE DESCRIPTION #* ------ ---- ----------- $* %* CURROW INT CURRENT CURSOR ROW POSITION &* WCOLMS INT MAXIMUM SCREEN COLUMN WIDTH '* ( )*CALL FSEDIT**CALL FLDATT+*CALL WINDOW, -* .* /*-----------------------------------------------------------------------0* LOCAL VARIABLES 1*-----------------------------------------------------------------------2* 3* 4 CHARACTER NOWTYP*8 5* 6* 7* 8* ***** SET VARIABLES ***** 9* :* ;* NAME TYPE DESCRIPTION <* ------ ---- ----------- =* >* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR ?* NOWCOL INT CURRENT COLUMN TO TEST FOR OFFSET@* NOWTYP CHAR CURRENT FORMS TYPE TO TEST FOR A CHANGE IN A* FORMS TYPE B* C* D*-----------------------------------------------------------------------E* END OF DECLARATIONSF*-----------------------------------------------------------------------G* H* IC BEGIN : SCANOFJ K NOWCOL = WCOLMS L FORM = MAPSCR( CURROW, NOWCOL ) M N 100 IF ( FORM .EQ. 0 ) THEN O NOWCOL = NOWCOL - 1P IF ( NOWCOL .EQ. 0 ) THEN Q OFFSET = 0 R RETURN S END IF T FORM = MAPSCR( CURROW, NOWCOL ) U GO TO 100 V END IFW X NOWTYP = RECTYP( FORM ) Y Z 200 NOWCOL = NOWCOL - 1 [ IF ( NOWCOL .EQ. 0 ) THEN \ OFFSET = 0 ] RETURN ^ END IF_ FORM = MAPSCR( CURROW, NOWCOL ) ` IF ( FORM .EQ. 0 ) GO TO 200 a IF ( NOWTYP .EQ. RECTYP( FORM ) ) GO TO 200 b c OFFSET = FLDCO2( FORM ) d e RETURNf END j EXTERNAL SCREEN k* l* m* ***** SUBROUTINE DESCRIPTIONS *****n* o* p* NAME DESCRIPTION qSCREEN 8/12/85* SUBROUTINE SCREEN( NUM, PARM1, PARM2 )* * *-----------------------------------------------------------------------* ROUTINE : SCREEN MODULE : $ DATE : 16-JAN-85 *-----------------------------------------------------------------------* * THIS SUBROUTINE MANIPULATES THE VT100 SCREEN. BECAUSE THIS  * MODULE IS A BPA FORTRAN UTILITY, CARE SHOULD BE TAKEN IN  * MODIFYING THE MEANINGS OF THE VARIOUS VALUES OF . SUCH  * MODIFICATIONS SHOULD USE HIGHER UNASSIGNED VALUES OF .  *  * E. C. Ogbuobiri* 15 November 1984 * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER NUM, PARM1, PARM2 * * * * * ***** INPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- *  * NUM INT DESIGNATES SCREEN FUNCTION TO BE USED FOR EACH CA!* TO THIS MODULE. "* NUM = 1 : CLEAR SCREEN, 'HOME' CURSOR #* NUM = 2 : CLEAR SCREEN W/O MOVING ( SOME, ALL ) $* PARM1 = 0, CLEARS FROM CURSOR TO %* END OF SCREEN &* PARM1 = 1, CLEARS FROM BEGINNING OF '* SCREEN TO CURSOR (* PARM1 = 2, CLEARS ENTIRE SCREEN )* ** NUM = 3 : SET SCREEN TO 132 COLUMNS +* NUM = 4 : SET SCREEN TO 80 COLUMNS ,* NUM = 5 : SET SCROLL TO SMOOTH -* NUM = 6 : SET SCROLL TO JUMP.* NUM = 7 : SET LINE TO TALL LETTERS ( TOP ) /* NUM = 8 : SET LINE TO TALL LETTERS ( BOTTOM ) 0* NUM = 9 : SET LINE TO WIDE LETTERS 1* NUM = 10 : SET LINE TO NORMAL LETTERS2* NUM = 11 : TURN ON 'PARM1' ATTRIBUTES3* PARM1 = 0, TURN OFF ALL ATTRIBUTES4* PARM1 = 1, TURN ON BOLD 5* PARM1 = 4, TURN ON UNDERSCORE 6* PARM1 = 5, TURN ON BLINK 7* PARM1 = 7, TURN ON REVERSE VIDEO 8* 9* NUM = 12 : MOVE TO SPECIFIED POINT :* PARM1 IS LINE NUMBER ;* PARM2 IS COLUMN NUMBER<* =* NUM = 13 : MOVE 'PARM1' LINES UP >* NUM = 14 : MOVE 'PARM1' LINES DOWN ?* NUM = 15 : MOVE 'PARM1' COLUMNS RIGHT@* NUM = 16 : MOVE 'PARM1' COLUMNS LEFT A* NUM = 17 : SET SCREEN TO TEXT MODE B* NUM = 18 : SET SCREEN TO GRAPHICS MODE C* NUM = 19 : SET KEYPAD TO APPLICATION D* NUM = 20 : SET KEYPAD TO NUMERIC E* NUM = 21 : CLEAR LINE W/O MOVING F* PARM1 = 0, CLEARS FROM CURSOR TO G* END OF LINEH* PARM1 = 1, CLEARS FROM BEGINNING OF I* LINE TO CURSOR J* PARM1 = 2, CLEARS ENTIRE LINE K* L* NUM = 22 : CLEAR SCREEN W/O MOVING ( SOME, ALL ) M* PARM1 = 0, CLEARS FROM CURSOR TO N* END OF SCREEN O* PARM1 = 1, CLEARS FROM BEGINNING OF P* SCREEN TO CURSOR Q* PARM1 = 2, CLEARS ENTIRE SCREEN R* S* NUM = 23 : SET SCROLL REGION T* NUM = 24 : INDEX CURSOR/SCROLL SCREEN DISPLAYU* PARM1 = +1, CURSOR DOWN/SCREEN UP V* PARM1 = -1, CURSOR UP /SCREEN DOWN W* CURSOR MUST BE AT WINDOW MARGIN FOR X* SCREEN-DISPLAY SCROLL TO OCCUR. Y* Z* [* ***** OUTPUT ARGUMENT DESCRIPTIONS ***** \* ]* ^* NAME TYPE DESCRIPTION _* ------ ---- ----------- `* a* PARM1 INT CONTROLS SCREEN ATTRIBUTES b* PARM2 INT CONTROLS SCREEN ATTRIBUTES c* d* e*-----------------------------------------------------------------------f* LOCAL VARIABLES g*-----------------------------------------------------------------------h* i* j CHARACTER AITCH*1, AYE*1, BEE*1, CEE*1k CHARACTER DEE*1, EIGHT*1, EMM*1, EQUAL*1 l CHARACTER ESC*1, FIVE*1, FOUR*1, GTR*1m CHARACTER JAY*1, KAY*1, LB*1, LCR*1n CHARACTER LILH*1, LILL*1, LILM*1, LPAREN*1 o CHARACTER NINE*1, NUMSGN*1, ONE*1, QMARK*1 p CHARACTER READY*1, SEMI*1, SEVEN*1, SIX*1q* r* s* ***** READ-ONLY VARIABLES ***** t* u* v* NAME TYPE DESCRIPTION w* ------ ---- ----------- x* y* AITCH CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN z* AYE CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN {* BEE CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN |* CEE CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN }* DEE CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN ~* EIGHT CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * EMM CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * EQUAL CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * ESC CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * FIVE CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * FOUR CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * GTR CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * JAY CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * KAY CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * LB CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * LCR CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * LILH CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * LILL CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * LILM CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * LPAREN CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * NINE CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * NUMSGN CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * ONE CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * QMARK CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * SEMI CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * SEVEN CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * SIX CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * THREE CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * TWO CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * ZERO CHAR FOR ESCAPE SEQUENCES TO CONTROL VT100 SCREEN * * *-----------------------------------------------------------------------* DATA INITIALIZATION*-----------------------------------------------------------------------* * DATA AITCH /'110'O/ DATA AYE /'101'O/ DATA BEE /'102'O/ DATA CEE /'103'O/ DATA DEE /'104'O/ DATA EIGHT /'8'/ DATA EMM /'115'O/ DATA EQUAL /'075'O/ DATA ESC /'033'O/ DATA FIVE /'5'/ DATA FOUR /'4'/ DATA GTR /'076'O/ DATA JAY /'112'O/ DATA KAY /'113'O/ DATA LB /'133'O/ DATA LCR /'162'O/ DATA LILH /'150'O/ DATA LILL /'154'O/ DATA LILM /'155'O/ DATA LPAREN /'050'O/ DATA NINE /'9'/ DATA NUMSGN /'043'O/ DATA ONE /'1'/ DATA QMARK /'077'O/ DATA SEMI /'073'O/ DATA SEVEN /'7'/ DATA SIX /'6'/ DATA THREE /'3'/ DATA TWO /'2'/ DATA ZERO /'0'/ * * *-----------------------------------------------------------------------* END OF DECLARATIONS*-----------------------------------------------------------------------* * *... SOME ESCAPE SEQUENCES USE THE FOLLOWING FORMAT  100 FORMAT('+'$,10A1)  C GOTO HOME, CLEAR SCREEN IF (NUM .EQ. 1) THEN TYPE 100, ESC,LB,AITCH  TYPE 100, ESC,LB,TWO,JAY  C CLEAR SCREEN W/O MOVING (SOME, ALL)  ELSE IF (NUM .EQ. 2) THEN  110 FORMAT('+',$,2A1,I1,7A1)  TYPE 110, ESC,LB,PARM1,JAY C SET SCREEN TO 132 COLUMNS  ELSE IF (NUM .EQ. 3) THEN  TYPE 100, ESC,LB,QMARK,THREE,LILH C SET SCREEN TO 80 COLUMNS ELSE IF (NUM .EQ. 4) THEN  TYPE 100, ESC,LB,QMARK,THREE,LILL C SET SCROLL TO SMOOTH ELSE IF (NUM .EQ. 5) THEN  TYPE 100, ESC,LB,QMARK,FOUR,LILH  C SET SCROOL TO SMOOTH ELSE IF (NUM .EQ. 6) THEN  TYPE 100, ESC,LB,QMARK,FOUR,LILL  C SET LINE TO TALL LETTERS ( TOP ) ELSE IF (NUM .EQ. 7) THEN  TYPE 100, ESC,NUMSGN,THREE  C SET LINE TO TALL LETTERS ( BOTTOM )  ELSE IF (NUM .EQ. 8) THEN  TYPE 100, ESC,NUMSGN,FOUR C SET LINE TO WIDE LETTERS ELSE IF (NUM .EQ. 9) THEN  TYPE 100, ESC,NUMSGN,SIX  C SET LINE TO NORMAL LETTERS  ELSE IF (NUM .EQ. 10) THEN  TYPE 100, ESC,NUMSGN,FIVE C TURN ON 'PARM1' ATTRIBUTE  ELSE IF (NUM .EQ. 11) THEN  TYPE 110, ESC,LB,PARM1,LILM  C MOVE TO SPECIFIED POINT  ELSE IF (NUM .EQ. 12) THEN  120 FORMAT('+',$,2A1,I1,A1,I1,5A1)  130 FORMAT('+',$,2A1,I1,A1,I2,5A1)  140 FORMAT('+',$,2A1,I1,A1,I3,5A1)  150 FORMAT('+',$,2A1,I2,A1,I1,5A1)  160 FORMAT('+',$,2A1,I2,A1,I2,5A1)  170 FORMAT('+',$,2A1,I2,A1,I3,5A1)   IF (PARM1 .LT. 1) PARM1=1 IF (PARM1 .LT. 10) THEN  IF (PARM2 .LT. 10) THEN  TYPE 120, ESC,LB,PARM1,SEMI,PARM2,AITCH ELSE IF (PARM2 .LT. 100) THEN  TYPE 130, ESC,LB,PARM1,SEMI,PARM2,AITCH ELSE IF (PARM2 .LT. 133) THEN  TYPE 140, ESC,LB,PARM1,SEMI,PARM2,AITCH  END IF  ELSE IF (PARM1 .LT. 26) THEN  IF (PARM2 .LT. 10) THEN   TYPE 150, ESC,LB,PARM1,SEMI,PARM2,AITCH  ELSE IF (PARM2 .LT. 100) THEN   TYPE 160, ESC,LB,PARM1,SEMI,PARM2,AITCH  ELSE IF (PARM2 .LT. 133) THEN   TYPE 170, ESC,LB,PARM1,SEMI,PARM2,AITCH  END IF  END IF  C MOVE 'PARM1' LINES UP  ELSE IF (NUM .EQ. 13) THEN  IF (PARM1 .LT. 1) RETURN  IF (PARM1 .LT. 10) THEN  TYPE 120, ESC,LB,PARM1,AYE  ELSE IF (PARM1 .LT. 25) THEN  TYPE 150, ESC,LB,PARM1,AYE  END IF  C MOVE 'PARM1' LINES DOWN  ELSE IF (NUM .EQ. 14) THEN  IF (PARM1 .LT. 1) RETURN  IF (PARM1 .LT. 10) THEN  TYPE 120, ESC,LB,PARM1,BEE  ELSE IF (PARM1 .LT. 25) THEN   TYPE 150, ESC,LB,PARM1,BEE ! END IF " #C MOVE 'PARM1' COLUMNS RIGHT $ ELSE IF (NUM .EQ. 15) THEN % IF (PARM1 .LT. 1) RETURN & IF (PARM1 .LT. 10) THEN ' TYPE 120, ESC,LB,PARM1,CEE ( ELSE IF (PARM1 .LT. 100) THEN) TYPE 150, ESC,LB,PARM1,CEE * ELSE IF (PARM1 .LT. 132) THEN+ 180 FORMAT('+',$,2A1,I3,7A1), TYPE 180, ESC,LB,PARM1,CEE - END IF . /C MOVE 'PARM1' COLUMNS LEFT 0 ELSE IF (NUM .EQ. 16) THEN 1 IF (PARM1 .LT. 1) RETURN 2 IF (PARM1 .LT. 10) THEN 3 TYPE 120, ESC,LB,PARM1,DEE 4 ELSE IF (PARM1 .LT. 100) THEN5 TYPE 150, ESC,LB,PARM1,DEE 6 ELSE IF (PARM1 .LT. 132) THEN7 TYPE 180, ESC,LB,PARM1,DEE 8 END IF 9 :C SET SCREEN TO TEXT MODE ; ELSE IF (NUM .EQ. 17) THEN < TYPE 100, ESC,LPAREN,AYE = >C SET SCREEN TO GRAPHICS MODE ? ELSE IF (NUM .EQ. 18) THEN @ TYPE 100, ESC,LPAREN,ZEROA BC SET KEYPAD TO APPLICATION C ELSE IF (NUM .EQ. 19) THEN D TYPE 100, ESC,EQUAL E FC SET KEYPAD TO NUMERIC G ELSE IF (NUM .EQ. 20) THEN H TYPE 100, ESC,GTRI JC CLEAR LINE W/O MOVING ( SOME, ALL ) K ELSE IF (NUM .EQ. 21) THEN L TYPE 110, ESC,LB,PARM1,KAYM NC CLEAR SCREEN W/O MOVING ( SOME, ALL ) O ELSE IF (NUM .EQ. 22) THEN P TYPE 110, ESC,LB,PARM1,JAYQ RC SET SCROLL REGION S ELSE IF (NUM .EQ. 23) THEN T IF (PARM1 .LT. 1) PARM1 = 1 U IF (PARM2 .GT. 24) PARM2 = 24 V IF (PARM1 .LT. 10) THEN W IF (PARM2 .LT. 10) THEN X TYPE 120, ESC,LB,PARM1,SEMI,PARM2,LCR Y ELSEZ TYPE 130, ESC,LB,PARM1,SEMI,PARM2,LCR [ END IF \ ELSE ] IF (PARM2 .LT. 10) THEN ^ TYPE 150, ESC,LB,PARM1,SEMI,PARM2,LCR _ ELSE` TYPE 160, ESC,LB,PARM1,SEMI,PARM2,LCR a END IF b END IFc d ELSE IF (NUM .EQ. 24) THEN e IF (PARM1 .GT. 0) THEN f TYPE 100, ESC,DEE g ELSEh TYPE 100, ESC,EMM i END IF j k ENDIF l m RETURN n END SPECHR 8/12/85 SUBROUTINE SPECHR( CURROW, CURCOL, WCOLMS, IQUERY )  SUBROUTINE SPECHR( CURROW, CURCOL, KEY, WCOLMS, IQUERY )  C---->SUBROUTINE SPECHR ( SPECIAL CHARACTER ) PROCESS SPECIAL CHARACTERSC e.g., ARROW KEYS OR KEYPAD KEYS AND MANIPULATES THE CURSOR OR THE C SCREEN TEXT, OR SENDS A 'BUTTON' KEY BACK TO THE CALLING PROGRAM.   IMPLICIT INTEGER( A - Z ) *----------------------------------------------------------------------- * ROUTINE : SPECHR MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  *  * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER KEY*1 * *  INTEGER CURCOL, CURROW, IQUERY, WCOLMS * * * * * ***** OUTPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * CURCOL INT CURRENT CURSOR COLUMN POSITION * IQUERY INT VALUE OF 'BUTTON' KEY RETURNED TO DRIVER  * !* "* ***** VARIABLES NOT SET IN THIS ROUTINE ***** #* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** $* %* &* NAME TYPE DESCRIPTION '* ------ ---- ----------- (* )* CURROW INT CURRENT CURSOR ROW POSITION * KEY CHAR ASCII SYMBOL OF KEY PRESSED ** WCOLMS INT MAXIMUM SCREEN COLUMN WIDTH +* , -*CALL FSEDIT .*CALL SYSPAR/*CALL FLDATT0*CALL FSED 1*CALL SPECAL2*CALL STAINF3*CALL VARS 4*CALL WINDOW5 6* 7*-----------------------------------------------------------------------8* LOCAL VARIABLES 9*-----------------------------------------------------------------------:* ;* <* = INTEGER FORM1, FORM2, I, NEWCOL >* ?* @* ***** SET VARIABLES ***** A* B* C* NAME TYPE DESCRIPTION D* ------ ---- ----------- E* F* FORM1 INT SUBSCRIPT FOR FORMS ARRAY FOR CURRENT CURSOR G* POSITION H* FORM2 INT SUBSCRIPT FOR FORMS ARRAY FOR FIELD TO LEFT I* OF CURRENT POSITION J* I INT VALUE OF INDEX FUNCTION K* NEWCOL INT FIRST COLUMN OF CURRENT FIELDL* M* N*-----------------------------------------------------------------------O* PROCEDURESP*-----------------------------------------------------------------------Q* R* S* ============ INTRINSIC FUNCTIONS ============ T* U* V* W* X INTEGER INDEX Y* Z* ***** INTRINSIC FUNCTION DESCRIPTIONS *****[* \* ]* NAME TYPE DESCRIPTION ^* ------ ---- ----------- _* `* INDEX INT STANDARD INDEX FUNCTION a* b* c* ============ SUBROUTINES CALLED ============d* e* f EXTERNAL CURDWN g EXTERNAL DELETE h EXTERNAL GETKEY i EXTERNAL HOMCUR j EXTERNAL KEYPAD k EXTERNAL LTAROW l EXTERNAL PUTSCR m EXTERNAL REBUFF n EXTERNAL RTAROW o EXTERNAL SCANOF p EXTERNAL SCREEN q EXTERNAL TABOVR r EXTERNAL UPAROW s* t* u* ***** SUBROUTINE DESCRIPTIONS *****v* w* x* NAME DESCRIPTION y* ------ ----------- z* {* CURDWN MOVE CURSOR DOWN |* DELETE DELETE (FROM CURSOR TO END OF CURRENT RECORD). }* GETKEY GET LAST KEY STROKE FROM KEYBOARD~* HOMCUR MOVES AND TRACKS CURSOR TO HOME POSITION * KEYPAD PROCESS KEYPAD KEYS * LTAROW MOVES AND TRACKS CURSOR ONE SPACE LEFT IN ROW* PUTSCR WRITE STRING TO TERMINAL SCREEN * REBUFF UPDATES DAVBUF (SAVE BUFFER) FROM SCRBUF * (SCREEN BUFFER) * RTAROW MOVES AND TRACKS CURSOR ONE SPACE RIGHT * SCANOF SCANS CURRENT ROW FOR COLUMN OFFSET * SCREEN MANIPULATES SCREEN ATTRIBUTES* TABOVR MOVES AND TRACKS CURSOR BY TAB KEY * UPAROW MOVES AND TRACKS CURSOR ONE ROW UPWARD * * *-----------------------------------------------------------------------* END OF DECLARATIONS*-----------------------------------------------------------------------* * C BEGIN : SPECHR IF ( KEYNUM .EQ. 27 ) THEN C To pick 2nd Character, i.e., Begin to analyze sequence.   CALL GETKEY  CALL GETKEY( KEY ) KEYNUM = ICHAR( KEY )  IF (INDEX(' Ii',KEY) .GT. 1) THEN C TOGGLE BETWEEN 'INSERT' AND 'OVERTYPE' MODES OF EDITING  IF ( MODE .EQ. 'OVERTYPE' ) THEN MODE = ' INSERT ' INSERT = .TRUE.  ELSE IF ( MODE .EQ. ' INSERT ' ) THEN MODE = 'OVERTYPE' INSERT = .FALSE. END IF RETURN   ELSE IF ( KEY .EQ. 'B' ) THEN  CALL CURDWN( CURROW, CURCOL, WCOLMS )  CALL CURDWN( CURROW, CURCOL, KEY, WCOLMS ) RETURN   ELSE IF ( KEY .EQ. 'T' ) THEN  CALL HOMCUR( CURROW, CURCOL, WCOLMS ) RETURN END IF  C To pick 3rd Character 'A/B/C/D'  CALL GETKEY  CALL GETKEY( KEY )  C A R R O W K E Y S I N T E X T A R E A   IF ( KEY .EQ. 'A' ) THEN  CALL UPAROW( CURROW, CURCOL ) RETURN END IF   IF ( KEY .EQ. 'B' ) THEN C DOWN ARROW in TEXT area KEY = 'E'  CALL CURDWN( CURROW, CURCOL, WCOLMS )  CALL CURDWN( CURROW, CURCOL, KEY, WCOLMS ) RETURN END IF   IF ( KEY .EQ. 'C' ) THEN C RIGHT ARROW in TEXT area:  CALL RTAROW( CURROW, CURCOL ) RETURN END IF   IF ( KEY .EQ. 'D' ) THEN C LEFT ARROW in TEXT area:  CALL LTAROW( CURROW, CURCOL ) RETURN END IF  C CHECK TO SEE IF 'KEY' WAS A KEYPAD KEY.  IF ( INDEX('pqrstuvwxymlnMPQRS', KEY ) .NE. 0 ) THEN  CALL KEYPAD( CURROW, CURCOL, WCOLMS, IQUERY )  CALL KEYPAD( CURROW, CURCOL, KEY, WCOLMS, IQUERY ) RETURN END IF  C C O N T R O L K E Y S I N T E X T A R E A  ELSE IF ( KEY .EQ. CR ) THEN ENDEDT = .TRUE. IQUERY = 0 CALL REBUFF ELSE IF ( KEY .EQ. BS ) THEN  C BACK SPACE : MOVE CURSOR TO RIGHT-MOST SPACE IN FIELD C IMMEDIATELY TO LEFT OF CURRENT FIELD. OTHERWISE MOVE TO C FIRST SPACE IN CURRENT FIELD   IF ( CURCOL .EQ. 1 ) THEN C IMPOSSIBLE TO MOVE LEFTWARD NEWCOL = CURCOL ELSE C FIND PERMISSIBLE SPACE ALLOWED BY ABOVE CONDITIONS  FORM1 = MAPSCR( CURROW, CURCOL ) NEWCOL = FLDCO1( FORM1 ) - 1  IF ( NEWCOL .LE. 0 ) THEN  NEWCOL = FLDCO1( FORM1 ) ELSE FORM2 = MAPSCR( CURROW, NEWCOL )  I = INDEX( DISCHR( FORM2 ), 'TP' )   IF ( I .EQ. 0 ) THEN CONTINUE ELSE  NEWCOL = FLDCO1( FORM1 ) END IF  END IF  END IF   CALL SCANOF( CURROW, NEWCOL, WCOLMS )   IF ( NEWCOL .LE. OFFSET ) THEN CURCOL = OFFSET ELSE  CURCOL = NEWCOL + OFFSET END IF   CALL SCREEN( 12, CURROW, CURCOL )   ELSE IF( KEY .EQ. DEL ) THEN  CALL DELETE( CURROW, CURCOL )  ELSE IF( KEY .EQ. TAB) THEN  CALL TABOVR( CURROW, CURCOL, WCOLMS )  CALL TABOVR( CURROW, CURCOL, KEY, WCOLMS )  ELSE IF ( KEY .EQ. LF ) THEN  CALL CURDWN( CURROW, CURCOL, WCOLMS )  CALL CURDWN( CURROW, CURCOL, KEY, WCOLMS )  ELSE  CALL PUTSCR('DUNNO.... ',6,65,0)  END IF   IF ( IQUERY .GT. 0 .AND. IQUERY .LE. 12 ) ENDEDT = .TRUE.     RETURN    END D FROM FSCREN * STRFOR STORES RECORD FORMATS FOR RECORD DISPLAY * WRTRCD WRITES A RECORD FOR EDITING * *-----------------------------------------------------------------------* DATA INITIALIZATIONSTRFOR 8/12/85 SUBROUTINE STRFOR( DATA, IFIELD, FSTCOL, SAVK )  C---->SUBROUTINE STRFOR ( STORE FORMATS ) STORES 'IFIELD' FORMATS C PASSED BY 'DATA' INTO ARRAY FORMS. COMMENTS CONCERNING FORMATS C IN DATA ARE IGNORED. TOTAL NUMBER OF OPERATIVE FORMATS ISC IS STORED IN NFIELD. EACH FORMAT IS SCANNED, AND SEVERAL ARRAYS C RECEIVE VALUES THEREFROM.  IMPLICIT INTEGER( A - Z )  *----------------------------------------------------------------------- * ROUTINE : STRFOR MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- * * * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER DATA(*)*(*)*  INTEGER FSTCOL, IFIELD, SAVK * * * * ***** INPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- -----------  * !* DATA CHAR CHARACTER ARRAY HOLDING ALL THE FORMATS "* FROM THE DRIVER PROGRAM #* IFIELD INT NUMBER OF FORMATS IN DATA (HERE) $* %* &* ***** OUTPUT ARGUMENT DESCRIPTIONS ***** '* (* )* NAME TYPE DESCRIPTION ** ------ ---- ----------- +* ,* FSTCOL INT INITIAL COLUMN POSITION OF CURSOR FROM -* FORMATS PROVIDED BY DRIVER PROGRAM .* SAVK INT THE NUMBER OF THE FORMAT WHICH HAS FSTCOL/* 0 1*CALL FSEDIT2*CALL FLDATT3*CALL WINDOW4 5* 6*-----------------------------------------------------------------------7* LOCAL VARIABLES 8*-----------------------------------------------------------------------9* :* ; CHARACTER BUF*80 <* = INTEGER COMPOS, ILEN, IPNT, J, K, L > INTEGER M ?* @* A* B* ***** SET VARIABLES ***** C* D* E* NAME TYPE DESCRIPTION F* ------ ---- ----------- G* H* BUF CHAR WORKING VARIABLE FOR DATA(*) I* COMPOS INT NEXT COMMA POSITION IN DATA(*) J* ILEN INT LENGTH OF CURRENT FIELD BETWEEN COMMAS K* IPNT INT VALUE OF INDEX FUNCTION L* J INT VALUE OF INDEX FUNCTION M* K INT VALUE OF INDEX FUNCTION N* L INT VALUE OF INDEX FUNCTION O* M INT VALUE OF INDEX FUNCTION P* Q* R*-----------------------------------------------------------------------S* PROCEDUREST*-----------------------------------------------------------------------U* V* W* ============ INTRINSIC FUNCTIONS ============ X* Y* Z* [* \* ***** INTRINSIC FUNCTION DESCRIPTIONS *****]* ^* _* NAME TYPE DESCRIPTION `* ------ ---- ----------- a* b* INDEX INT STANDARD FORTRAN INDEX FUNCTION c* d* e*-----------------------------------------------------------------------f* END OF DECLARATIONSg*-----------------------------------------------------------------------h* i* jC BEGIN : STRFOR ( STORE FORMATS ) k l L = 0 m n DO 10 K = 1, IFIELD o IPNT = INDEX( DATA(K)(1:9), ',' ) p qC CHECK FOR A COMMENT LINE AMONG FORMAT SPECIFICATIONr s IF ( IPNT .EQ. 0 ) GO TO 10 t L = L + 1 u FORMS( L ) = DATA( L ) v 10 CONTINUE w x DO 100 K = 1, L y BUF = FORMS( K ) zC GET RECORD TYPE. FIRST COMMA DELIMITS RECORD TYPE { IPNT = INDEX( BUF(1:), ',' ) | RECTYP( K )(1:8) = BUF(1:IPNT-1) }C GET START COLUMN OF RECORD. NEXT COMMA DELIMITS THIS ~ COMPOS = IPNT  IPNT = COMPOS + INDEX( BUF(COMPOS+1:), ',' ) ILEN = IPNT - COMPOS -1 IF ( ILEN .EQ. 1 ) THEN READ( BUF(COMPOS+1:IPNT-1), FMT = 110 ) FLDCO1( K ) 110 FORMAT( I1 ) ELSE  READ( BUF(COMPOS+1:IPNT-1), FMT = 120 ) FLDCO1( K ) 120 FORMAT( I2 ) END IF  C GET STOP COLUMN OF RECORD; LOOK FOR NEXT COMMA COMPOS = IPNT  IPNT = COMPOS + INDEX( BUF(COMPOS+1:), ',' )  ILEN = IPNT - COMPOS - 1  IF ( ILEN .EQ. 1 ) THEN IF ( BUF(COMPOS+1:IPNT-1) .EQ. '*' ) THEN FLDCO2( K ) = 79 ELSE READ( BUF(COMPOS+1:IPNT-1), FMT = 110 ) FLDCO2( K ) END IF ELSE  READ( BUF(COMPOS+1:IPNT-1), FMT = 120 ) FLDCO2( K ) END IF  C LOOK FOR NEXT COMMA WHICH DELIMITS TABSPC COMPOS = IPNT  IPNT = COMPOS + INDEX( BUF(COMPOS+1:), ',' )  M = INDEX( '123456789', BUF( COMPOS+1:IPNT-1) ) TABSPC( K ) = MC LOOK FOR NEXT COMMA WHICH DELIMITS DISCHR ( DISPLAY CHARACTERIS COMPOS = IPNT  IPNT = COMPOS + INDEX( BUF(COMPOS+1:), ',' )  DISCHR( K ) = '('//BUF(COMPOS+1:IPNT-1)//')++'  DISCHR( K )(31:32) = '++' C CHECK CURRENT DISPLAY CHARACTERISTICS FOR A TYPE 'KH'.  J = INDEX( DISCHR( K ), 'KH' )  IF ( J .NE. 0 ) THEN FSTCOL = FLDCO1( K ) SAVK = K END IF  C LOOK FOR NEXT COMMA WHICH DELIMITS FMTTYP ( FORMAT TYPE) COMPOS = IPNT  IPNT = COMPOS + INDEX( BUF(COMPOS+1:), ',' )  FMTTYP( K ) = BUF(COMPOS+1:IPNT-1)//'++'  FMTTYP( K )(31:32) = '++' C LOOK FOR NEXT COMMA WHICH DELIMITS TITLE COMPOS = IPNT  IPNT = COMPOS + INDEX( BUF(COMPOS+1:), ',' )  TITLE( K ) = BUF(COMPOS+1:IPNT-1)//'++' TITLE( K )(31:32) = '++' C LOOK FOR NEXT COMMA WHICH DELIMITS LOVAL COMPOS = IPNT  IPNT = COMPOS + INDEX( BUF(COMPOS+1:), ',' )  LOVAL( K ) = BUF(COMPOS+1:IPNT-1)//'++' LOVAL( K )(9:10) = '++'C LOOK FOR NEXT COMMA WHICH DELIMITS HIVAL COMPOS = IPNT  IPNT = COMPOS + INDEX( BUF(COMPOS+1:), ',' )  HIVAL( K ) = BUF(COMPOS+1:IPNT-1)//'++' HIVAL( K )(9:10) = '++'C LOOK FOR NEXT COMMA WHICH DELIMITS FLDHLP ( FIELD HELP ) COMPOS = IPNT  IPNT = COMPOS + INDEX( BUF(COMPOS+1:), ',' )  FLDHLP( K ) = BUF(COMPOS+1:IPNT-1)//'++'  FLDHLP( K )(31:32) = '++' 100 CONTINUE  NFIELD = L  RETURN END = 0 CALL REBUFF ELSE IF ( KEY .EQ. BS ) THEN  C BACK SPACE : MOVE CURSOR TO RIGHT-MOST SPACE IN FIELD C IMMTABOVR 8/12/85 SUBROUTINE TABOVR( CURROW, CURCOL, WCOLMS )  SUBROUTINE TABOVR( CURROW, CURCOL, KEY, WCOLMS )  C---->SUBROUTINE TABOVR (TAB OVER) MOVES THE CURSOR RIGHT THE SPECIFIED C NUMBER OF SPACES AS GIVEN BY THE FORMS TABLE. IF THE NUMBER OF C TAB SPACES IS UNDEFINED, THEN THE CURSOR IS MOVED TO THE FIRSTC SPACE IN THE NEXT FIELD. IF, HOWEVER, THE CURSOR IS IN THE LAST C FIELD OF THE RECORD, THE CURSOR GOES TO THE FIRST FIELD IN THEC NEXT LINE, IF NOT AT BOTTOM LIMIT   IMPLICIT INTEGER( A - Z )   *-----------------------------------------------------------------------* ROUTINE : TABOVR MODULE : FSCREN DATE : 8-AUG-85 *-----------------------------------------------------------------------* * * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER KEY*1  INTEGER CURCOL, CURROW, WCOLMS * * * * * ***** OUTPUT ARGUMENT DESCRIPTIONS ***** * *  * NAME TYPE DESCRIPTION !* ------ ---- ----------- "* #* CURCOL INT CURRENT CURSOR COLUMN POSITION * KEY CHAR ASCII SYMBOL OF KEY PRESSED $* %* &* ***** VARIABLES NOT SET IN THIS ROUTINE ***** '* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** (* )* ** NAME TYPE DESCRIPTION +* ------ ---- ----------- ,* -* CURROW INT CURRENT CURSOR ROW POSITION .* WCOLMS INT MAXIMUM SCREEN COLUMN WIDTH /* 0 1*CALL FSEDIT2*CALL FLDATT 3*CALL SYSPAR4*CALL WINDOW5 6* 7*-----------------------------------------------------------------------8* LOCAL VARIABLES 9*-----------------------------------------------------------------------:* ;* < CHARACTER BELL*1 =* > INTEGER FORM, SPACES, TRYCOL ?* @* A* B* ***** READ-ONLY VARIABLES ***** C* D* E* NAME TYPE DESCRIPTION F* ------ ---- ----------- G* H* BELL CHAR ASCII EQUIVALENT OF 'BEL'I* J* K* ***** SET VARIABLES ***** L* M* N* NAME TYPE DESCRIPTION O* ------ ---- ----------- P* Q* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR R* SPACES INT NUMBER OF TAB SPACES S* TRYCOL INT TRIAL COLUMN FOR FINDING AN UNPROTECTED ONE T* U* V*-----------------------------------------------------------------------W* PROCEDURESX*-----------------------------------------------------------------------Y* Z* [* ============ SUBROUTINES CALLED ============\* ]* ^ EXTERNAL CURDWN _ EXTERNAL SCREEN `* a* b* ***** SUBROUTINE DESCRIPTIONS *****c* d* e* NAME DESCRIPTION f* ------ ----------- g* h* CURDWN MOVES AND TRACKS THE CURSOR DOWN ONE ROW i* SCREEN MANIPULATES SCREEN ATTRIBUTESj* k* l*-----------------------------------------------------------------------m* DATA INITIALIZATIONn*-----------------------------------------------------------------------o* p* q DATA BELL / 7 / r* s* t*-----------------------------------------------------------------------u* END OF DECLARATIONSv*-----------------------------------------------------------------------w* x* yC BEGIN : TABOVRz { TRYCOL = CURCOL | } IF ( TRYCOL .LE. OFFSET ) THEN ~ CURCOL = OFFSET + 1  RETURN  END IF  FORM = MAPSCR( CURROW, TRYCOL ) SPACES = TABSPC( FORM )  IF ( SPACES .EQ. 0 ) THEN  TRYCOL = FLDCO2( FORM ) + OFFSET + 1  IF ( TRYCOL .GE. WCOLMS .AND. CURROW .LT. SWBOT ) THEN KEY = 'Z'  CALL CURDWN( CURROW, CURCOL, WCOLMS )  CALL CURDWN( CURROW, CURCOL, KEY, WCOLMS ) RETURN  ELSE IF ( TRYCOL .GE. WCOLMS ) THEN CURCOL = CURCOL + 1 ELSE CURCOL = TRYCOL END IF   ELSE   IF ( ( CURCOL + SPACES ) .GT. ( FLDCO2(FORM) + OFFSET ) ) THEN  CURCOL = FLDCO2( FORM ) + OFFSET ELSE  CURCOL = CURCOL + SPACES END IF   END IF  CALL SCREEN( 12, CURROW, CURCOL )   RETURN  END * &* NAME TYPE DESCRIPTION '* ------ ---- ----------- (* )* CURROW INT CURRENT CURSOR ROW POSITION * KEY CHAR ASCII SYMBOL OF KEY PRESSED ** WCOLMS INT MAXIMUM SCREEN COLUMN WIDTH +* ,TRMCHN 8/12/85  SUBROUTINE TRMCHN  C... Purpose: To ASSIGN a channel to the terminal *-----------------------------------------------------------------------* ROUTINE : TRMCHN MODULE : FSCREN DATE : 8-AUG-85 *-----------------------------------------------------------------------*   *CALL SYSPAR  * *-----------------------------------------------------------------------* LOCAL VARIABLES *-----------------------------------------------------------------------* *  CHARACTER TERMNL*2/'TT'/    * ***** SET VARIABLES ***** *  *  * NAME TYPE COMMON DESCRIPTION* ------ ---- ------ -----------* * TERMNL CHAR TRMCHN TERMINAL CHANNEL  *  * *-----------------------------------------------------------------------* PROCEDURES*-----------------------------------------------------------------------* * * ============ INTRINSIC FUNCTIONS ============ * * * * ***** INTRINSIC FUNCTION DESCRIPTIONS ****** * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * ASSIGN VAX SYSTEM ASSIGN STATEMENT FOR TERMINAL CHANNEL * *  *-----------------------------------------------------------------------!* END OF DECLARATIONS"*-----------------------------------------------------------------------#* $* %C BEGIN : TRMCHN& ' IF ( TERMCH .LE. 0 ) THEN ( CALL SYS$ASSIGN( TERMNL, TERMCH, , ) ) END IF* + RETURN, END * q DATA BELL / 7 / r* s* t*-----------------------------------------------------------------------uUPAROW 8/12/85 SUBROUTINE UPAROW( CURROW, CURCOL )  C---->SUBROUTINE UPAROW ( UP ARROW ) MOVES THE CURSOR UP ONE LINE C IN THE TEXT IF THERE IS A LINE ABOVE CURRENT LINE.  IMPLICIT INTEGER( A - Z )  *----------------------------------------------------------------------- * ROUTINE : UPAROW MODULE : FSCREN DATE : 8-AUG-85  *----------------------------------------------------------------------- *  *  * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  INTEGER CURCOL, CURROW * * * * * ***** OUTPUT ARGUMENT DESCRIPTIONS ***** * * * NAME TYPE DESCRIPTION * ------ ---- ----------- * * CURROW INT CURRENT CURSOR ROW POSITION *  * !* ***** VARIABLES NOT SET IN THIS ROUTINE ***** "* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** #* $* %* NAME TYPE DESCRIPTION &* ------ ---- ----------- '* (* CURCOL INT CURRENT CURSOR COLUMN POSITION )* * +*CALL FSEDIT,*CALL FLDATT-*CALL WINDOW. /* 0*-----------------------------------------------------------------------1* LOCAL VARIABLES 2*-----------------------------------------------------------------------3* 4* 5 CHARACTER BELL*1 6* 7 INTEGER FORM, I, TRYROW 8* 9* :* ;* ***** READ-ONLY VARIABLES ***** <* =* >* NAME TYPE DESCRIPTION ?* ------ ---- ----------- @* A* BELL CHAR ASCII EQUIVALENT OF 'BEL'B* C* D* ***** SET VARIABLES ***** E* F* G* NAME TYPE DESCRIPTION H* ------ ---- ----------- I* J* FORM INT SUBSCRIPT FOR ARRAY FORMS FROM ARRAY MAPSCR K* I INT VALUE FROM INDEX FUNCTIONL* TRYROW INT TRIAL ROW FOR FINDING AN UNPROTECTED ROW M* N* O*-----------------------------------------------------------------------P* PROCEDURESQ*-----------------------------------------------------------------------R* S* T* ============ INTRINSIC FUNCTIONS ============ U* V* W* X* Y INTEGER INDEX Z* [* ***** INTRINSIC FUNCTION DESCRIPTIONS *****\* ]* ^* NAME TYPE DESCRIPTION _* ------ ---- ----------- `* a* INDEX INT STANDARD FORTRAN INDEX FUNCTION b* c* d* ============ SUBROUTINES CALLED ============e* f* g EXTERNAL SCREEN h* i* j* ***** SUBROUTINE DESCRIPTIONS *****k* l* m* NAME DESCRIPTION n* ------ ----------- o* p* SCREEN MANIPULATES SCREEN ATTRIBUTESq* r* s*-----------------------------------------------------------------------t* DATA INITIALIZATIONu*-----------------------------------------------------------------------v* w* x DATA BELL / 7 / y* z* {*-----------------------------------------------------------------------|* END OF DECLARATIONS}*-----------------------------------------------------------------------~* * C BEGIN : UPAROW TRYROW = CURROW   100 IF ( TRYROW .GT. SWTOP ) THEN TRYROW = TRYROW - 1 FORM = MAPSCR( TRYROW, CURCOL ) IF ( FORM .EQ. 0 ) GO TO 100  I = INDEX( DISCHR( FORM ), 'TP' )  IF ( I .EQ. 0 ) THEN CURROW = TRYROW  CALL SCREEN( 12, CURROW, CURCOL ) ELSE GO TO 100 END IF   ELSE PRINT 200, BELL 200 FORMAT( '+', $, A ) END IF  RETURN END  END IF   ELSE   IF ( ( CURCOL + SPACES ) .GT. ( FLDCO2(FORM) + OFFSET ) ) THEN  CURCOL = FLDCO2( FORM ) + OFFSET ELSE WRTRCD 8/12/85 SUBROUTINE WRTRCD( DATA, FORMAT, ROW, COLUMN, VIEW, LENGTH,  1 WCOLMS, IFIELD, SAVK, ROWKH )  C---->SUBROUTINE WRTRCD ( WRITE RECORD ) WRITES ONE LINE TO THE SCREEN C BUFFER ( SCRBUF ) IN COMMON /WINBUF/ AND WRITES THE THE LINE OF C OF DATA TO THE TERMINAL SCREEN. SCRBUF, A CHARACTER ARRAY, ISC CONSTANTLY UPDATED DURING EDITING.C THE LINE OF DATA IS WRITTEN AT ROW AND COLUMN STARTING AT COLUMN C OVER A RANGE OF LENGTH C  IMPLICIT INTEGER (A-Z) *-----------------------------------------------------------------------* ROUTINE : WRTRCD MODULE : WRTRCD DATE : 8-AUG-85 *-----------------------------------------------------------------------* * * *-----------------------------------------------------------------------* ARGUMENTS *-----------------------------------------------------------------------* *  CHARACTER DATA*(*), FORMAT*(*) *  INTEGER COLUMN, IFIELD, LENGTH, ROW, ROWKH, SAVK  INTEGER VIEW, WCOLMS * * *  * !* ***** UNREFERENCED ARGUMENTS ***** "* #* $* WCOLMS INT MAXIMUM SCREEN COLUMN WIDTH %* &* '* ***** INPUT ARGUMENT DESCRIPTIONS ***** (* )* ** NAME TYPE DESCRIPTION +* ------ ---- ----------- ,* -* COLUMN INT CURSOR COLUMN POSITION .* FORMAT CHAR RECORD TYP WITH WHICH TO WRITE DATA /* IFIELD INT AN FSCREN PARAMETER, AN IDENTIFIER FOR THIS 0* RECORD (UNUSED). 1* LENGTH INT LENGTH, i.e. NUMBER OF CHARACTERS IN DATA2* SAVK INT ROW DESIGNATOR WHERE INITIAL CURSOR POSITION IS 3* VIEW INT WHERE IN DATA TO START WRITING 4* 5* 6* ***** OUTPUT ARGUMENT DESCRIPTIONS ***** 7* 8* 9* NAME TYPE DESCRIPTION :* ------ ---- ----------- ;* <* ROWKH INT INITIAL ROW POSITION FOR CURSOR =* >* ?* ***** VARIABLES NOT SET IN THIS ROUTINE ***** @* ***** WHICH ARE PASSED TO OTHER ROUTINES ***** A* B* C* NAME TYPE DESCRIPTION D* ------ ---- ----------- E* F* DATA CHAR CHARACTER STRING TO BE WRITTEN G* ROW INT ROW NUMBER WHERE TO WRITE DATA H* I J*CALL FSEDITK*CALL FLDATTL*CALL WINDOWM N* O*-----------------------------------------------------------------------P* LOCAL VARIABLES Q*-----------------------------------------------------------------------R* S* T INTEGER BEG, BEGCOL, END, ENDCOL, FIN, FIRST U INTEGER I, IPNT, K, L, LAST, LSTROW V INTEGER START W* X* Y* Z* ***** SET VARIABLES ***** [* \* ]* NAME TYPE DESCRIPTION ^* ------ ---- ----------- _* `* BEG INT FIRST COLUMN OF CURRENT FIELDa* BEGCOL INT FIRST COLUMN ON SCREEN OF CURRENT FIELD b* END INT WORKING VALUE OF END COLUMN c* ENDCOL INT LAST COLUMN ON SCREEN OF CURRENT FIELD d* FIN INT LAST COLUMN OF CURRENT FIELD e* FIRST INT FIRST OF FORMS TO WRITE CURRENT RECORD f* I INT DO-LOOP RUNNING INDEXg* IPNT INT VALUE FROM INDEX FUNCTIONh* K INT DO-LOOP RUNNING INDEXi* L INT DO-LOOP RUNNING INDEXj* LAST INT LAST OF FORMS TO WRITE CURRENT RECORDk* LSTROW INT WORKING VALUE OF ROW l* START INT WORKING VALUE OF COLUMN m* n* o*-----------------------------------------------------------------------p* PROCEDURESq*-----------------------------------------------------------------------r* s* t* ============ INTRINSIC FUNCTIONS ============ u* v* w* x* y INTEGER INDEX z* {* ***** INTRINSIC FUNCTION DESCRIPTIONS *****|* }* ~* NAME TYPE DESCRIPTION * ------ ---- ----------- * * INDEX INT STANDARD FORTRAN INDEX FUNCTION * * * ============ SUBROUTINES CALLED ============* * EXTERNAL CLRSCR EXTERNAL FSOUT* * * ***** SUBROUTINE DESCRIPTIONS ****** * * NAME DESCRIPTION * ------ ----------- * * CLRSCR CLEAR SCREEN OF VIDEO TERMINAL * FSOUT WRITE (PARTIAL) RECORD TO TERMINAL SCREEN* * *-----------------------------------------------------------------------* END OF DECLARATIONS*-----------------------------------------------------------------------* * C BEGIN : WRTRCD ( WRITE RECORD )  IF ( IFIELD .EQ. 0 ) THEN  C INITIALIZE A LOT OF STUFF HERE WHEN IFIELD IS ZERO  DO 50 K = 1, 25 RCDCHG( K ) = 1  DO 25 L = 1, 133 MAPSCR( K, L ) = 0 25 CONTINUE 50 CONTINUE  LSTROW = 0 CALL CLRSCR RETURN  END IF C CHECK TO SEE IF THIS LINE HAS CHANGED. IF NO CHANGE RETURN, C THAT IS, DO NOT REWRITE TO SAVBUF, SCRBUF, AND SCREEN   IF ( SCRBUF( ROW )(COLUMN:COLUMN+LENGTH-1) .NE. DATA ) THEN RCDCHG( ROW ) = 0 LSTROW = ROW  SAVBUF( ROW )(COLUMN:COLUMN+LENGTH-1) = DATA  SCRBUF( ROW )(COLUMN:COLUMN+LENGTH-1) = DATA  ELSE  IF ( LSTROW .EQ. 0 ) LSTROW = ROW   IF ( LSTROW .EQ. ROW .OR. RCDCHG( ROW ) .EQ. 1 ) THEN RCDCHG( ROW ) = 0 LSTROW = ROW SAVBUF( ROW )(COLUMN:COLUMN+LENGTH-1) = DATA SCRBUF( ROW )(COLUMN:COLUMN+LENGTH-1) = DATA ELSE RETURN END IF  END IF C A RECORD IS TO BE WRITTEN TO THE SCREEN USING A SPECIFIED FORMAT C GET FORMAT FORMS NEEDED FOR THIS RECORD  FIRST = 0 LAST = 0  DO 100 I = 1, NFIELD  IPNT = INDEX( RECTYP( I ), FORMAT ) IF ( IPNT .NE. 0 ) THEN IF ( FIRST .EQ. 0 ) FIRST = I LAST = I END IF 100 CONTINUE  C WRITE RECORD TO SCREEN IN ACCORDANCE WITH THE PROPER FORMAT  DO 300 I = FIRST, LAST C GET BEGINNING AND FINAL ROW-SPACES FOR CURRENT FORMAT AND C TRANSLATE TO SCREEN COORDINATES.  BEG = FLDCO1( I ) FIN = FLDCO2( I )  C DETERMINE START AND END COLUMNS FROM CALLING PROGRAM  START = COLUMN  END = START + LENGTH - 1  C CALCULATE CORRECT COLUMNS FOR DATA AND THE SCREEN MAP. C THIS MUST BE DONE IN ORDER TO HANDLE A PARTIAL RECORD OF C TEXT SENT BY THE CALLING PROGRAM, PARTICULARLY WHEN THEC DATA COVERS MORE THAN ONE FIELD IN THE PARTIAL RECORD.   BEGCOL = COLUMN + BEG - 1  ENDCOL = COLUMN + FIN - 1  IF ( END .LT. FIN ) ENDCOL = END  C UPDATE SCREEN MAP   DO 200 K = BEGCOL, ENDCOL MAPSCR( ROW, K ) = I 200 END DO  C WRITE ( PARTIAL ) DATA RECORD TO SCREEN IN ACCORDANCE WITH C THE PROPER FORMAT.   IF ( VIEW+BEG-1 .GT. ENDCOL ) GO TO 300 CALL FSOUT( DATA(VIEW+BEG-1:ENDCOL), ROW, BEGCOL, DISCHR( I ) ) IF ( I .EQ. SAVK ) ROWKH = ROW 300 CONTINUE   RETURN END  CALL SCREEN( 12, CURROW, CURCOL )   ELSE IF( KEY .EQ. DEL ) THEN  CALL DELETE( CURROW, CURCOL )  ELSE IF( KEY .EQ. TAB) THEN  CALL TABOVR( CURROW, CURCOL, WCOLMS )  ELSE IF ( KEY .EQ. LF ) THEN