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' command to make it the active C character set, and the 'SO' 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' 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' 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