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: SETAR C SOURCE: 92840 - 18004 C RELOC: 92840 - 16001 C C MODIFIED BY DJS 1/16/80 C CC*********************************************************** C SUBROUTINE XETAR(IND,IGCB,ASPCT), 92840-16001 REV.2013 800116 C INTEGER GRIFX DS2013 DIMENSION VAR(10),ICODE(3) DIMENSION IBUFR(5) EQUIVALENCE (VAR,DXGDU),(VAR(2),DYGDU),(AP,VAR(3)) EQUIVALENCE (BP,VAR(4)),(CP,VAR(5)),(DP,VAR(6)) EQUIVALENCE (G1X,VAR(7)),(G1Y,VAR(8)),(G2X,VAR(9)) EQUIVALENCE (G2Y,VAR(10)) C DATA EPSLN/.0001/ DS2013 C DATA IGTCH/4404B/ DS2013 DATA IHCLP/32001B/ C C THIS ROUTINE IS USED TO DETERMINE THE ASPECT RATIO OR C MORE SUCCINCTLY ADJUST THE GDU SPACE. C DATA ICODE/15B,11,8/ C AR = ASPCT 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 C SET UP DEFAULT IF NECESSARY C IF(ASPCT.GT.0.) GO TO 50 EM1901 AR=1 EM1901 CALL PLTER(23) EM1901 C C GET GDUS AND A' - D' C 50 CALL GCBIM(ICODE,3,VAR,0,1) EM1901 C CALL OUTPT(1,IGTCH,1) DS2013 C CALL GCBIM(16,1,IBUFR,4,1) DS2013 C C C C COMPUTE PRESENT ASPECT RATIO C 5 ARP = DXGDU/DYGDU C C SEE IF ASPECT RATIOS ARE EQUAL C C XTEST = ABS(AR - ARP) DS2013 C IF(XTEST.LE.EPSLN)RETURN DS2013 C C IS AR LONGER THAN IT IS HIGH OR VICE VERSA C IF(AR.LT.1.)GO TO 100 C C LONGER THAN HIGH AR > 1 C IF(ARP.GT.1.0.AND.AR.LT.ARP)GO TO 200 C C ADJUST GY C GO TO 300 C C HIGHER THAT IT IS WIDE C 100 IF(AR.GT.ARP.AND.ARP.LT.1.0)GO TO 300 C C ADJUST GX C 200 TMPAR = (( DXGDU - (DYGDU*AR))/2.) * AP G1X = G1X + TMPAR G2X = G2X - TMPAR C GO TO 400 C 300 TMPAR = (( DYGDU - ( DXGDU/AR))/2.) * CP G1Y = G1Y + TMPAR G2Y = G2Y - TMPAR 400 CALL GCBIM(8,1,G1X,0,2) EM1901 C C CALL GPON(IGCB,3) C DETERMINE HARD CLIPPING CAPABILITY OF DEVICE C CALL OUTPT(1,IHCLP,1) CALL GCBIM(16,1,IBUFR,1,1) IF(IBUFR.EQ.0)CALL GRSTS(2,77767B,10B) C C RETURN END END$