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: GCHR1
C      SOURCE: 92840 - 18149
C      RELOC:  92840 - 16021
C 
C 
C 
CC*********************************************************** 
      SUBROUTINE GCHR1(IGCB,LUG,IBUFR,IBUFS,INDEX,XMTRX,
     +CPX,CPY,DONE) 
     +,92840-16021 REV.2013 791210
C************************************************************** 
C GCHR1 DRAWS ONE CHARACTER ONTO LUG ACCORDING TO THE CHARACTER 
C STROKES STORED IN BUFFER IBUFR STARTING AT WORD INDEX.
C 
C IBUFR = BUFFER THAT HOLDS THE STROKES TO BE MADE. 
C INDEX= FIRST WORD IN IBUFR TO START DRAWING THE STROKES AT. 
C IBUFS= TOTAL WORD-LENGTH OF IBUFR.
C 
C XMTRX= TRANSFORMATION XMTRX FOR THIS CHARACTER TO DO SLANTS,
C         CHANGE ASPECT RATIO, ETC. 
C 
C CPX AND CPY = THE CURRENT POINTER IN WC USED TO ORIENT THIS CHAR. 
C 
C DONE  = LOGICAL FLAG SET TO TRUE WHEN THE LAST STROKE OF A CHARACTER
C         HAS BEEN DRAWN (ALLOWS STROKES FOR A CHARACTER TO CROSS OVER
C         MULTIPLE BUFFERS.)
C***************************************************************
C 
      INTEGER IGCB(1),LUG,IBUFR(1),IBUFS,INDEX
      REAL XMTRX(2,2),CPX,CPY 
      LOGICAL DONE
C***************************************************************
C CHECK THAT THE INDEX IS VALID.
C 
C************************************************************ 
C DRAW THE CHARACTER STROKES. 
C IF IX=64, ITS A CONTROL PAIR WHERE IY DETERMINES THE TYPE OF CONTROL. 
C OTHERWISE, ITS AN X-Y PAIR TO WHICH TO MOVE.
C 
C THE FORMAT FOR AN X-Y PAIR FOLLOWS: (BIT 15 = SIGN(X), BIT 6=SIGN(Y)
C ------------------------------------------------- 
C 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 
C +-     X  X  X  X  X  X    +-  Y  Y  Y  Y  Y  Y 
C-------------------------------------------------- 
      DO 20 J=INDEX,IBUFS,1 
      IX=IBUFR(J)/256 
      IY=IAND(IBUFR(J),177B)
      IF (IY .GE. 64) IY=64-IY
C 
D     WRITE(13,1374) J,IX,IY
D1374 FORMAT("GCHR1: J,IX,IY = ",3I6) 
C 
      IF (IX .EQ. 64) GO TO 10
      IF ((IABS(IX) .GT. 63) .OR. 
     +    (IABS(IY) .GT. 63)) GO TO 9200
      X=FLOAT(IX) 
      Y=FLOAT(IY) 
C 
C****************************************************************** 
C TRANSFORM THE X-Y PAIR BY XMTRX, ADD IN THE CURRENT POINTER.
C 
      X1=XMTRX(1,1)*X+XMTRX(1,2)*Y+CPX
      Y1=XMTRX(2,1)*X+XMTRX(2,2)*Y+CPY
C 
D     WRITE(13,3456) X1,Y1
D3456 FORMAT("GCHR1: X1 AND Y1 = ",2F13.6,//) 
C 
      CALL PLOT(IGCB,X1,Y1,IPEN)
      GO TO 20
C*****************************************************************
C HAVE A CONTROL PAIR. Y HAS THE FOLLOWING MEANINGS:
C    IY  < 0 IMPLIES HAVE A BAD X-Y PAIR OFF THE DISC.
C        = 0 IMPLIES LIFT THE PEN.
C        = 1 IMPLIES LOWER THE PEN. 
C        = 2 IMPLIES DONE WITH THIS CHARACTER.
C        > 2 IMPLIES BAD X-Y PAIR OFF THE DISC. 
C 
10    IF (IY) 9200,100,15 
15    GO TO (200,300,9200) IY 
C***************************************************************
C IY=0 SIGNIFIES LIFT PEN.
C 
100   IPEN=-2 
      GO TO 20
C***************************************************************
C IY=1 SIGNIFIES LOWER PEN. 
C 
200   IPEN=-1 
      GO TO 20
C***************************************************************
C IY=2 SIGNIFIES DONE.
C 
300   CONTINUE
      DONE=.TRUE. 
      RETURN
C************************************************************** 
C END OF PROCESSING CURRENT X-Y PAIR. CONTINUE THE DO LOOP. 
C 
20    CONTINUE
C********************************************************** 
C PROCESSED ALL THE STROKES IN THE CURRENT BUFFER. SET THE
C DONE FLAG TO FALSE AND RETURN.
C 
      DONE=.FALSE.
      RETURN
C*************************************************************
C ERROR PROCESSING. 
C 
C************************************************************** 
C ERROR ON READF CALL.
C 
9100  CALL PLTER(IERR-300,IDUMMY) 
      RETURN
C************************************************************ 
C FAULTY X-Y PAIR FROM THE DISC.
C 
9200  CALL PLTER(38,IDUMMY) 
      RETURN
      END 
                                                                                                                                                                      