C
$STORAGE:2
C
C
C        *******************************************************
C        *                                                     *
C        *   The following Subroutines are used for cursor     *
C        *   control and special effects on the SCREEN ONLY    *
C        *                                                     *
C        *******************************************************
C
C
C
      SUBROUTINE CURUP(INUM)
C
C          This routine will move the CURSOR up
C
      INTEGER INUM
      IF(INUM.GT.0) THEN
      DO 50 K=1,INUM
         WRITE(*,'(1X,A1,A2,\)') 155,'1A'
         WRITE(*,'(1X,A1,A2,\)') 155,'2K'
   50 CONTINUE
      WRITE(*,'(1X,A1,A2,\)') 155,'5D'
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE CURDN(INUM)
C
C          This routine will move the CURSOR down
C
      INTEGER INUM
      IF(INUM.GT.0) THEN
      DO 50 K=1,INUM
         WRITE(*,'(1X,A1,A2,\)') 155,'1B'
         WRITE(*,'(1X,A1,A2,\)') 155,'2K'
   50 CONTINUE
      WRITE(*,'(1X,A1,A2,\)') 155,'5D'
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE CURRT(INUM)
C
C         This routine moves the CURSOR right
C
      INTEGER INUM
      IF(INUM.GT.0) THEN
         WRITE(*,'(1X,A1,I2.2,A1,\)') 155,INUM,'C'
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE CURLT(INUM)
C
C        This routine moves the CURSOR left
C
      INTEGER INUM
      IF(INUM.GT.0) THEN
         WRITE(*,'(1X,A1,I2.2,A1,\)') 155,INUM,'D'
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE LOCATE(HORZ,VERT,RELOC)
CC
CC         Author: Bruce W. Roeckel
CC           Date: December 1986
CC
CC    Description: This routine creates an escape sequence that will move
CC                 the cursor to a specific position on the screen. You must
CC                 write the sequence to the screen, followed by your data.
CC
CC               Example: I want to position TEST on line 10, Col 40
CC
CC                        CHARACTER RELOC*11
CC
CC                        CALL LOCATE(40,10,RELOC)
CC                        WRITE(*,100) RELOC,'TEST'
CC                  100   FORMAT(A11,A4)
CC
CC
CC
CC    Update #    Name       Date          Comments
CC    --------  ---------  --------  ----------------------------------
CC       001    Roeckel    01-07-87  Moved into System Library
CC
CC
      INTEGER HORZ,VERT
      CHARACTER RELOC*11
      IF((HORZ.GT.0) .AND. (HORZ.LT.133)) THEN
         IF((VERT.GT.0) .AND. (VERT.LT.25)) THEN
            WRITE(RELOC,100) 27,'[',VERT,';',HORZ,'H'
  100       FORMAT(1X,A1,A1,I3.3,A1,I3.3,A1)
         ENDIF
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE MOVEIT(HORZ,VERT)
C
C          This routine moves the CURSOR anywere on the screen
C          and clears the screen from that point down
C
      INTEGER HORZ,VERT
      IF((HORZ.GT.0) .AND. (HORZ.LT.133)) THEN
         IF((VERT.GT.0) .AND. (VERT.LT.25)) THEN
            WRITE(*,'(1X,A1,I3.3,A1,I3.3,A1,\)') 155,VERT,';',HORZ,'H'
            WRITE(*,'(1X,A1,A1,\)') 155,'J'
            WRITE(*,'(1X,A1,A2,\)') 155,'3D'
         ENDIF
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE UPTOP(HORZ,VERT)
C
C          This routine moves the CURSOR anywere on the screen
C          without clearing data on the screen         
C
      INTEGER HORZ,VERT,HOR2
      HOR2=HORZ-2
      IF(HOR2.LT.1) HOR2=1
      IF((HOR2.GT.0) .AND. (HOR2.LT.133)) THEN
         IF((VERT.GT.0) .AND. (VERT.LT.25)) THEN
            WRITE(*,'(1X,A1,I3.3,A1,I3.3,A1,\)') 155,VERT,';',HOR2,'H'
         ENDIF
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE BELL 
C
C         This routine will ring the BELL on the Keyboard     
C
      WRITE(*,'(1X,A1,\)') 7
      RETURN
      END
C
C
C
      SUBROUTINE DHTOP
C
C         This routine is part 1 of DOUBLE HEIGHT, DOUBLE WIDE
C
      WRITE(*,'(1X,A1,A2,\)') 27,'#3'
      WRITE(*,'(1X,A1,A2,\)') 155,'2D'
      RETURN
      END
C
C
C
      SUBROUTINE DHBOT
C
C         This routine is part 2 of DOUBLE HEIGHT, DOUBLE WIDE
C
      WRITE(*,'(1X,A1,A2,\)') 27,'#4'
      WRITE(*,'(1X,A1,A2,\)') 155,'2D'
      RETURN
      END
C
C
C
      SUBROUTINE HOME
C
C         This routine sends the cursor to the HOME position
C
      WRITE(*,'(1X,A1,A1,\)') 155,'H'
      RETURN
      END
C
C
C
      SUBROUTINE CLS
C
C          This routine clears from the top of the screen
C
      WRITE(*,'(1X,A1,A1,\)') 155,'H'
      WRITE(*,'(1X,A1,A2,\)') 155,'2J'
      RETURN
      END
C
C
C
      SUBROUTINE BOLD
C
C          This routine will BOLD all letters
C
      WRITE(*,'(1X,A1,A2,\)') 155,'1m'
      WRITE(*,'(1X,A1,A2,\)') 155,'2D'
      RETURN
      END
C
C
C
      SUBROUTINE OFF
C
C          This routine turns off all screen attributes
C
      WRITE(*,'(1X,A1,A2,\)') 155,'0m'
      WRITE(*,'(1X,A1,A2,\)') 155,'2D'
      RETURN
      END
C
C
C
      SUBROUTINE ULINE
C
C          This routine will start UNDERLINE feature
C
      WRITE(*,'(1X,A1,A2,\)') 155,'4m'
      WRITE(*,'(1X,A1,A2,\)') 155,'2D'
      RETURN
      END
C
C
C
      SUBROUTINE HLIGHT(ILEN)
C
C         This routine will highlight input areas
C
      CALL RVIDEO
         DO 100 I=1,ILEN
         WRITE(*,'(1X,\)')
  100    CONTINUE
      CALL OFF
         ILEN=ILEN+1
         CALL CURLT(ILEN)
      RETURN
      END
C
C
C
      SUBROUTINE BLINK
C
C          This routine will invoke BLINKING of all characters
C
      WRITE(*,'(1X,A1,A2,\)') 155,'5m'
      WRITE(*,'(1X,A1,A2,\)') 155,'2D'
      RETURN
      END
C
C
C
      SUBROUTINE RVIDEO
C
C         This routine will REVERSE VIDEO all characters
C
      WRITE(*,'(1X,A1,A2,\)') 155,'7m'
      WRITE(*,'(1X,A1,A2,\)') 155,'2D'
      RETURN
      END
C
C
C
      SUBROUTINE COL132
C
C         This routine selects 132 COL display
C
      WRITE(*,'(1X,A1,A3,\)') 155,'?3h'
      WRITE(*,'(1X,A1,A2,\)') 155,'3D'
      RETURN
      END
C
C
C
      SUBROUTINE COL080
C
C         Thsi routine selects 80 COL display
C
      WRITE(*,'(1X,A1,A3,\)') 155,'?3l'
      WRITE(*,'(1X,A1,A2,\)') 155,'3D'
      RETURN
      END
C
C
C
      SUBROUTINE KEYOFF
C
C         This routine locks the KEYBOARD
C
      WRITE(*,'(1X,A1,A2,\)') 155,'2h'
      WRITE(*,'(1X,A1,A2,\)') 155,'2D'
      RETURN
      END
C
C
C
      SUBROUTINE KEYON
C
C         This routine resets the KEYBOARD
C
      WRITE(*,'(1X,A1,A2,\)') 155,'2l'
      WRITE(*,'(1X,A1,A2,\)') 155,'2D'
      RETURN
      END
C
C
C        *******************************************************
C        *                                                     *
C        *   The following Subroutines are used for the        *
C        *   special VT100 Graphic Character set               *
C        *                                                     *
C        *******************************************************
C
C
C
      SUBROUTINE GCHAR(UNIT) 
C
C         This routine will select the VT100 Graphics Character set
C         as G1. Use the 'SI' <cntl/O> command to make it the active
C         character set, and the 'SO' <cntl/N> command to bring back 
C         the ASCII character set as the active one.
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,A2,\)') 27,')0'
      RETURN
      END
C
C
C
      SUBROUTINE GPHON(UNIT)
C
C         This routine will activate the Graphics character set
C             (This is the 'SI' <cntl/O> command)
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,\)') 14
      RETURN
      END
C
C
C
      SUBROUTINE GPHOFF(UNIT)
C
C         This routine will deactivate the Graphics character set
C             (This is the 'SO' <cntl/N> command)
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,\)') 15
      RETURN
      END
C
C
C        *******************************************************
C        *                                                     *
C        *   The following Subroutines are used for special    *
C        *   effects on the LA-50 printer                      *
C        *                                                     *
C        *******************************************************
C
C
      SUBROUTINE PBOLD(UNIT)
C
C        This routine starts BOLD printing
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,A2,\)') 155,'1m'
      RETURN
      END
C
C
C
      SUBROUTINE PULINE(UNIT)
C
C        This routine selects UNDERLINED print
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,A2,\)') 155,'4m'
      RETURN
      END
C
C
C
      SUBROUTINE POFF(UNIT)
C
C        This routine turns off BOTH Bold & Underline printing
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,A2,\)') 155,'0m'
      RETURN
      END
C
C
C
      SUBROUTINE DWIDTH(UNIT)
C
C        This routine select DOUBLE-WIDTH print
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,A2,\)') 155,'5w'
      RETURN
      END
C
C
C
      SUBROUTINE SWIDTH(UNIT)
C
C       This routine selects STANDARD-WIDTH print
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,A2,\)') 155,'0w'
      RETURN
      END
C
C
C
      SUBROUTINE WWIDTH(UNIT)
C
C       This routine selects 132 Column printing 
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,A2,\)') 155,'4w'
      RETURN
      END
C
C
C
      SUBROUTINE LQPON(UNIT)
C
C        This routine selects LETTER QUALITY print
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,A3,\)') 155,'2"z'
      RETURN
      END
C
C
C
      SUBROUTINE LQPOFF(UNIT)
C
C        This routine selects NORMAL print
C
      INTEGER UNIT
      WRITE(UNIT,'(1X,A1,A3,\)') 155,'0"z'
      RETURN
      END
