FTN,L 
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:   DRAW INCREMENTAL 
C      SOURCE: 92840 - 18040
C      RELOC:  92840 - 16001
C 
C 
C 
CC*********************************************************** 
C 
      SUBROUTINE XDRWI(IN,IGCB,X,Y), 92840-16001 REV.1819 780515
      INTEGER DRPPN,READ,WRITE,PLTIN,GRIFX
      INTEGER PLTAB 
      DIMENSION ICODE(4),VAR(14),IBUFR(8),CLPTS(4)
      EQUIVALENCE (A,VAR),(B,VAR(2)),(C,VAR(3)),(D,VAR(4))
      EQUIVALENCE (V5,VAR(5)),(IBUFR,LFTPN),(IBUFR(2),PLTAB)
      EQUIVALENCE (IBUFR(5),DRPPN),(IBUFR(6),PLTIN),(IBUFR(7),IB7)
      EQUIVALENCE (IBUFR(8),IB8)
      EQUIVALENCE (ICODE(2),ICD2),(ICODE(3),ICD3),(ICODE(4),ICD4) 
      EQUIVALENCE (IBUFR(3),IB3),(IBUFR(4),IB4) 
      EQUIVALENCE (VAR(9),THETX),(VAR(10),THETY)
      EQUIVALENCE (VAR(11),XOLD ),(VAR(12),YOLD ) 
      EQUIVALENCE (VAR(13),XNEW), (VAR(14),YNEW)
      EQUIVALENCE (CLPTS(3),CLP3),(CLPTS(4),CLP4) 
      EQUIVALENCE (CLPTS,CLP1),(CLPTS(2),CLP2)
C 
C 
C 
C     THIS IS THE CORE MODULE FOR INCREMENTAL DRAW
C 
      DATA READ/1/
      DATA WRITE/2/ 
      DATA LFTPN/20400B/
      DATA PLTAB/21402B/
      DATA DRPPN/21000B/
      DATA PLTIN/21402B/
C 
      DATA ICD3,ICD4/19,18/ 
      IFLG = 0
      ISTAT = 0 
CCCC
C     THIS CALL ESTABLISHES AN ADDRESS LINK BETWEEN THE GRAPGHICS 
C  PACKAGE AND THE CURRENT GCB AND ALSO CHECKS FOR A SUSPENDED GCB. 
C 
      ISUSP= 0
      CALL GCBIM(99,1,IGCB,ISUSP) 
      IF(ISUSP.NE.0)RETURN
C 
C     INITIALIZE CODES FOR GCBIM
C 
C     WHERE 11 = TRANSFORMATION CONSTANTS 
C           9 = MAPPING ENDPOINTS V1,V2 
C           18 = PREVIOUS X,Y 
C           19 = COS(THETA),SIN(THETA)
C 
      ICODE = IADCD(D)
      ICD2 = IS1V1(D) 
C 
C     LOOK AT STATUS WORD TO DETERMINE UNITS (UDU OR GDU), AND
C  EXAMINE SAME WORD TO ASCERTAIN WHETHER OR NOT CLIPPING IS ON.
C 
      CALL GCBIM(ICODE,4,VAR, 0,READ) 
C 
C 
C 
C     COMPUTE NEW POINTS BY FIRST DOING TRANSLATION AND 
C  SCALING, AND SECOND PERFORMING THE ROTATION. 
C  THE ROTATION PROCESS INVOLVES ROTATING A VECTOR ABOUT
C  THE SAME ORIGIN AS THE ORIGINAL AXES, (ANGLES ARE COUNTER- 
C  CLOCKWISE).  THE CONSTANTS COS(THETA) AND SIN(THETA) RESIDE
C  IN THE GCB AND ARE DETERMINED FROM PDIR(THETA).
C     THE OTHER THING THAT HAS TO BE DONE HERE IS TO COMPUTE
C  THE NEW ENDPOINTS AND CLIP(IF SOFT CLIPPING IS ON).
C 
C 
      CALL GRSTS(1,10000B,ISUSP)
      XNEW = 0. 
      YNEW = 0. 
      IF(X.EQ.0.)GO TO 72 
      XNEW   =(A* X)
72    IF(Y.EQ.0. )GO TO 75
      YNEW = C * Y
75    XN = (XNEW * THETX) - (YNEW * THETY)
      YN = (XNEW * THETY) + (YNEW * THETX)
C 
      IF(ISUSP.NE.0)GO TO 77
      XN = XN + B 
      YN = YN + D 
77    XNEW = XN + XOLD
      YNEW = YN + YOLD
C 
C     CHECK TO SEE IF UNITS = GDUS
C 
C 
C     NOW DO DE CLIPPING. 
C 
20    CALL  CLPNG(XOLD, CLPTS,V5,IFLG)
C 
C     DEBUGGING 
C 
C     WRITE(6,5500)XOLD,YOLD,XNEW,YNEW,CLP1,CLP2,CLP3,CLP4
C500  FORMAT("DRAWI ",2X,8(X,F5.2)) 
C     WRITE(6,7500)X,Y
C500  FORMAT(2X,"POINTS X,Y ",2(X,F7.2))
C 
C     WRITE(6,8500)IFLG 
C500  FORMAT(2X,"IFLG =",K6)
C 
22    IF(IFLG)600,25,600
C 
C     NOW DROP-PEN AND MAKE A MARK
C 
25    IB3 = GRIFX(CLP1) 
      IB4 = GRIFX(CLP2) 
      IB7 = GRIFX(CLP3) 
      IB8 = GRIFX(CLP4) 
      IF(CLP1.EQ.XOLD.AND.CLP2.EQ.YOLD)GO TO 35 
      CALL OUTPT(4,IBUFR,2) 
      GO TO 600 
35    CALL OUTPT(2,DRPPN,2) 
C 
C     SET STATUS WORD TO INDICATE PEN DOWN AND SET NEW POINTS 
C  INTO GCB.
600   CALL GRSTS(2,67577B,10200B) 
      CALL GCBIM(18,1,XNEW  ,4,WRITE) 
      IF(IFLG.EQ.1)CALL PLTER(20,11)
C 
C     CHECK FOR PREVIOUS CALL TO PORG (BIT 8=1) 
C     IF NOT NEW POINTS BECOME ORIGIN FOR A RELATIVE CALL.
C 
      CALL GRSTS(1,400B,ISTAT)
      IF(ISTAT.NE.0)RETURN
C 
C     PORG(X,Y) 
C 
      XNEW = X
      YNEW = Y
      CALL GCBIM(17,  1,XNEW,0,2) 
      RETURN
      END 
      END$