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: MOVE INCREMENTAL C SOURCE: 92840 - 18039 C RELOC: 92840 - 16001 C C C CC*********************************************************** C SUBROUTINE XMOVI(IN,IGCB,X,Y), 92840-16001 REV.1819 780515 INTEGER READ,WRITE,PLTIN,GRIFX DIMENSION ICODE(4),VAR(14),IBUFR(4),CLPTS(4) EQUIVALENCE (A,VAR),(B,VAR(2)),(C,VAR(3)),(D,VAR(4)) EQUIVALENCE (V5,VAR(5)),(IBUFR,LFTPN),(IBUFR(2),PLTIN) EQUIVALENCE (ICODE(2),ICD2),(ICODE(3),ICD3),(ICODE(4),ICD4) EQUIVALENCE (IBUFR(3),IB3),(IBUFR(4),IB4) EQUIVALENCE (VAR(11),XOLD),(VAR(12),YOLD) EQUIVALENCE (VAR(13),XNEW),(VAR(14),YNEW) EQUIVALENCE (VAR( 9),THETX),(VAR(10),THETY) EQUIVALENCE (CLPTS(3),CLP3),(CLPTS(4),CLP4) C C C C THIS IS THE CORE MODULE FOR INCREMENTAL MOVE C DATA READ/1/ DATA WRITE/2/ DATA LFTPN/20400B/ DATA PLTIN/21402B/ C DATA ICD3,ICD4/19,18/ IFLG = 0 IST1 = 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) IF(ISUSP.NE.0)GO TO 77 XN = XN + B YN = YN + D 77 XNEW = XN + XOLD YNEW = YN + YOLD C C C C NOW DO DE CLIPPING. C 20 CALL CLPNG(XOLD, CLPTS,V5,IFLG) C C DEBUGGING C CD WRITE(6,5500)XOLD,YOLD,XNEW,YNEW,CLP1,CLP2 CD00 FORMAT("MOVEI ",2X,8(X,F5.2)) CD WRITE(6,7500)X,Y CD00 FORMAT(2X," POINTS X,Y",2X,2(X,F5.2)) C 22 IF(IFLG)600,25,600 C C NOW DROP-PEN AND MAKE A MARK C 25 IB3 = GRIFX(CLP3) IB4 = GRIFX(CLP4) CALL OUTPT(2,IBUFR,2) C C SET STATUS WORD TO INDICATE PEN UP AND SET NEW POINTS C INTO GCB. 600 CALL GRSTS(2,67577B,10000B) 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$