SUBROUTINE MESSAG(LMESS,IMESSIN,XPOS,YPOS)
!	
!	Program to analyze text string and output it using GTX
!	This program does some of the functions of the
!	corresponding DISSPLA routine.
!
!	Programmer:	T. Worlton
!			Argonne National Laboratory
!			12-February-1988
!
!	Arguments:
!		LMESS	A byte or character string
!		IMESSIN	Length of string LMESS (OPTIONAL)
!		XPOS	x-position in inches to start writing string
!		YPOS	y-position in inches where string is to start
!
!
!	8-DEC-88  Added update of workstations at end of CHRMSG
!	28-FEB-89 Allowed repeating switch character to output it
!	          instead of interpreting it.
!	17-MAR-89 Removed NMAP and put it in GKI, so it could be reset
!		  by ENDPL.
!	 2-MAR-90 Added save and restore of GKS state to CHRMSG
!
	BYTE BCHAR
	CHARACTER LMESS*(*)
	INTEGER IMESS
	REAL XPOS,YPOS,WDWIND(4),WDVIEW(4)
	INCLUDE 'GPLOT_SRC:GKA.INC/LIST'
	INCLUDE 'GPLOT_SRC:GKALF.INC/LIST'
	INCLUDE 'GPLOT_SRC:GKI.INC/LIST'
C	CHARACTER CBUFF*200

C	CALL STRAN(LMESS,IMESS,CBUFF,IL)

	IF(%LOC(IMESSIN) .EQ. 0) THEN
	  IMESS = 0
	ELSE
	  IMESS = IMESSIN
	END IF

	LENMES = LEN(LMESS)
	IF(LENMES .GT. IMESS .AND. IMESS .GT. 0 
	1  .AND. IMESS .NE. 100) THEN
	  LENMES = IMESS
	END IF
	IL =  INDEX(LMESS(:LENMES),ENDSTR(1:LENEND))
	IF(IL .GT. 0) THEN
	  IL = IL - 1
	ELSE
	  IL = LENMES
	END IF
C	CALL CHRMSG(XPOS,YPOS,CBUFF(1:IL) )
	CALL CHRMSG(XPOS,YPOS,LMESS(1:IL) )

	RETURN
	END
 
	SUBROUTINE CHRMSG(XPOSM,YPOSM,CMESS)
	CHARACTER*(*) CMESS
	REAL XPOSM,YPOSM,SHITE,TXANG
	INCLUDE 'GPLOT_SRC:GKA.INC/LIST'
	INCLUDE 'GPLOT_SRC:GKI.INC/LIST'
	INCLUDE 'GPLOT_SRC:GKALF.INC/LIST'
	INCLUDE 'SYS$LIBRARY:GKSDEFS.BND'
	CHARACTER*200 TMESS,CIN*20,COUT*20,CTEMP*1
	BYTE BMESS(200),BCHAR,BCHIN,BCHOUT
	INTEGER*4 HALIN,VALIN,FONTIN,PRECIN,WKCAT,LTRAN(5)
	INTEGER*4 HALIGN,VALIGN,IOUT,CFLAG
	LOGICAL *1 LMESS(200)
	REAL ERX(4),ERY(4),IS(6),CREC(4)
	DATA WKID/0/
 
!	Save initial GKS state
	CALL GQCNTN(IERR,ITRAN)
	CALL QWORK(NACT,WKID,WKTYPE,WKCAT)
	CALL GQCHH(IERR,SHITE)
	CALL GQCLIP(IERR,CFLAG,CREC)
	CALL GQTXFP(IERR,FONTIN,PRECIN)
	CALL GQTXAL(IERR,HALIN,VALIN)
	CALL GQCHSP(IERR,SPACIN)
	CALL QANG(TXANG)
	INFONTC = FONTID
	INPRECC = FPREC
 
!	Select Transform
	IF(ITRAN .GT. TRSBPL) THEN
	    JTRAN = TRSBPL
	    CALL GSELNT(TRSBPL)	! Select subplot area transform
	ELSE IF(ITRAN .LT. TRPAGE) THEN
	    JTRAN = TRPAGE
	    CALL GSELNT(TRPAGE)
	ELSE
	    JTRAN = ITRAN
	END IF
 
!	Turn off clipping.
	CALL GSCLIP(GNCLIP)
 
!	Set text font, precision, and height to the values in COMMON
D	WRITE(8,*) ' ------------- CHRMSG ----------------------'
	HITE0 = HITE
D	WRITE(8,*) 'SETTING FONTID,FPREC:',FONTID,FPREC
	CALL GSTXFP(FONTID,FPREC)
D	WRITE(8,*) 'MESSAG SETTING HITE TO COMMON VALUE,',HITE0
	CALL GSCHH(HITE0)
        CALL GUWK(1,GPERFO)
	LFONT = FONTID
 
	TMESS(1:)=CMESS(1:)	! Save input string
	LOWER_CASE = .FALSE.
	IMESS = LEN(CMESS)	! Start with length = total length
D	WRITE(8,*) 'CHRMSG INPUT = <',CMESS(1:IMESS),'>'
 
!	Map characters according to KBMAP
!	Characters in CIN(1:NMAP) are replaced with COUT(1:NMAP)
	I = 1
	DO WHILE ( I .LE. NMAP)
	    IF(COUT(I:I) .EQ. CIN(I:I) ) STOP 'INVALID KBMAP'
	    IMAP = INDEX(TMESS,CIN(I:I) )
	    DO WHILE(IMAP .NE. 0)
D	WRITE(8,*) 'IMAP,I,CIN=',IMAP,I,' ',CIN(I:I)
D	WRITE(8,*) ' ',TMESS(IMAP:IMAP),' --> ',COUT(I:I)
		TMESS(IMAP:IMAP) = COUT(I:I)
		IMAP = INDEX(TMESS,CIN(I:I))
	    END DO
	    I = I + 1
D	WRITE(8,*) 'MAPPED TMESS = <',TMESS(1:IMESS),'>'
	END DO
 
D	WRITE(8,*) ' Initial XABUT,YABUT=',XABUT,YABUT
	XT=XPOSM	! MOVE XPOSM TO INTERNAL VARIABLE
	YT=YPOSM	! MOVE YPOSM TO INTERNAL VARIABLE
 
	IF(XT .EQ. 'ABUT') THEN
	    XT = XABUT	! USE ENDING X-POS OF PREVIOUS WRITE
	END IF
	IF(YT .EQ. 'ABUT') THEN
	    YT = YABUT
	END IF
D	WRITE(8,*) ' Initial XT,YT=',XT,YT
!	Get current text alignment
	CALL GQTXAL(IERR,HALIGN,VALIGN)
 
!	Analyze the string for font changes, instructions, etc.
	I1 = 1	! Initialize I1 for the following loop
 
200	I2 = IMESS + 1	! Start of loop
	IX = 0
	IF(NALF .GT. 1) THEN
	  DO I=1,NALF	! Find ALF switch characters
	    ISW = INDEX(TMESS(I1:),ALFSW(I:I)) + I1 - 1
!	ISW is the position of the Ith switch character
	    IF(ISW .LT. I1) THEN
		ISW = IMESS + 1	! If not found, set to end
	    ELSE
		I2 = MIN(I2,ISW )	! I2 is position of 1st switch character
		IF(I2 .EQ. ISW) IX = I	! IX is font # index.
	    END IF
	  END DO
	END IF
 
	IF(TMESS(I2:I2) .EQ. TMESS(I2+1:I2+1) .AND. I2 .LT. IMESS ) THEN
	  I2 = I2 + 1
	END IF
 
D	WRITE(8,*) 'SUBSTRING=<',TMESS(I1:I2-1),'>'
 
	IF(I1 .EQ. 1 .AND. I2 .LT. IMESS) THEN
	  IF(HALIGN .EQ. GACENT ) THEN
	    JMESS = IMESS	! Don't count switch characters in length
C	    DO J=1,IMESS
C	      DO I = 1,NALF
C		IF(INDEX(TMESS(J:J),ALFSW(I:I)) .GT. 0) JMESS = JMESS - 1
C	      END DO
C	    END DO
	    READ(TMESS(1:JMESS),201) (BMESS(I),I=1,JMESS)
201	FORMAT(200A1)
D	WRITE(8,*) '->XMESS:',(CHAR(BMESS(I)),I=1,JMESS)
D	WRITE(8,*) 'BEFORE XMESS, XT,YT,XABUT,YABUT=',XT,YT,XABUT,YABUT
	    CALL QANG(TXANG)
C	    DTL = 0.5*XMESS(BMESS,JMESS)
	    DTL = 0.5*XMESS(TMESS,JMESS)
	    DXT = 0.5*DTL*COSD(TXANG)
	    DYT = 0.5*DTL*SIND(TXANG)
D	WRITE(8,*) 'AFTER XMESS, XT,YT,XABUT,YABUT=',XT,YT,XABUT,YABUT
D	WRITE(8,*) 'XMESS->DXT,DYT=',DXT,DYT
	    XT = XT - DXT
	    YT = YT - DYT
	    CALL GSTXAL(GAHNOR,VALIGN)	! Change to left aligned text
	  END IF
	END IF
 
	IF(I2 .GT. I1 .AND. LFONT .NE. 999) THEN ! write substring
	  IF(LOWER_CASE)THEN
	    DO I=I1,I2-1
	      BCHAR = ICHAR(TMESS(I:I))
	      IF(BCHAR .GE. 65 .AND. BCHAR .LE. 90) BCHAR = BCHAR + 32
	      TMESS(I:I) = CHAR(BCHAR)
	    END DO
	  END IF
!	  Check for supplemental characters
	  ITX1 = I1
	  ITX = I2-1
	  XS = XT
	  YS = YT
	  I = I1
20	  DO WHILE (I .LE. I2-1 .AND. ICHAR(TMESS(I:I)) .LT. 127)
	    I = I + 1
	  END DO
	  IF(I .LE. I2-1 .AND. FONTID .NE. 1) THEN
	    ITX = I - 1
D	    WRITE(8,*) '1 GTX:',XS,YS,', <',TMESS(ITX1:ITX),'>'
	    CALL GQCHH(IERR,CHITE)
D	    WRITE(8,*) 'GKS INQUIRY GIVES CHITE =',CHITE
	    CALL GTX(XS,YS,( TMESS(ITX1:ITX) ) )
!	    Find position for next character
	    CALL TXEND(XS,YS,TMESS(ITX1:ITX),XS,YS )
D	    WRITE(8,*) 'Supplemental character at',I,' is:',TMESS(I:I)
!	    Print Supplemental character
C	    CALL GSTXFP(1,2)	! Set to default font to print DEC suppl.
	    FONTID = -1
	    FPREC = 2
D	    CALL GQCHH(IERR,HX)
D	    WRITE(8,*) 'GKS INQUIRY BEFORE GSTXFP GIVES CHITE =',HX
	    CALL GSTXFP(FONTID,FPREC)
D	    CALL GQCHH(IERR,HX)
D	    WRITE(8,*) 'GKS INQUIRY BEFORE QANG GIVES CHITE =',HX
	    CALL QANG(TXANG)
C	    IF(TXANG .EQ. 0.0 .OR. TXANG .EQ. 90.0) THEN	!X TGW 1/11/91
C		IF(TXANG .EQ. 0.0) XS = XS + 0.5*CHITE		!X TGW 1/11/91
C		IF(TXANG .EQ. 90.0) YS = YS + 0.5*CHITE		!X TGW 1/11/91
C		CALL GSCHSP(0.4)  !Spread out spacing for emphasis
C	    END IF						!X TGW 1/11/91
	    I = ITX + 1
D	    WRITE(8,*) '2 GTX:',XS,YS,', <',TMESS(I:I),'>'
	    CALL GTX(XS,YS,TMESS(I:I) )
D	    CALL GQCHH(IERR,HX)
D	    WRITE(8,*) 'GKS INQUIRY AFTER GTX GIVES CHITE =',HX
	    CALL GSCHSP(0.0)
!	    Find position for next character
	    CALL TXEND(XS,YS,TMESS(I:I),XS,YS )
D	WRITE(8,*) 'TXEND-->XS,YS=',XS,YS
	    I = I + 1
!	    Reset text font and precision to initial values in COMMON
	    FONTID = INFONTC
	    FPREC = INPRECC
	    CALL GSTXFP(FONTID,FPREC)
	    ITX = I2 - 1
	    ITX1 = I
	    IF(I .LE. I2-1) THEN	! get next piece of substring
	      GOTO 20
	    ELSE	! Save ending position of substring
	      XT = XS
	      YT = YS
	    END IF
	  ELSE
	    ITX = I2 - 1
D	    WRITE(8,*) '3 GTX:',XS,YS,', <',TMESS(ITX1:ITX),'>'
D	    CALL GQCHH(IERR,CHITE)
D	    WRITE(8,*) 'GKS INQUIRY GIVES CHITE =',CHITE
	    CALL GTX(XS,YS,( TMESS(ITX1:ITX) ) )
	    CALL TXEND(XS,YS,TMESS(ITX1:ITX),XT,YT )
	  END IF
C	  CALL TXEND(XT,YT,TMESS(I1:I2-1),XT,YT)
	ELSE IF(LFONT .EQ. 999) THEN	! Analyze instruction string.
D	WRITE(8,*) '-->ANLZIN TMESS=<',TMESS(I1:I2-1),'>'
D	WRITE(8,*) '   XT,YT,HITE0,TXANG=',XT,YT,HITE0,TXANG
	  CALL ANLZIN( TMESS(I1:I2-1),XT,YT,HITE0,TXANG )
D	WRITE(8,*) 'ANLZIN-->XT,YT,HITE0,TXANG=',XT,YT,HITE0,TXANG
	END IF
 
	IF(I2 .GE. IMESS) THEN	! Message output is finished
	  IF(LFONT .EQ. 999) LFONT = -1
!	Save ending text position
	  XABUT = XT
	  YABUT = YT
!	Update Workstations before leaving CHRMSG
	CALL GQACWK(1,IERR,NACTV,LWKACT)	! Find number of active WS
 
	DO I=1,NACTV
	    CALL GQWKC(I,IERR,iconid,iwkst)	! Find WS type
	    CALL GQWKCA(IWKST,IERR,ICAT)	! Find WS Category
	    IF(ICAT .EQ. GOUTPT .OR. ICAT .EQ. GOUTIN) THEN
       	      CALL GUWK(I,GPERFO)
	    END IF
	END DO
 
!	Reset GKS state before exiting
	  IF(ITRAN .NE. JTRAN) CALL GSELNT(ITRAN)
	  CALL GSCLIP(CFLAG)
	  CALL GSTXAL(HALIN,VALIN)
	  CALL QWORK(NACT,WKID,WKTYPE,WKCAT)
D	WRITE(8,*) '2 CALLING GSCHH, HITE TO',SHITE
	  CALL GSCHH(SHITE)
	  CALL GSCHSP(SPACIN)
	  CALL GSTXFP(FONTIN,PRECIN)
	  RETURN
	END IF
 
	IF(TMESS(I2:I2) .EQ. TMESS(I2-1:I2-1) ) THEN
D	  WRITE(8,*) 'REPEAT CHARACTER=<',TMESS(I2-2:I2-1),'>'
	ELSE
	  LFONT = IALF(IX)
	  LOWER_CASE = LCASE(IX)
	END IF
 
	IF(LFONT .EQ. 999) THEN		! DO NOTHING (INSTRUCTION STRING)
	ELSE IF(LFONT .NE. 0) THEN	! CHANGE FONT TEMPORARILY
	  CALL GSTXFP(LFONT,FPREC)
	ELSE
	  WRITE(8,*) 'IX,LFONT',IX,LFONT
	  WRITE(8,*) 'I1,I2,IMESS',I1,I2,IMESS
	  WRITE(8,*) 'TMESS(1:)<',TMESS(1:),'>'
	  STOP 'ILLEGAL FONT'
	END IF
 
	I1 = I2 + 1
	IF(I1 .LE. IMESS) GOTO 200	
 
	IF(ITRAN .NE. JTRAN) CALL GSELNT(ITRAN)
	XABUT = XT
	YABUT = YT
!	Update Workstations before leaving CHRMSG
	CALL GQACWK(1,IERR,NACTV,LWKACT)	! Find number of active WS
 
	DO I=1,NACTV
	  CALL GQWKC(I,IERR,ICONID,IWKST)	! Find WS type
	  CALL GQWKCA(IWKST,IERR,ICAT)		! Find WS Category
	  IF(ICAT .EQ. GOUTPT .OR. ICAT .EQ. GOUTIN) THEN
       	    CALL GUWK(I,GPERFO)
	  END IF
	END DO
 
!	Reset GKS state before exiting
	IF(ITRAN .NE. JTRAN) CALL GSELNT(ITRAN)
	CALL GSCLIP(CFLAG)
	CALL GSTXAL(HALIN,VALIN)
	CALL QWORK(NACT,WKID,WKTYPE,WKCAT)
D	WRITE(8,*) 'MESSAG RESETTING GSCHH, SHITE=',SHITE
	CALL GSCHH(SHITE)
	CALL GSCHSP(SPACIN)
	CALL GSTXFP(FONTIN,PRECIN)
	RETURN
! -------------- END OF CHRMSG -------------------

	ENTRY QABUT(XOUT,YOUT)
	XOUT = XABUT
	YOUT = YABUT
	RETURN
 
	ENTRY KBMAP(BCHIN,BCHOUT)
	NMAP = NMAP + 1
	CIN(NMAP:NMAP) = CHAR(BCHIN)
	CTEMP(1:1) = CHAR(BCHOUT)
	IOUT = ICHAR(CTEMP)
	IF( IOUT .EQ. 140) THEN
	    IOUT = 197	! Angstrom
	ELSE
D	    WRITE(8,*) 'Unknown IOUT=',BCHOUT,CTEMP,IOUT
	END IF
	COUT(NMAP:NMAP) = CHAR(IOUT)
D	WRITE(8,*) 'KBMAP CHIN,CHOUT=<',CIN(1:NMAP)
D	1,'>--><',COUT(1:NMAP),'>'
	RETURN
	END
 
	SUBROUTINE TXEND(XS,YS,TEXT,XE,YE)
	INCLUDE 'SYS$LIBRARY:GKSDEFS.BND'
	REAL*4 XS,YS,XE,YE,ERX(4),ERY(4)
	CHARACTER*(*) TEXT
	INTEGER*4 NACT,WKID,WKTYPE,WKCAT
 
	NCH = LEN(TEXT)
!	Get category and type of active workstation
	CALL QWORK(NACT,WKID,WKTYPE,WKCAT)
	CALL QANG(TXANG)	! Find text angle
	IF(WKCAT .EQ. GOUTPT .OR. WKCAT .EQ. GOUTIN) THEN
!	Inquire text extent
	    CALL GQTXX(WKID,XS,YS,TEXT(1:NCH),IERR,XABUT,YABUT,ERX,ERY)
	    IF(IERR .NE. 0) WRITE(6,*) 'GQTXX ERROR STATUS',IERR
	ELSE	! For metafile, just calculate length
	    WRITE(6,*) WKID,', TYPE ',WKTYPE,' IS CATEGORY ',WKCAT
	    WRITE(6,*) 'TXEND CANNOT CALL GQTXX'
	END IF
 
	CALL GQTXAL(IERR,ILIGNH,ILIGNV)
	IF(ILIGNH .EQ. GACENT) THEN
	  IF(TXANG .EQ. 0.0) THEN	! XABUT IS WRONG
	    XE = ERX(2) + 0.2*TXHITE
	    YE = YS
	  ELSE IF (TXANG .EQ. 90.0) THEN	! YABUT IS WRONG
	    XE = XS
	    YE = ERY(2) + 0.2*TXHITE
	  ELSE	! Use corner of extent rectangle
	    XE = XABUT
	    YE = YABUT
	  END IF
	ELSE
	  XE = XABUT
	  YE = YABUT
	END IF
 
	RETURN
	END