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 ABSOLUTE C SOURCE: 92840 - 18025 C RELOC: 92840 - 16001 C C C CC*********************************************************** C SUBROUTINE XMOVE(IN,IGCB,X,Y), 92840-16001 REV.1819 780515 INTEGER PLTAB,GRIFX DIMENSION CLPTS(4) DIMENSION IBUFR(4),VAR(12),ICODE(3) EQUIVALENCE (VAR,A),(VAR(2),B),(VAR(3),C),(VAR(4),D) EQUIVALENCE (IBUFR,LFTPN),(VAR(5),V5),(VAR(9),XOLD) EQUIVALENCE (VAR(11),XNEW),(VAR(12),YNEW) EQUIVALENCE (IBUFR(2),PLTAB),(IBUFR(3),IB3),(IBUFR(4),IB4) EQUIVALENCE (CLP3,CLPTS(3)),(CLP4,CLPTS(4)) EQUIVALENCE (ICODE(2),ICD2),(ICODE(3),ICD3) C DATA LFTPN/20400B/ DATA PLTAB/21402B/ C C THIS IS THE MODULE FOR PROCESSING ABSOLUTE MOVES. C ISTAT = 0 IFLG = 0 IST1 = 0 ICD3 = 18 C 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 ICODE = IADCD(D) ICD2 = IS1V1(D) CALL GCBIM(ICODE,3,VAR,0,1) C C COMPUTE NEW POINTS. C XNEW = (A * X) + B YNEW = (C * Y) + D C C CALL CLPNG(XOLD,CLPTS,V5,IFLG) IF(IFLG.NE.0)GO TO 20 10 IB3 = GRIFX(CLP3) IB4 = GRIFX(CLP4) CALL OUTPT(2,IBUFR,2) C C PUT NEW POINTS INTO GCB AND SET STATUS WORD = PENUP. C 20 CALL GCBIM(18,1,XNEW,4,2) CALL GRSTS(2,67577B,10000B) C C SET SOFT ERROR IF POINT OUTSIDE CLIPPING BOUNDARY C 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$