FTN4,L
C 
C 
C 
C 
C 
C 
CC************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
CC************************************************************
C 
C 
C 
C      NAME: GTEX1
C      SOURCE: 92840 - 18143
C      RELOC:  92840 - 16021
C 
C 
C 
CC*********************************************************** 
      SUBROUTINE GTEX1(IGCB,ITEXT,ISTRT,ITEXL,IDCB,IBUFR) 
     +,92840-16021 REV.2013 791129
C**************************************************************** 
C GTEX1 WRITES CHARACTERS FROM ITEXT TO THE 
C GRAPHICS LU USING SOFTWARE GENERATED TEXT. IT OUTPUTS THE 
C CHARACTERS ACCORDING TO THE TRANSFORMATION IN XMTRX.
C THE ONLY CONTROL CHARACTERS RECOGNIZED ARE CR AND CR-LF.
C ALL ILLEGAL CHARACTERS ARE PRINTED AS @.
C 
C IGCB = GCB TO THE GRAPHICS DEVICE.
C ITEXT= BUFFER CONTAINING THE CHARS TO BE OUTPUT.
C ISTRT= INDEX TO FIRST CHARACTER IN ITEXT TO BE OUTPUT.
C ITEXL= + NUMBER OF CHARACTERS TO BE OUTPUT. 
C IDCB = A DCB OPEN TO THE FONT FILE. 
C IBUFR = A 128-WORD UTILITY BUFFER THAT GTEX1 CAN USE. 
C 
C XMTRX= THE TRANSFORMATION MATRIX USED TO TRANSFORM EACH CHARACTER 
C        FROM THE FONT FILE.
C 
C X1 AND Y1 = THE START COORDINATES OF THE CURRENT LINE.
C               HELD CONSTANT EXCEPT FOR CR AND CR-LF.
C 
C INFO  = LOCAL 8-WORD ARRAY HOLDING INFORMATION ABOUT THE CHARACTERS 
C         IN THE FONT FILE. 
C 
C LEN  = + CHARACTER COUNT OF NUMBER OF CHARACTERS IN ITEXT.
C ISTRC= LOCAL VARIABLE THAT EQUALS ISTRT.
C ITEXL2= LOCAL VARIABLE THAT EQUALS ITEXL (OR ITEXL-1 IF THERE'S 
C         A CR-LF SUPPRESSION.) 
C IEND = INDEX OF THE LAST CHARACTER OF THE STRING OF INTEREST. 
C 
C NOCARR= TRUE IF THE USER REQUESTED A CR-LF SUPPRESSION. 
C DONE = TRUE WHEN YOU'RE DONE WITH ONE CHARACTER.
C 
C X1 AND Y1 = CURRENT POSITION UPON ENTRY. THIS POSITION IS USED TO 
C             ORIENT THE STRING FOR LORG PURPOSES. (X1,Y1)
C             IS UPDATED ONLY TO IMPLEMENT A CR-LF. 
C**************************************************************** 
      INTEGER IGCB(1),ITEXT(1),ITEXL,IDCB(1),IBUFR(1) 
      INTEGER IBUFS,INFO(9) 
      REAL XMTRX(2,2) 
      LOGICAL DONE,NOCARR 
      LOGICAL GWC 
      DATA IBUFS/128/ 
C************************************************************** 
C CHECK FOR ERROR CONDITIONS. 
C 
C 
      IF ((ITEXL .LE. 0) .OR. (ISTRT .LE. 0)) GO TO 8500
      ISTRC=ISTRT 
C************************************************************** 
C GET THE GRAPHICS LU OUT OF THE IGCB.
C 
      CALL GCBIM(2,1,LUG,0,1) 
C***********************************************************
C GET THE IMPORTANT INFO ABOUT THE CHARACTERS FROM THE FONT FILE
C HEADER RECORD.
C 
      CALL READF(IDCB,IERR,INFO,9,LENGTH,1) 
      IF (IERR .LT. 0) GO TO 9000 
C*****************************************************************
C CHECK FOR CR-LF SUPPRESSION.
C 
      CALL SGET(ITEXT,ISTRC+ITEXL-1,ICHAR)
      NOCARR=.FALSE.
      IF (ICHAR .EQ. 137B) NOCARR = .TRUE.
      ITEXL2=ITEXL
      IF (NOCARR) ITEXL2=ITEXL-1
C***************************************************************
C CHECK AND SAVE WHETHER YOU'RE IN WC SPACE OR NDC SPACE. THEN
C ENABLE THE PROPER SPACE FOR ALL THE REST OF THE CALCULATIONS. 
C 
      CALL GSTAT(IGCB,11,1,ICU) 
D     WRITE(1,55) ICU 
D55   FORMAT(/"GTEX1: ICU = 1 FOR WC ENABLED : ",I2)
      IF (GWC(IGCB)) GO TO 100
C*************************************************************
C SET UP EVERYTHING FOR NDC CHARACTER PLOTTING. 
C 
      IUNIT=0 
      CALL SETGU(IGCB)
      GO TO 1000
C*********************************************************
C SET UP EVERYTHING FOR WC PLOTTING 
C 
100   IUNIT=1 
      CALL SETUU(IGCB)
      GO TO 1000
C***************************************************************
C SAVE THE CP TO USE LATER FOR PLACEMENT PURPOSES.
C 
1000  CALL WHERE(IGCB,X1,Y1)
C************************************************************** 
C GET THE LENGTH OF THE LINE. GET THE LORG VALUE. 
C THEN ADJUST THE CP FOR THE PROPER LORG PLACEMENT. 
C IDCB(17) IS SET TO 100000B TO TELL GLEN1 NOT TO PRINT OUT A GPS 13
C ERROR.
C 
      IDCB(17)=100000B
      CALL GLEN1(IGCB,ITEXT,ISTRC,ITEXL2,DELTX,DELTY,IDCB,IDCB(17)) 
      CALL GCBIM(21,1,LORG,0,1) 
      CALL GPLC1(IGCB,ITEXT,X1,Y1,DELTX,DELTY,LORG) 
C*************************************************************
C OUTPUT THE CHARACTERS ONE AT A TIME. ICHAR HOLDS THE JTH CHAR.
C 
      IEND=ISTRT+ITEXL2-1 
      DO 10 J=ISTRC,IEND
      CALL SGET(ITEXT,J,ICHAR)
C***********************************************************
C GET THE CP (NDC COORDS) ABOUT WHICH TO ORIENT THIS CHARACTER. 
C GET A NEW XMTRX TO USE TO TRANSFORM THE CHARACTERS FROM THE 
C CHARACTER COORDINATE SPACE INTO THE NDC SPACE.
C GET THE STROKES FOR THE CHARACTER INTO IBUFR. THEN OUTPUT 
C THE STROKES. YOU MAY HAVE TO GET SEVERAL BUNCHES OF STROKES 
C TO FINISH ONE CHARACTER.
C 
8     CALL WHERE(IGCB,CPX,CPY)
      CALL GCALC(IGCB,XMTRX,INFO,IBUFR,IUNIT) 
C 
      DO 15 IREPET=1,INFO(2)/128
      CALL GGET(ICHAR,IREPET,INFO,IDCB,IBUFR,IBUFS,INDEX) 
      CALL GCHR1(IGCB,LUG,IBUFR,IBUFS,INDEX,XMTRX,CPX,CPY,DONE) 
      IF (DONE) GO TO 30
15    CONTINUE
C*********************************************************
C DONE WITH THIS CHARACTER. CAN ADD CODE HERE TO PAD A
C BLANK CHARACTER IF YOU WANT TO JUSTIFY THE STRING.
C 
30    CONTINUE
10    CONTINUE
C*************************************************************
C FINISHED WITH THE WHOLE STRING. REENABLE THE PROPER UNITS 
C AND MOVE THE CP TO THE PROPER SPOT. 
C 
      CALL GPLC2(IGCB,INFO,XMTRX,X1,Y1,DELTX,DELTY,LORG,NOCARR,IBUFR) 
      IF (ICU .EQ. 1) CALL SETUU(IGCB)
      RETURN
C*************************************************************
C ITEXL OR ISTRC .LE. 0 
C 
8500  CONTINUE
      CALL PLTER(9,IDUMY) 
      RETURN
C*************************************************************
C SOME SORT OF FMP ERROR OCCURRED.
C 
9000  CONTINUE
      CALL PLTER(IERR-300,IDUMY)
      RETURN
      END 
                                                                                          