SUBROUTINE GRFRAM(IBUF,IGRAPH,MODE) C C C J. LISCOUSKI DIGITAL EQUIPMENT CORPORATION C NOV. 9, 1979 C C GRFRAM FUNCTION IN LIFE IS TO CONSTRUCT THE FRAME USED IN A GRAPH. C IT WILL CONSTRUCT THE FOLLOWING ITEMS: C C 1) HORIZONTAL LINES AT THE TOP AND BOTTOM OF THE GRAPH C 2) THE VERTICAL BARS AT THE SIDES OF THE GRAPH C 3) PLACE THE DOT FOR A GRAPH ON A LINE COINCIDENT WITH C THE BOTTOM VERTICAL LINE C 4) LABEL THE GRAPH ON THE HORIZONTAL AND VERTICAL AXIS C C ARGUMENTS: C IBUF IS THE FORTRAN INFORMATION BUFFER C IGRAPH IS THE GRAPH NUMBER (0/1) C MODE IS THE MODE VALUE PASSED TO THE CALLING ROUTINE C DIMENSION IBUF(1),LINE(2,3),LINEL(2,3),ICOL(4),LBLY(3,3),LINEY(3) DIMENSION IB(2) DIMENSION TEMP(4),ITEMP(8) !THESE WILL BE USED IN SCALING EQUIVALENCE (TEMP(1),ITEMP(1)) !THE AXIS BYTE LINES(4),LINEE(4),MARKER(2) BYTE CMD(11),ENTRGR(3),EXITGR(3) DATA ENTRGR/"33,'1',0/ !ENTER GRAPHICS MODE DATA EXITGR/"33,'2',0/ !YOU GUESSED IT, EXIT GRAPHICS MODE DATA LINE/150,239,50,129,50,239/ !HORIZONTAL LINE POSITIONS DATA LINES/"33,'(','0',0/ !SPECIAL GRAPHICS MODE DATA LINEE/"33,'(','B',0/ !ASCII STANDARD MODE DATA LINEL/1,9,12,19,1,19/ !STARTING POS. AND # OF LINES DATA ICOL/9,25,41,57/ !COLUMN POSITIONS FOR LABELING X-AXIS DATA LBLY/9,5,1,19,15,12,19,10,1/ !ROW POS. FOR Y-AXIS DATA LINEY/194,89,144/ !MORE HORIZONTAL LINE POSITIONS DATA MARKER/'C','K'/ !GRAPH MARKER IDENTIFICATIONS DATA IB/10,18/ C IF((IGRAPH.EQ.0).OR.(IGRAPH.EQ.1))GOTO 1 !VALID GRAPH #? CALL ERRMSG('?GRFRAM - invalid graph #, must be 0 or 1') CALL EXIT RETURN C 1 IRGN=IBUF(8+IGRAPH) IF(IRGN.NE.-1)GOTO 10 !WHERE IS THE GRAPH REGION? CALL ERRMSG('?GRFRAM - graph region not assigned') CALL EXIT RETURN C C CHECK TO SEE IF HORIZONTAL LINES HAVE BEEN ENABLED C 10 IF((IRGN.EQ.1).OR.(IRGN.EQ.2))IBUF(28)=0 !SHOW PARTIAL DISPLAY IF(IRGN.EQ.3)IBUF(28)=1 !SHOW FULL REGION CALL OUTSTR(ENTRGR) !ENTER GRAPHICS MODE IF((IBUF(4).AND.1).NE.0)GOTO 12 !IF GRAPHICS HAVEN'T BEEN ENABLED IBUF(4)=IBUF(4)+1 !ENABLE THEM CMD(1)='A' CMD(2)=IBUF(4) CMD(3)=IBUF(5) CALL OUTSTR(CMD,3) 12 IF((IBUF(6).AND.1).NE.0)GOTO 15 !IF HOR. LINE HAVEN'T BEEN ENABLED IBUF(6)=IBUF(6)+1 !ENABLE THEM CMD(1)='I' CMD(2)=IBUF(6) CMD(3)=IBUF(7) CALL OUTSTR(CMD,3) 15 CMD(1)='D' !SET UP FOR HORIZONTAL LINES DO 20 I=1,2 J=LINE(I,IRGN) !THIS LOOP IS USED TO PUT UP THE LINES CMD(2)=32+(J.AND."37) CMD(3)=48+((J.AND."340)/32) CALL OUTSTR(CMD,3) 20 CONTINUE CALL OUTSTR(EXITGR) C C PUT UP VERTICAL BARS C CALL OUTSTR(LINES) !INTO SPECIAL GRAPHICS MODE DO 30 I=LINEL(1,IRGN),LINEL(2,IRGN) I4=I !NEEDED TO AVOID A COMPILER WARNING CALL VTHTXT(0,I4,8,'x') !ON OUTPUT THE x WILL BECOME A VERTICAL 30 CALL VTHTXT(0,I4,74,'x')!BAR SINCE ITS OCTAL CODE IS "170 CALL OUTSTR(LINEE) !BACK TO ASCII MODE C C NEXT, LABEL THE AXIS BEGINNING WITH THE HORIZONTAL AXIS C IF((MODE.AND.64).EQ.0)GOTO 52 C C IF STRIPCHART MODE IS GOING TO BE USED, DON'T LABEL THE C THE X-AXIS C IF((MODE.AND.16).NE.0)GOTO 45 !IF STRIPCHRT, GOTO Y-AXIS IBASE=IB(IGRAPH+1) !GET READ TO COPY COORDINATES DO 35 I=1,8 35 ITEMP(I)=IBUF(IBASE+I) !COPY VALUES FROM IBUF TO TEMP (yes, TEMP) C ILINE=20 !LINE VALUES ARE TO BE PRINTED ON IF(IRGN.EQ.1)ILINE=10 !RESET FOR UPPER REGION XINC=(TEMP(2)-TEMP(1))/4. DO 40 I=1,4 X=TEMP(1)+XINC*FLOAT(I-1) ENCODE(10,37,CMD)X 37 FORMAT(1PE10.3) CMD(11)=0 CALL VTHTXT(0,ILINE,ICOL(I),CMD) 40 CONTINUE C C NOW LABEL THE Y AXIS C 45 YINC=(TEMP(4)-TEMP(3))/2. DO 50 I=1,3 Y=TEMP(3)+YINC*FLOAT(I-1) ENCODE(10,37,CMD)Y CALL VTMCUR(LBLY(I,IRGN),1) CALL OUTSTR(CMD,6) !MANTISSA CALL VTMCUR(LBLY(I,IRGN)+1,3) CALL OUTSTR(CMD(7),4) !EXPONENT 50 CONTINUE C C MOVING ALONG, WE NOW GET TO THE HORIZONTAL LINES IN THE C MIDDLE OF THE SCREEN..... C 52 IF((MODE.AND.2).EQ.0)GOTO 54 CALL OUTSTR(ENTRGR) !BACK INTO GRAPHICS MODE CMD(1)='D' !SPECIFY HORIZONTAL LINE CMD(2)=32+(LINEY(IRGN).AND."37) CMD(3)=48+((LINEY(IRGN).AND."340)/32) CALL OUTSTR(CMD,3) !PUT UP LINE CALL OUTSTR(EXITGR) !EXIT GRAPHICS C C GRAPH MARKERS ARE NEXT........ C 54 IF((MODE.AND.128).EQ.0)RETURN I4=4 !SET UP BIT PATTERN FOR ENABLING MARKERS IF(IGRAPH.EQ.1)I4=8 !RESET IF GRAPH IS 1 IBUF(6)=IBUF(6).OR.I4 !ENABLE MARKERS CMD(1)='I' CMD(2)=IBUF(6) CMD(3)=IBUF(7) CALL OUTSTR(ENTRGR) !ENTER GRAPHICS CALL OUTSTR(CMD,3) !SEND NEW REGISTER 1 CONFIGURATION CMD(1)=MARKER(IGRAPH+1) !SET MARKER TYPE DO 60 I=1,4 J=(I-1)*128 !MARKER POSITION CMD(2)=32+(J.AND."37) CMD(3)=48+((J.AND."740)/32) CALL OUTSTR(CMD,3) !SEND STRING 60 CONTINUE CALL OUTSTR(EXITGR) !EXIT GRAPHICS RETURN END