FTN4,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:  LOCATE,VIEWPORT,CLIP
C      SOURCE: 92840 - 18015
C      RELOC:  92840 - 16001
C 
C      MODIFIED BY: DJS 1/16/80  >> STOP GPS 15 REPORT FOR CLIP 
C 
CC*********************************************************** 
C 
      SUBROUTINE SCLNG(IND, IGCB,P1,P2,P3,
     1P4), 92840-16001 REV.2013 800116
      DIMENSION VAR(8),ICODE(3),VAR1(4),IBUFR(5)
      DIMENSION IER1(2),IER2(2),IER3(2) 
      INTEGER GICB
      INTEGER STATS,READ,WRITE,DIGTZ
      EQUIVALENCE (VAR,V1X,XMM),(VAR(2),YMM,V1Y)
      EQUIVALENCE (VAR(3),V2X),(VAR(4),V2Y) 
      EQUIVALENCE (VAR(5),S1X),(VAR(6),S1Y) 
      EQUIVALENCE (VAR(7),S2X),(VAR(8),S2Y) 
      EQUIVALENCE (VAR1,A,AP)      ,(VAR1(2),B,BP,G1X)
      EQUIVALENCE (VAR1(3),C,CP,G1Y),(VAR1(4),D,DP,G2X) 
      EQUIVALENCE (IBUFR(2),IB2),(IBUFR(4),IB4) 
      EQUIVALENCE(IBUFR(3),IB3) 
      EQUIVALENCE (IBUFR(5),IB5)
C 
C     THIS IS THE AGL MODULE FOR THE SCALING COMMANDS:
C  LOCATE AND CLIP. 
C 
C     THE VARIABLES IN THE EQUIVALENCE STATEMENTS HAVE THE FOLLOWING
C  MEANINGS:
C     G1 - G2 (X,Y) = HARD CLIP LIMITS
C     V1 - V2   "   = MAPPING ENDPOINTS 
C     S1 - S2   "   = SOFT CLIP LIMITS
C     A - D    = TRANSFORMATION CONSTANTS 
C 
      DATA STATS/5/ 
      DATA READ/1/
      DATA WRITE/2/ 
      DATA IV12/9/
      DATA IG12/8/
      DATA IS12/10/ 
      DATA IADP/11/ 
      DATA IAD/12/
      DATA DIGTZ/6003B/ 
      DATA GICB/16/ 
      DATA IER1/11,17/
      DATA IER2/12,19/
      DATA IER3/14,18/
      IBUFR = 26404B
      IFLG = 0
C 
      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     CALL GRSTS(1,2,ISTAT)                                             DS2013
C     IF(ISTAT.NE.0)CALL PLTER(15)                                      DS2013
      INDX = IND
C 
C     SELECT COMMAND PROCESSOR
C 
      IF(IND.GT.2)GO TO 70
C 
C     LOCATE - FIRST CHECK TO SEE IF P1=P2 OR P3=P4 
C 
10    IF(P1.EQ.P2.OR.P3.EQ.P4)GO TO 800 
C 
C     SEE IF S1 OR V1 IS LOWER LEFT AND S2 OR V2 IS UPPER RIGHT 
C 
C 
C 
C 
C     GET AP TO DP OR G1-G2 AND CHRH,CHRW 
C 
      GO TO(20,50),IND
20    CALL GCBIM(IADP,1,VAR1,0,READ)
      CALL GRSTS(1,2,ISTAT)                                             DS2013
      IF (ISTAT .NE. 0) CALL PLTER(15)                                  DS2013
C     GO TO (100,50),IND                                                DS2013
C 
C     COMPUTE V1,V2 AND S1,S2 
C 
100   V1X = AP * P1 + BP
      V1Y = CP * P3 + DP
      V2X = AP * P2 + BP
      V2Y = CP *P4 + DP 
110   S1X = AMIN1(V1X,V2X)
      S2X = AMAX1(V1X,V2X)
      S1Y = AMIN1(V1Y,V2Y)
      S2Y = AMAX1(V1Y,V2Y)
C 
      IF(V1X.GT.V2X.OR.V1Y.GT.V2Y)CALL PLTER(IER1(INDX))
C 
C     CLIP MAPPING ENDPOINTS TO THE HARD CLIP LIMITS H1,H2
C 
      ICODE = 8 
115   CALL GCBIM(ICODE,1,A,0,READ)
      IFLG = -1 
      CALL CLPNG(S1X,V1X,A,IFLG)
      IF(IFLG.EQ.1)GO TO 810
      IF(S1X.LT.A.OR.S1X.GT.C)S1X = A 
      IF(S1Y.LT.B.OR.S1Y.GT.D)S1Y = B 
      IF(S2X.GT.C.OR.S2X.LT.A)S2X = C 
      IF(S2Y.GT.D.OR.S2Y.LT.B)S2Y = D 
      CALL GCBIM(IS12,1,S1X,0,WRITE)
C 
C     SEE IF THIS IS A CLIP OR VIEWP CALL 
C 
      GO TO(117,55,117,55),IND
117   CALL GCBIM(IV12,1,S1X,0,WRITE)
      CALL GRSTS(2,67773B,4)
      V1X = 0.
      V1Y = 0.
      CALL GCBIM(18,1,V1X,0,2)
      RETURN
C 
C     CLIP
C 
50    ISTAT = IADCD(D)
      CALL GCBIM(ISTAT,1,VAR1,0,READ) 
      GO TO 100 
C 
55    CALL GRSTS(2,77773B,4)
      RETURN
C 
C 
C     INTERACTIVE CALLS TO        CLIP OR LOCATE. 
C 
70    INDX = IND - 2
      CALL OUTPT(1,DIGTZ,1) 
      CALL GCBIM(GICB,1,IB2,2,1)
      CALL OUTPT(1,DIGTZ,1) 
      CALL GCBIM(GICB,1,IB4,2,1)
      V1X = IB2 
      V2X = IB4 
      V1Y = IB3 
      V2Y = IB5 
      IF(IB2.EQ.IB4.OR.IB3.EQ.IB5)GO TO 800 
      GO TO 110 
C 
C     ERRORS
C 
800   CALL PLTER(IER2(INDX))
      RETURN
810   CALL PLTER(IER3(INDX))
      RETURN
C 
      END 
      END$
          