C @(#)vt125drv.for	17.1.1.1 (ES0-DMD) 01/25/02 17:33:39
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
C  @(#)vt125drv.for	17.1.1.1 (OAA-ASTRONET) 01/25/02 17:33:39
C*
C* HEADER : vt125drv.for   - Vers 3.6.000  - Oct 1991 -  L. Fini, Oss. Arcetri
C*
C*
C
C  AGL device driver for the DEC VT125 graphic terminal.
C  This driver has been designed to work under VAX/VMS only and is
C  not expected to be portable to other O.S.
C
C  AGL 3.0 version - L. Fini May 1987
C
C  Note: this version is mostly based on the Version 2.0 driver code
C        developed at ASTRONET node in Trieste.
C
C  Driver entry points:
C
C     Initialize  AGLIN125
C     Cursor en.  AGLCU125
C     Erase       AGLER125
C     Escape      AGLES125
C     Flush buff. AGLSE125
C     Finish      AGLTE125
C     Polyline    AGLPL125
C
	SUBROUTINE AGLCU125(DVCOM)
C
	COMMON /AGLVT125/ CBUF(80),BUFPNT
	BYTE  CBUF
	INTEGER BUFPNT
C
	STRUCTURE /STRUC/
	  REAL    VECTX(0:0)
	  REAL    VECTY(0:0)
	  REAL    FLTB(0:9)
	  INTEGER INTB(0:19)
	  INTEGER ERRCOD
	  INTEGER CHANNL
	  BYTE    BYTBUF(132)
	END STRUCTURE
C
	RECORD /STRUC/ DVCOM
C
	CHARACTER*132 CHRBUF
C
	INCLUDE 'MID_INCLUDE:AGLERROR.INC'
C
	INTEGER AGLC2FOR
	INTEGER INTERACTIVE  
	INTEGER RETPIXVAL    
	INTEGER PLNSELECT    
	INTEGER PARTERASE    
	INTEGER UPDOSCROLL  
	INTEGER LFRGSCROLL  
	INTEGER SEPALPHA    
	INTEGER ERASABLE   
C
	PARAMETER( INTERACTIVE =1)  ! Device interactive flag mask
	PARAMETER( RETPIXVAL   =2)  ! Can return locator pixel value
	PARAMETER( PARTERASE   =4)  ! Partial erase flag mask
	PARAMETER( SEPALPHA    =8)  ! Separated alpha plane flag mask
	PARAMETER( ERASABLE   =16)  ! Erasable device flag mask
	PARAMETER( EXECOMMND  =32)  ! Execute command at close flag mask
C
	INTEGER FLAGS  
	INTEGER PLANES 
	INTEGER XPIXEL 
	INTEGER YPIXEL 
	INTEGER VERSCODE
	PARAMETER ( VERSCODE =  36 )
C
	PARAMETER ( FLAGS  =  INTERACTIVE .OR. ERASABLE .OR.
     .	 		      PARTERASE .OR. SEPALPHA )
	PARAMETER ( PLANES =  1 )         
	PARAMETER ( XPIXEL =  800 )
	PARAMETER ( YPIXEL =  480 )
C
	REAL SMCHAR
	REAL BSCHAR
	REAL MDCHAR
	REAL LGCHAR
	REAL XLENG
	REAL YLENG
	REAL XMAXL
	REAL YMAXL
C
	PARAMETER ( SMCHAR =  2.0 )
	PARAMETER ( BSCHAR =  3.0 )        
	PARAMETER ( MDCHAR =  4.0 )
	PARAMETER ( LGCHAR =  6.0 )
	PARAMETER ( XLENG  =  18.6 )
	PARAMETER ( YLENG  =  12.8 )
	PARAMETER ( XMAXL  =  0.0 )
	PARAMETER ( YMAXL  =  0.0 )
C
C					AUXILIARY VARIABLES
	INTEGER INTERR
	INTEGER IX0,IY0
	INTEGER NDISPL
	INTEGER IDX, J, K
	REAL XXSEL,XYSEL,YYSEL,YXSEL
	INTEGER AUX
	INTEGER END
C
	CHARACTER CHFLAG*1
	CHARACTER AUXSTR*13
C
	INTEGER*4 F_READ, F_WRITE, F_RCURS
	INTEGER*4 NCHARS
	INTEGER*2 IOSB(4)
C
	INTEGER IO$_READVBLK  
	INTEGER IO$M_NOECHO   
	INTEGER IO$_TTYREADALL
	INTEGER IO$_WRITEVBLK 
	INTEGER IO$M_NOFORMAT 
	INTEGER IO$M_ESCAPE
	INTEGER NORET
	INTEGER SS$_NORMAL
C
	PARAMETER ( IO$_READVBLK    = '00000031'X )
	PARAMETER ( IO$M_NOECHO     = '00000040'X )
	PARAMETER ( IO$_TTYREADALL  = '0000003A'X )
	PARAMETER ( IO$_WRITEVBLK   = '00000030'X )
	PARAMETER ( IO$M_NOFORMAT   = '00000100'X )
	PARAMETER ( SS$_NORMAL      = '00000001'X )
	PARAMETER ( IO$M_PURGE      = '00000800'X )
	PARAMETER ( IO$M_ESCAPE     = '00004000'X )
	PARAMETER ( NORET	    = '0'X )
	PARAMETER ( F_READ  = IO$_READVBLK .OR.
     .	                      IO$M_NOECHO  .OR.
     .	                      IO$_TTYREADALL .OR.
     .	                      IO$M_PURGE          )
	PARAMETER ( F_WRITE = IO$_WRITEVBLK .OR. IO$M_NOFORMAT )
	PARAMETER ( F_RCURS = IO$_READVBLK .OR.
     .	                      IO$M_NOECHO  .OR.
     .	                      IO$M_ESCAPE .OR.
     .	                      IO$M_PURGE          )
C
	INTEGER*4 SYS$ASSIGN,SYS$DASSGN
	INTEGER*4 SYS$QIOW
	INTEGER*2 VSSTAT(4)
C
	REAL VT1_FACT_X, VT1_FACT_Y
	REAL VT1_INP_X,  VT1_INP_Y
	PARAMETER ( VT1_FACT_X = 799. )		! NORM. TO DEVICE COORDINATES
	PARAMETER ( VT1_FACT_Y = 479. )		! CONVERSION FACTORS
C
	PARAMETER ( VT1_INP_X  = 1.25156E-3)	! DEVICE INPUT TO NOR. COORD.
	PARAMETER ( VT1_INP_Y  = 2.08768E-3)	! CONVERSION FACTORS
C
	INTEGER CURR_X, CURR_Y			! ABSOLUTE CURRENT POSITION
C
C						AUXILIARY VT125 VARIABLES
C
	INTEGER IXX, IYY			
	INTEGER*2 IO_STATUS(4), IO_MASK(2)
	INTEGER*4 JO_STATUS, JMOV(2), JO_MASK(2), TERMINATOR(4)
	EQUIVALENCE (IO_MASK(1),JO_MASK(1))
	BYTE IPUF(2), IBUF(16), OBUF(128)
C
C
C						DEFINE SOME VT 125 COMMANDS
C
	CHARACTER VTSTART*51			! STARTING SEQUENCE
	BYTE BVTSTART(51)
	EQUIVALENCE ( VTSTART, BVTSTART )
C
	CHARACTER ERASE*9			! ERASE SCREEN
	BYTE BERASE(9)
     .		/27,80,112,83,40,69,41,27,92/	! <ESC>PpS(E)<ESC>\
	EQUIVALENCE ( ERASE, BERASE )
C
	CHARACTER INIT*4			! CLEAR ALPHA SCREEN
	BYTE BINIT(4) /27,91,50,74/		! <ESC>[2J
	EQUIVALENCE ( INIT, BINIT )
C
	BYTE MOVCUR(7) 				! MOVE CURSOR MACRO
	DATA MOVCUR /27,80,112,64,90,27,92/	! <ESC>Pp@Z<ESC>\
C
C---------------------------------------------------------------------
C
	DVCOM.ERRCOD = AGLNOERR
C
	IO_MASK(1) = 16
	IO_MASK(2) = 0
	JO_MASK(2) = %LOC (TERMINATOR)
	TERMINATOR(1) = '37777760377'O
	TERMINATOR(2) = '37777777777'O
	TERMINATOR(3) = '37777777777'O
	TERMINATOR(4) = '37777777777'O
	JUMP = 10
	JMOV(1) = NINT(DVCOM.FLTB(0)*VT1_FACT_X)
	JMOV(2) = NINT(DVCOM.FLTB(1)*VT1_FACT_Y)
C
C					ENABLE THE SOFTWARE CURSOR
C
	CALL AGLVT1PSC (JMOV,OBUF,NB)
	INTERR = SYS$QIOW (,%VAL(DVCOM.CHANNL),%VAL(F_WRITE),IO_STATUS,,,
	1		   OBUF,%VAL(NB),,,,)
	INTERR = SYS$QIOW (,%VAL(DVCOM.CHANNL),%VAL(F_WRITE),IO_STATUS,,,
	1		   MOVCUR,%VAL(7),,,,)
C
	INTERR = SYS$QIOW (,%VAL(DVCOM.CHANNL),%VAL(F_RCURS),IO_STATUS,,,
	1		   IBUF,%VAL(6),,JO_MASK,,)
	IF( INTERR .NE. SS$_NORMAL .OR. .NOT. IO_STATUS(1) ) THEN
	    DVCOM.ERRCOD = DEVIOERR
	    GOTO 9999
	ELSE 
	    DVCOM.ERRCOD = AGLNOERR
	ENDIF
C
	DO WHILE (IO_STATUS(3) .EQ. 27)
C
		IF (IBUF(IO_STATUS(2)+3) .EQ. 65) THEN
			JMOV(2) = JMOV(2) + JUMP
			IF (JMOV(2) .GT. 479) JMOV(2) = JMOV(2) - 480
			CALL AGLVT1PC (JMOV,OBUF,NB)
			INTERR = SYS$QIOW (,%VAL(DVCOM.CHANNL),
     ,			                    %VAL(F_WRITE),
     ,			                    IO_STATUS,,,
     ,					    OBUF,%VAL(NB),,,,)
C
		ELSE IF (IBUF(IO_STATUS(2)+3) .EQ. 66) THEN
			JMOV(2) = JMOV(2) - JUMP
			IF (JMOV(2) .LT. 0) JMOV(2) = 480 + JMOV(2)
			CALL AGLVT1PC (JMOV,OBUF,NB)
			INTERR = SYS$QIOW (,%VAL(DVCOM.CHANNL),
     ,					    %VAL(F_WRITE),
     ,					    IO_STATUS,,,
     ,					    OBUF,%VAL(NB),,,,)
C
		ELSE IF (IBUF(IO_STATUS(2)+3) .EQ. 67) THEN
			JMOV(1) = JMOV(1) + JUMP
			IF (JMOV(1) .GT. 799 ) JMOV(1) = JMOV(1) - 800
			CALL AGLVT1PC (JMOV,OBUF,NB)
			INTERR = SYS$QIOW (,%VAL(DVCOM.CHANNL),
     ,	                                    %VAL(F_WRITE),
     ,	                                    IO_STATUS,,,
     ,					    OBUF,%VAL(NB),,,,)
C
		ELSE IF (IBUF(IO_STATUS(2)+3) .EQ. 68) THEN
			JMOV(1) = JMOV(1) - JUMP
			IF (JMOV(1) .LT. 0 ) JMOV(1) = 800 + JMOV(1)
			CALL AGLVT1PC (JMOV,OBUF,NB)
			INTERR = SYS$QIOW (,%VAL(DVCOM.CHANNL),
     ,					    %VAL(F_WRITE),
     ,					    IO_STATUS,,,
     ,					    OBUF,%VAL(NB),,,,)
C
		ELSE IF (IBUF(IO_STATUS(2)+3) .EQ. 80) THEN
			JUMP = 1
C
		ELSE IF (IBUF(IO_STATUS(2)+3) .EQ. 81) THEN
			JUMP = 5
C
		ELSE IF (IBUF(IO_STATUS(2)+3) .EQ. 82) THEN
			JUMP = 10
C
		ELSE IF (IBUF(IO_STATUS(2)+3) .EQ. 83) THEN
			JUMP = 50
		END IF
C
		INTERR = SYS$QIOW (,%VAL(DVCOM.CHANNL),
     ,	                            %VAL(F_RCURS),IO_STATUS,,,
     ,				   IBUF,%VAL(6),,JO_MASK,,)
		IF( INTERR .NE. SS$_NORMAL .OR. .NOT. IO_STATUS(1) ) THEN
		    DVCOM.ERRCOD = DEVIOERR
		    GOTO 9999
		ELSE 
		    DVCOM.ERRCOD = AGLNOERR
		ENDIF
	END DO
C
C						READ KEYBOARD AND POSITION
C
	IX = JMOV(1)
	IY = JMOV(2)
	IPUF(1) = IBUF(1)
	CALL AGLVT1PC (JMOV,OBUF,NB)
	INTERR = SYS$QIOW (,%VAL(DVCOM.CHANNL),%VAL(F_WRITE),IO_STATUS,,,
	1		   OBUF,%VAL(NB),,,,)
	INTERR = SYS$QIOW (,%VAL(DVCOM.CHANNL),%VAL(F_WRITE),IO_STATUS,,,
	1		   MOVCUR,%VAL(7),,,,)

C
C						CONVERT COORDINATES
C
	DVCOM.FLTB(0) = REAL(IX)*VT1_INP_X
	DVCOM.FLTB(1) = REAL(IY)*VT1_INP_Y
	DVCOM.INTB(1) = IPUF(1)
C
C						RETURN PIXEL VALUE
C						UNSUPPORTED
C
	DVCOM.INTB(2) = 0
	GOTO 9999
C
C ------------------------------- AGLER125 ------------------------------
C
	ENTRY AGLER125(DVCOM)
C
	DVCOM.ERRCOD = AGLNOERR
C						PARTIAL ERASE UNSUPPORTED YET
1000	CONTINUE
C
     	INTERR = SYS$QIOW ( ,%VAL(DVCOM.CHANNL), %VAL(F_WRITE),IOSB,,,
     ,	                   BERASE, %VAL(LEN(ERASE)),,
     ,	                   %VAL(NORET),,)
C
	DVCOM.ERRCOD = AGLNOERR
	GOTO 9999
C
C ------------------------------- AGLES125 ------------------------------
C
	ENTRY AGLES125(DVCOM)
	DVCOM.ERRCOD = UNSFEATINF
	GOTO 9999
C
C------------------------- AGLIN125 -------------------------------
C
	ENTRY AGLIN125(DVCOM)
C
	DVCOM.ERRCOD = AGLNOERR
C
	IF ( DVCOM.INTB(0) .EQ. 0 ) THEN
C						GET I/O CHANNEL
	  K = AGLC2FOR ( DVCOM.BYTBUF, CHRBUF )
	  INTERR = SYS$ASSIGN ( CHRBUF(1:K), DVCOM.CHANNL,,)
	  IF ( INTERR .NE. SS$_NORMAL ) THEN
	    DVCOM.ERRCOD = DEVOPNERR
	    GOTO 9999
	  ENDIF
C						CLEAR ALPHA SCREEN
C
     	  INTERR = SYS$QIOW ( ,%VAL(DVCOM.CHANNL), %VAL(F_WRITE),IOSB,,,
     ,	                     BINIT, %VAL(LEN(INIT)),,
     ,	                     %VAL(NORET),,)
C
C						SET UP CORRECT SCREEN
C							APPEARANCE
C
	  VTSTART = ' PpS(A[0,479][799,0]) \'
	  VTSTART ( 1: 1) = CHAR (27)
  	  VTSTART (22:22) = CHAR (27)
     	  INTERR = SYS$QIOW ( ,%VAL(DVCOM.CHANNL), %VAL(F_WRITE),IOSB,,,
     ,	                     BVTSTART, %VAL(23),,
     ,	                     %VAL(NORET),,)
C
C						SET UP CURSOR MACROGRAPH
C
	  VTSTART = ' Pp@:ZW(C,M255)V22P6666V22000P444444V000W(V,M1)@; \'
	  VTSTART ( 1: 1) = CHAR (27)
	  VTSTART (50:50) = CHAR (27)
     	  INTERR = SYS$QIOW ( ,%VAL(DVCOM.CHANNL), %VAL(F_WRITE),IOSB,,,
     ,	                     BVTSTART, %VAL(51),,
     ,	                     %VAL(NORET),,)
C
	  DVCOM.INTB(0) = DVCOM.CHANNL
C
	  BUFPNT=0
C						SET INITIAL COLOR CODE
	  CALL AGLPUTB ( 'W(I3)', DVCOM )
C
	ELSE IF (DVCOM.INTB(0) .EQ. 1) THEN
C						SET DEVICE CHARACT. PARAMS
	  DVCOM.ERRCOD=AGLNOERR
	  DVCOM.FLTB(0) = XLENG
	  DVCOM.FLTB(1) = YLENG
C
	  DVCOM.FLTB(2) = 1.0
	  DVCOM.FLTB(3) = 0.0
	  DVCOM.FLTB(4) = 0.0
	  DVCOM.FLTB(5) = 0.0
	  DVCOM.FLTB(6) = XLENG
	  DVCOM.FLTB(7) = YLENG
	  DVCOM.FLTB(8) = XMAXL
	  DVCOM.FLTB(9) = YMAXL  
C
	  DVCOM.INTB(1) = FLAGS  
	  DVCOM.INTB(2) = PLANES 
	  DVCOM.INTB(3) = XPIXEL 
	  DVCOM.INTB(4) = YPIXEL 
	  DVCOM.INTB(5) = VERSCODE
	  DVCOM.INTB(6) = 0
	  DVCOM.INTB(7) = 0
	  DVCOM.INTB(8) = 3
	  DVCOM.INTB(9) = 0
C
	  DVCOM.INTB(10) = 1
	  DVCOM.INTB(11) = 2
	  DVCOM.INTB(12) = 3
	  DVCOM.INTB(13) = 1
	  DVCOM.INTB(14) = 2
	  DVCOM.INTB(15) = 3
	  DVCOM.INTB(16) = 3
C
	  DVCOM.ERRCOD=AGLNOERR
C
	ELSE IF ( DVCOM.INTB(0) .EQ. 2 ) THEN
C						SET COLOR CODE (UNSUPP)
C	  END = 5
C	  WRITE(AUXSTR(:END),FMT='(3HW(I,I1,1H))') DVCOM.INTB(1)
C	  CALL AGLPUTB ( AUXSTR(:END), DVCOM )
	  DVCOM.ERRCOD=AGLNOERR
	ELSE 
C						SET LINE STYLE (UNSUPP)
C						SET LINE WIDTH UNSUPPORTED
	  DVCOM.ERRCOD=AGLNOERR
	ENDIF
C
	GOTO 9999
C
C---------------------------- AGLMV125 -----------------------------
C
	ENTRY AGLMV125(DVCOM)
C
	DVCOM.ERRCOD = AGLNOERR
C
	IX0 = NINT(DVCOM.FLTB(0)*VT1_FACT_X)
	IY0 = NINT(DVCOM.FLTB(1)*VT1_FACT_Y)
C
	MX = 3
	IF (IX0.LT.100) MX = 2
	IF (IX0.LT.10)  MX = 1
	MY = 3
	IF (IY0.LT.100) MY = 2
	IF (IY0.LT.10)  MY = 1
	END = MX+MY+4
	WRITE(AUXSTR(:END),FMT='(2HP[,I<MX>,1H,,I<MY>,1H])') IX0,IY0
	CALL AGLPUTB (AUXSTR(:END), DVCOM)
C
	CURR_X = IX0
	CURR_Y = IY0
C
	GOTO 9999
C
C-------------------------  AGLTE125 -------------------------------
C
	ENTRY AGLTE125 (DVCOM)
C
	DVCOM.ERRCOD = AGLNOERR
C
	CALL SYS$DASSGN ( DVCOM.CHANNL )
	GOTO 9999
C
C-------------------------  AGLTR125 -------------------------------
C
	ENTRY AGLTR125 (DVCOM)
C
	DVCOM.ERRCOD = AGLNOERR
C
	IX0 = NINT( DVCOM.FLTB(0)*VT1_FACT_X )
	IY0 = NINT( DVCOM.FLTB(1)*VT1_FACT_Y )
	MX = 3
	IF (IX0.LT.100) MX = 2
	IF (IX0.LT.10)  MX = 1
	MY = 3
	IF (IY0.LT.100) MY = 2
	IF (IY0.LT.10)  MY = 1
	END = MX+MY+6
	WRITE(AUXSTR(:END),FMT='(4HV[][,I<MX>,1H,,I<MY>,1H])') IX0,IY0
	CALL AGLPUTB (AUXSTR(:END), DVCOM )
C
	DVCOM.ERRCOD = AGLNOERR
C
9999	CONTINUE
	END
C
C
C-------------------------  AGLPL125 -------------------------------
C
	SUBROUTINE AGLPL125 (DVCOM)
C
	COMMON /AGLVT125/ CBUF(80),BUFPNT
	BYTE  CBUF
	INTEGER BUFPNT
C
	STRUCTURE /STRUC/
	  REAL    VECTX(0:0)
	  REAL    VECTY(0:0)
	  REAL    FLTB(0:9)
	  INTEGER INTB(0:19)
	  INTEGER ERRCOD
	  INTEGER CHANNL
	  BYTE    BYTBUF(132)
	END STRUCTURE
C
	RECORD /STRUC/ DVCOM
C
C
C
	CALL AGLPL125B(DVCOM,%VAL(DVCOM.VECTX(0)),%VAL(DVCOM.VECTY(0)))
	END
C-------------------------  AGLPL125 -------------------------------
C
	SUBROUTINE AGLPL125B (DVCOM,VX,VY)
C
	STRUCTURE /STRUC/
	  REAL    VECTX(0:0)
	  REAL    VECTY(0:0)
	  REAL    FLTB(0:9)
	  INTEGER INTB(0:19)
	  INTEGER ERRCOD
	  INTEGER CHANNL
	  BYTE    BYTBUF(132)
	END STRUCTURE
C
	RECORD /STRUC/ DVCOM
C
	REAL VX(1),VY(1)
C
	IF(DVCOM.INTB(0) .LT. 2) RETURN
C
	DVCOM.FLTB(0) = VX(1)
	DVCOM.FLTB(1) = VY(1)
	CALL AGLMV125(DVCOM)
C
	DO 1000 I=2,DVCOM.INTB(0)
	DVCOM.FLTB(0) = VX(I)
	DVCOM.FLTB(1) = VY(I)
	CALL AGLTR125(DVCOM)
1000	CONTINUE
9999	CONTINUE
	END
C
C--------------------------- AGLSE125 -----------------------------
C
	SUBROUTINE AGLSE125(DVCOM)
C
	COMMON /AGLVT125/ CBUF(80),BUFPNT
	BYTE  CBUF
	INTEGER BUFPNT
C
	STRUCTURE /STRUC/
	  REAL    VECTX(0:0)
	  REAL    VECTY(0:0)
	  REAL    FLTB(0:9)
	  INTEGER INTB(0:19)
	  INTEGER ERRCOD
	  INTEGER CHANNL
	  BYTE    BYTBUF(132)
	END STRUCTURE
C
	RECORD /STRUC/ DVCOM
C
C
	INCLUDE 'MID_INCLUDE:AGLERROR.INC'
C
	INTEGER*4 F_WRITE
	INTEGER*2 IOSB(4)
C
	INTEGER IO$_WRITEVBLK 
	INTEGER IO$M_NOFORMAT 
	INTEGER NORET
	INTEGER SS$_NORMAL
C
	PARAMETER ( IO$_WRITEVBLK   = '00000030'X )
	PARAMETER ( IO$M_NOFORMAT   = '00000100'X )
	PARAMETER ( SS$_NORMAL      = '00000001'X )
	PARAMETER ( NORET	    = '0'X )
	PARAMETER ( F_WRITE = IO$_WRITEVBLK .OR. IO$M_NOFORMAT )
C
	INTEGER*4 SYS$QIOW
C
	CHARACTER PROLOG*3			! VT125 PROLOG
	BYTE BPROLOG(3)	/27,80,112/		! <ESC>Pp
	EQUIVALENCE ( PROLOG, BPROLOG )
C
	CHARACTER EPILOG*2			! VT125 EPILOG
	BYTE BEPILOG(2)	/27,92/			! <ESC>\
	EQUIVALENCE ( EPILOG, BEPILOG )
C
	DVCOM.ERRCOD = AGLNOERR
C
	IF ( BUFPNT .GT. 0 ) THEN
C
C					SEND PROLOG
C
	  INTERR = SYS$QIOW ( ,%VAL(DVCOM.CHANNL), %VAL(F_WRITE),IOSB,,,
     ,	                     BPROLOG, %VAL(LEN(PROLOG))
     ,	                     ,,%VAL(NORET),,)
C
C					SEND THE BUFFER
C
     	  INTERR = SYS$QIOW ( ,%VAL(DVCOM.CHANNL), %VAL(F_WRITE),IOSB,,,
     ,	                     CBUF, %VAL(BUFPNT)
     ,	                     ,,%VAL(NORET),,)
C
C					RESET DEVICE IN ALPHA MODE
C
	  INTERR = SYS$QIOW ( ,%VAL(DVCOM.CHANNL), %VAL(F_WRITE),IOSB,,,
     ,	                      BEPILOG, %VAL(LEN(EPILOG))
     ,	                      ,,%VAL(NORET),,)
C
	  BUFPNT = 0
C
	  IF( INTERR .NE. SS$_NORMAL ) THEN
	    DVCOM.ERRCOD = DEVIOERR
	  ELSE 
	    DVCOM.ERRCOD = AGLNOERR
	  END IF
	ENDIF
C
	END
C
	SUBROUTINE AGLPUTB ( CHSTRG, DVCOM )
C
	CHARACTER*(*) CHSTRG
C
C
	STRUCTURE /STRUC/
	  REAL    VECTX(0:0)
	  REAL    VECTY(0:0)
	  REAL    FLTB(0:9)
	  INTEGER INTB(0:19)
	  INTEGER ERRCOD
	  INTEGER CHANNL
	  BYTE    BYTBUF(132)
	END STRUCTURE
C
	RECORD /STRUC/ DVCOM
C
C
	COMMON /AGLVT125/ CBUF(80),BUFPNT
	BYTE  CBUF
	INTEGER BUFPNT
C
	IF ( (LEN(CHSTRG)+BUFPNT) .GT. 80 ) THEN
	  CALL AGLSE125(DVCOM)			!	SEND THE OUTPUT BUFFER
	ENDIF
C
	DO 1000 I = 1, LEN(CHSTRG)
	  BUFPNT = BUFPNT+1
	  CBUF ( BUFPNT ) = ICHAR(CHSTRG(I:I))
1000	CONTINUE
C
	END
C
	INTEGER FUNCTION AGLC2FOR(BUF,CHR)
C
C  CONVERTS A C-LIKE STRING INTO A FORTRAN CHARACTER STRING
C  AND RETURNS STRING LENGTH
C
	BYTE BUF(1)
	CHARACTER*(*) CHR
C
	N=0
	CHR=' '
	DO 1000 I=1,LEN(CHR)
	IF(BUF(I).EQ.0) GOTO 1010
	CHR(I:I)=CHAR(BUF(I))
	N=N+1
1000	CONTINUE
1010	CONTINUE
	AGLC2FOR=N
	END