SUBROUTINE GRSHAD(IBUF,SHADE,IGR) C C C J. LISCOUSKI DIGITAL EQUIPMENT CORPORATION C NOV. 9, 1979 C C GRSHAD permits the user to set the shade line, or change it for C any of the graph modes. It must be used if shading in C point plot mode is desired. C C SHADE IS THE POINT ON THE VERTICAL AXIS (EXPRESSED IN USER VALUES) C AT WHICH SHADING IS TO BE DONE. THE DEFAULT IS THE BOTTOM C OF THE GRAPH. C C IGR IS THE GRAPH NUMBER (0/1) FOR PLOTTING, THE DEFAULT IS 0. C C NOTE: ALL ARGUMENTS ARE NEEDED, EITHER BY DEFAULT OR BY USER C DEFINITION. IF ANY ARE MISSING, A TRAP TO 4 MAY RESULT. C DIMENSION IBUF(1),TEMP(4),ITEMP(8),IRB(2,3),IB(2) BYTE CMD(11) EQUIVALENCE (TEMP(1),ITEMP(1)) !THIS IS TO PROVIDE A QUICK MEANS EQUIVALENCE (TEMP(1),XMIN) !OF GETTING SCALED VALUES FROM EQUIVALENCE (TEMP(2),XMAX) !FROM IBUF INTO THE APPROPRIATE EQUIVALENCE (TEMP(3),YMIN) !REAL VARIABLES EQUIVALENCE (TEMP(4),YMAX) DATA IRB/239,150,129,50,239,50/ !REGION BOUNDS DATA CMD/"33,'1','A',0,0,'@',0,0,"33,'2',0/ DATA IB/10,18/ F(Z,ZMAX,ZMIN)=(Z-ZMIN)/(ZMAX-ZMIN) !ARITH. STAT. SUBROUTINE C C BEGINNING OF EXECUTABLE CODE C CALL IDFLT(IGRAPH,0,IGR) !CHECK FOR DEFAULT ON GRAPH # IF((IGRAPH.EQ.0).OR.(IGRAPH.EQ.1))GOTO 1 !IGRAPH OK? CALL ERRMSG('?GRSHAD - invalid graph number, must be 0/1') CALL EXIT RETURN 1 IF(IBUF(27).EQ."52525)GOTO 4 !GRINIT CALLED? CALL ERRMSG('?GRSHAD - GRINIT not called') CALL EXIT RETURN 4 IRGN=IBUF(8+IGRAPH) IF(IRGN.NE.-1)GOTO 3 !FIND WHICH REGION IS BEING PLOTTED CALL ERRMSG('?GRSHAD - graph not assigned to region') CALL EXIT RETURN 3 CALL IDFLT(IMODE,0,MODE) !CHECK DEFAULT ON MODE C C GET SCALING VALUES FOR X AND Y AXIS C IBASE=IB(IGRAPH+1) 10 IF(IBUF(2+IGRAPH).NE.0)GOTO 12 !HAVE SCALED VALUES BEEN ENTERED? CALL ERRMSG('?GRSHAD - scaling has not been provided for graph') CALL EXIT RETURN 12 DO 15 I=1,8 15 ITEMP(I)=IBUF(IBASE+I) !GET SCALED VALUES FROM IBUF 30 CALL DFLTCK(SHADEL,YMIN,SHADE) !CKECK FOR DEFAULT ON SHADE LINE I=2 IF(IGRAPH.EQ.1)I=4 !SHADE APPROPRIATE GRAPH IBUF(5)=((IBUF(5).OR.I).OR.IGRAPH) !SET BITS FOR SHADING Y1=F(SHADEL,YMAX,YMIN)*FLOAT(IRB(1,IRGN)-IRB(2,IRGN)) IY=Y1+IRB(2,IRGN) C C CHECK FOR SHADELINE OUT OF RANGE OF REGION BOUNDS, IF OUT OF C RANGE SET IT TO THE LIMITS OF THE REGION C IF(IY.GT.IRB(1,IRGN))IY=IRB(1,IRGN) IF(IY.LT.IRB(2,IRGN))IY=IRB(2,IRGN) C CMD(7)=32+(IY.AND."37) CMD(8)=32+((IY.AND."340)/32) CMD(4)=IBUF(4) !LOAD REGISTER INFORMATION CMD(5)=IBUF(5) CALL OUTSTR(CMD) !SEND SHADING INFORMATION RETURN END