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$