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: ABSOLUTE DRAW
C      SOURCE: 92840 - 18024
C      RELOC:  92840 - 16001
C 
C 
C 
CC*********************************************************** 
C 
      SUBROUTINE XDRAW(IN,IGCB,X,Y), 92840-16001 REV.1819 780515
      INTEGER GICB,DRPPN,READ,WRITE,PLTAB,GRIFX 
      DIMENSION ICODE(3),VAR(12),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 (ICODE(2),ICD2),(ICODE(3),ICD3) 
      EQUIVALENCE (IBUFR(3),IB3),(IBUFR(4),IB4) 
      EQUIVALENCE (IBUFR(5),DRPPN),(IBUFR(6),IB6) 
      EQUIVALENCE (IBUFR(7),IB7),(IBUFR(8),IB8) 
      EQUIVALENCE (VAR(9),XOLD),(VAR(10),YOLD)
      EQUIVALENCE (VAR(11),XNEW),(VAR(12),YNEW) 
      EQUIVALENCE (CLPTS(3),CLP3),(CLPTS(4),CLP4) 
      EQUIVALENCE (CLPTS,CLP1),(CLPTS(2),CLP2)
C 
C 
C 
C     THIS IS THE CORE MODULE FOR ABSOLUTE DRAWS
C 
      DATA READ/1/
      DATA WRITE/2/ 
      DATA LFTPN/20400B/
      DATA GICB/16/ 
      DATA DRPPN/21000B/
      DATA PLTAB/21402B/
C 
      IFLG = 0
      ISTAT = 0 
      IB6 = PLTAB 
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 
      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 
      ICD3 = 18 
      CALL GCBIM(ICODE,3,VAR, 0,READ) 
C 
C 
C 
C     COMPUTE NEW POINTS AND CLIP AWAY THE FAT
C 
      XNEW   =(A* X + B)
      YNEW = C * Y + D
C 
C     WRITE(6,3000)X,Y
C000  FORMAT(2X,2(X,F10.3)) 
C 
C 
C     NOW DO DE CLIPPING. 
C 
20    CALL  CLPNG(XOLD, CLPTS,V5,IFLG)
C     WRITE(6,5500)XOLD,YOLD,XNEW,YNEW,CLP1,CLP2,CLP3,CLP4
C     WRITE(6,1000)IFLG 
C000  FORMAT(2X,"IFLG = ",I4) 
C500  FORMAT("DRAW",2X,8(X,F5.2)) 
22    IF(IFLG)600,100,600 
C 
C     NOW DROP-PEN AND MAKE A MARK
C 
100   IB3 = GRIFX(CLP1) 
      IB4 = GRIFX(CLP2) 
      IB7 = GRIFX(CLP3) 
      IB8 = GRIFX(CLP4) 
      IF(CLP1.EQ.XOLD.AND.CLP2.EQ.YOLD)GO TO 56 
      CALL OUTPT(4,IBUFR,2) 
      GO TO 600 
56    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,8) 
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$
                                                                                                                                                                                              