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: MSCALE C SOURCE: 92840 - 18011 C RELOC: 92840 - 16001 C C MODIFIED BY: DJS 1/16/80 >> GET RID OF GPS 15 ERROR C CC*********************************************************** C SUBROUTINE XSCAL(IN,IGCB,P1,P2), 92840-16001 REV.2013 800116 DIMENSION VAR(8),ICODE(3) EQUIVALENCE (VAR,DXGDU),(VAR(2),DYGDU),(VAR(3),G1X) EQUIVALENCE (VAR(4),G1Y),(VAR(5),G2X),(VAR(6),G2Y) EQUIVALENCE (VAR(7),XMM),(VAR(8),YMM) EQUIVALENCE (ICODE,IGDU),(ICODE(2),IG12) EQUIVALENCE(ICODE(3),MMU) C C THIS IS THE FUNCTIONAL MODULE FOR THE AGL COMMAND MSCALE C WHICH DEFINES USER UNITS IN TERMS OF MILLIMETERS. C DATA IGDU/15B/ DATA IG12/8/ DATA MMU/6/ 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 CALL GCBIM(ICODE,3,VAR,0,1) C DS2013 C FAKE OUT VIEWP SO THAT A GPS 15 ERROR WON'T BE REPORTED DS2013 C DS2013 C DS2013 CALL GRSTS(2,77775B,0) DS2013 C C REDEFINE VIEWPORT SET HARD CLIP LIMITS = SOFT CLIP LIMITS C CALL VIEWP( IGCB,0.,DXGDU,0.,DYGDU) C C COMPUTE PARAMETERS FOR SCALE C XUU = (G2X - G1X)/XMM - P1 YUU = (G2Y - G1Y)/YMM - P2 XU1 = -P1 YU1 = -P2 CALL WINDW( IGCB,XU1,XUU,YU1,YUU) RETURN END END$