SUBROUTINE FRAME( XMINF, XMAXF, YMINF, YMAXF ) COMMON /PAGSIZ/ XBOND, YBOND COMMON /HFRAME/ IXMINF, IXMAXF, IYMINF, IYMAXF COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR C XN = AMAX1 ( 0., XMINF ) XX = AMIN1 ( XBOND, XMAXF ) YN = AMAX1 ( 0., YMINF ) YX = AMIN1 ( YBOND, YMAXF ) IXMINF = SCRX * XN IXMAXF = SCRX * XX IYMINF = SCRY * YN IYMAXF = SCRY * YX C IDX = IXMINF - IXORIG IDY = IYMINF - IYORIG IXORIG = IXMINF IYORIG = IYMINF C C MOVE WINDOW INTO FRAME C IASCR = IASCR + IDX IBSCR = IBSCR + IDX ICSCR = ICSCR + IDY IDSCR = IDSCR + IDY XCONST = XCONST + IDX YCONST = YCONST + IDY C RETURN END SUBROUTINE WINDOW( XWIN0, XWIN1, YWIN0, YWIN1 ) COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW C IASCR = SCRX * XWIN0 + IXORIG IBSCR = SCRX * XWIN1 + IXORIG ICSCR = SCRY * YWIN0 + IYORIG IDSCR = SCRY * YWIN1 + IYORIG C CALL SCALE( XMINW, XMAXW, YMINW, YMAXW ) C RETURN END SUBROUTINE VUPORT( XMIN, XMAX, YMIN, YMAX ) C CALL SCALE(XMIN, XMAX, YMIN, YMAX) C RETURN END SUBROUTINE SCALE( XMIN, XMAX, YMIN, YMAX ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW C XMINW = XMIN XMAXW = XMAX YMINW = YMIN YMAXW = YMAX C XSLOPE = (IBSCR - IASCR) / (XMAX - XMIN) YSLOPE = (IDSCR - ICSCR) / (YMAX - YMIN) XCONST = - XSLOPE * XMIN + FLOAT(IASCR) YCONST = - YSLOPE * YMIN + FLOAT(ICSCR) C RETURN END SUBROUTINE AXIS( XTIC, YTIC, IXTIT, IXLEN, IXSIZ, IXFMT, 1 IYTIT, IYLEN, IYSIZ, IYFMT ) BYTE IXTIT(IXLEN), IYTIT(IYLEN) COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW C CALL DRWREC( XMINW, XMAXW, YMINW, YMAXW, 0 ) CALL XAXIS( XTIC, IXTIT, IXLEN, IXSIZ, IXFMT ) CALL YAXIS( YTIC, IYTIT, IYLEN, IYSIZ, IYFMT ) C RETURN END SUBROUTINE YAXIS( YTIC, IYTIT, IYLEN, IYSIZ, IYFMT ) BYTE IYTIT(IYLEN) INTEGER FORM(3) COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW COMMON /CHRSIZ/ ICHW(5), ICHH(5) COMMON /YLABEL/ IXMIN C WHEN ( IYSIZ .GE. 1 .AND. IYSIZ .LE. 5 ) IYS = IYSIZ ELSE IYS = 0 IXMIN = IASCR IF ( YTIC .NE. 0. ) IX = IASCR IS = ICSCR LENTIC = SCRY / 4 IFORM = IFRMT( FORM, IYFMT ) YVAL = YMINW IHGT = ICHH(MAX0(IYS,1)) / 2 IY = IS - IHGT IW = ICHW(MAX0(IYS,1)) YMAX = AMAX1( YMINW, YMAXW ) YMIN = AMIN1( YMINW, YMAXW ) WHILE ( YVAL .LE. YMAX .AND. YVAL .GE. YMIN ) WHEN ( YVAL .EQ. YMINW ) CALL LABELY( YVAL, FORM, IFORM, IASCR, IY, IW, IYS ) FIN ELSE IS = ISCRY( YVAL ) IY = IS - IHGT IF( IDSCR .NE. IS ) CALL DRYTIC( IASCR, IS, LENTIC ) CALL LABELY( YVAL, FORM, IFORM, IASCR, IY, IW, IYS ) FIN YVAL = YVAL + YTIC FIN FIN C C CENTER VERTICAL TITLE AND PLOT C IF ( IYS .NE. 0 ) CALL TRIMSP( IYTIT, IYLEN, IST, IEND ) IYLN = IEND + 1 - IST IX = IXMIN - ICHH(IYS) IYL = IYLN * ICHW(IYS) IY = (ICSCR + IDSCR - IYL) / 2 CALL PLTSTR(IX, IY, IYTIT(IST), IYLN, 4, IYS) FIN C RETURN END SUBROUTINE LABELX( XVAL, FORM, IFORM, IS, IY, ICHW, IXSIZ ) BYTE LABEL(9) INTEGER FORM(3) C IF ( IXSIZ .NE. 0 ) ENCODE ( 9 , FORM, LABEL ) XVAL CALL TRIML(LABEL, 9, LEN) IF ( IFORM .EQ. 0 ) LEN = LEN - 1 IXL = LEN * ICHW IX = IS - IXL / 2 CALL PLTSTR(IX, IY, LABEL , LEN , 1 , IXSIZ) FIN C RETURN END SUBROUTINE LABELY( YVAL, FORM, IFORM, IS, IY, ICHW, IYSIZ ) BYTE LABEL(9) INTEGER FORM(3) COMMON /YLABEL/ IXMIN C IF ( IYSIZ .NE. 0 ) ENCODE ( 9 , FORM, LABEL ) YVAL CALL TRIML ( LABEL, 9, LEN ) IF ( IFORM .EQ. 0 ) LEN = LEN - 1 IX = IS - ( LEN + 1 ) * ICHW IXMIN = MIN0( IXMIN, IX ) CALL PLTSTR(IX, IY, LABEL , LEN , 1 , IYSIZ) FIN C RETURN END SUBROUTINE DRXTIC( IX, IY, LENTIC ) C CALL PLOT(IX, IY, 0) CALL PLOT(IX, IY + LENTIC, 1) C RETURN END SUBROUTINE DRYTIC( IX, IY, LENTIC ) C CALL PLOT(IX, IY, 0) CALL PLOT(IX + LENTIC, IY, 1) C RETURN END FUNCTION IFRMT( FORM, IFMT ) INTEGER FMT(2) , EMT, NUM(5), FORM(3) DATA FMT / '(F', '9.' / DATA EMT / '(G' / DATA NUM / '0)', '1)', '2)', '3)', '2)' / C IFORM = MAX0( 0, IFMT ) FORM(1) = FMT(1) FORM(2) = FMT(2) FORM(3) = NUM( MIN0( 5 , IFORM + 1) ) IF ( IFORM .GT. 3 ) FORM(1) = EMT IFRMT = IFORM C RETURN END SUBROUTINE LINE( X, Y, N, ICOL, ISYM, ISIZE, INUM ) DIMENSION X(N), Y(N) C CALL DASHLN(X, Y, N, ICOL, ISYM, ISIZE, INUM, 0 ) C RETURN END SUBROUTINE DASHLN( X, Y, N, ICOL, ISYM, ISIZE, INUM, LINTYP ) LOGICAL DRAW_MARK, DRAW_LINE, INSIDE, START_NEW DIMENSION X(N), Y(N) COMMON /CHKBON/ INSIDE, START_NEW, LINNTP, LIN1, DASH C DRAW_MARK = ISIZE .GE. 1 .AND. ISIZE .LE. 5 DRAW_MARK = DRAW_MARK .AND. ISYM .GE. 0 .AND. ISYM .LE. 5 DRAW_MARK = DRAW_MARK .AND. INUM .NE. 0 DRAW_LINE = INUM .GE. 0 C IF ( DRAW_LINE ) START_NEW = .TRUE. CALL COLTYP(ICOL) CALL MOVETO(X(1), Y(1), 0, LINTYP) DO ( I = 2, N ) CALL MOVETO(X(I), Y(I), 1, LINTYP) FIN C IF ( DRAW_MARK ) START_NEW = .TRUE. ITEMP = IABS(INUM) CALL COLTYP(ICOL) DO ( I = 1, N, ITEMP ) CALL MOVETO(X(I), Y(I), 0, LINTYP) IF ( INSIDE ) CALL MARKER(ISYM, ISIZE) FIN FIN C RETURN END SUBROUTINE MOVETO( XWRLD, YWRLD, IUD, LINTYP ) LOGICAL CURRENT_INSIDE, INX, INY, PREVIOUS_INSIDE, START_NEW COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHKBON/ PREVIOUS_INSIDE, START_NEW, LINNTP, LIN1, DASH C WHEN ( START_NEW .OR. LINNTP .NE. LINTYP ) CALL MOV1ST(XWRLD, YWRLD, IUD, LINTYP) START_NEW = .FALSE. FIN ELSE IXC = ISCRX( XWRLD ) IYC = ISCRY( YWRLD ) IX = IXC IY = IYC INX = IX .GE. IASCR .AND. IX .LE. IBSCR INY = IY .GE. ICSCR .AND. IY .LE. IDSCR CURRENT_INSIDE = INX .AND. INY WHEN ( CURRENT_INSIDE .OR. PREVIOUS_INSIDE ) IF ( .NOT. ( CURRENT_INSIDE .AND. PREVIOUS_INSIDE ) ) IX0 = IXCUR IY0 = IYCUR WHEN ( PREVIOUS_INSIDE ) PREVIOUS_INSIDE = .FALSE. CALL FNDINT( IX0, IY0, IX, IY ) FIN ELSE PREVIOUS_INSIDE = .TRUE. CALL FNDINT( IX, IY, IX0, IY0 ) IXCUR = IX0 IYCUR = IY0 CALL DRDASH(IX0, IY0, 0) FIN FIN CALL DRDASH(IX, IY, IUD) FIN ELSE CALL ALLOUT( IX, IY, IUD ) FIN IXCUR = IXC IYCUR = IYC FIN C RETURN END SUBROUTINE ALLOUT( IX, IY, IUD ) INTEGER ISCX(2), ISCY(2), IX1(2), IY1(2) LOGICAL INSIDE, START_NEW COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHKBON/ INSIDE, START_NEW, LINNTP, LIN1, DASH EQUIVALENCE ( ISCX(1), IASCR ), ( ISCX(2), IBSCR ) EQUIVALENCE ( ISCY(1), ICSCR ), ( ISCY(2), IDSCR ) C INSECT = 0 IF ( IX .NE. IXCUR ) IXMAX = MAX0( IX, IXCUR ) IXMIN = MIN0( IX, IXCUR ) DO ( IS = 1, 2 ) IF( ISCX(IS) .GE. IXMIN .AND. ISCX(IS) .LE. IXMAX ) XSL = ( IY - IYCUR ) / FLOAT( IX - IXCUR ) IY0 = XSL * ( ISCX(IS) - IX ) + IY IF ( IY0 .GE. ICSCR .AND. IY0 .LE. IDSCR ) INSECT = INSECT + 1 IX1(INSECT) = ISCX(IS) IY1(INSECT) = IY0 FIN FIN FIN FIN IF ( IY .NE. IYCUR .AND. INSECT .LT. 2 ) IYMAX = MAX0( IY, IYCUR ) IYMIN = MIN0( IY, IYCUR ) DO ( IS = 1, 2 ) IF( ISCY(IS) .GE. IYMIN .AND. ISCY(IS) .LE. IYMAX ) YSL = ( IX - IXCUR ) / FLOAT( IY - IYCUR ) IX0 = YSL * ( ISCY(IS) - IY ) + IX IF ( IX0 .GE. IASCR .AND. IX0 .LE. IBSCR ) INSECT = INSECT + 1 IX1(INSECT) = IX0 IY1(INSECT) = ISCY(IS) IF( INSECT.EQ.2.AND.IX1(1).EQ.IX1(2) ) INSECT=1 FIN FIN FIN FIN IF ( INSECT .EQ. 2 ) IXCUR = IX1(1) IYCUR = IY1(1) CALL DRDASH ( IX1(1), IY1(1), 0 ) CALL DRDASH ( IX1(2), IY1(2), IUD ) FIN INSIDE = .FALSE. C RETURN END SUBROUTINE FNDINT( IX0, IY0, IX, IY ) LOGICAL INX, INY COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR C INX = IX .GE. IASCR .AND. IX .LE. IBSCR INY = IY .GE. ICSCR .AND. IY .LE. IDSCR IF ( .NOT. INX ) XSL = (IY - IY0) / FLOAT(IX - IX0) WHEN ( IX .GT. IBSCR ) IX = IBSCR ELSE IX = IASCR IY = XSL * (IX - IX0) + IY0 INY = IY .GE. ICSCR .AND. IY .LE. IDSCR FIN IF ( .NOT. INY ) YSL = (IX - IX0) / FLOAT(IY - IY0) WHEN( IY .GT. IDSCR ) IY = IDSCR ELSE IY = ICSCR IX = YSL * (IY - IY0) + IX0 FIN C RETURN END SUBROUTINE MOV1ST( XWRLD, YWRLD, IUD, LINTYP ) LOGICAL INSIDE, INX, INY, START_NEW COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHKBON/ INSIDE, START_NEW, LINNTP, LIN1, DASH COMMON /LINDAT/ RDASH(11), RSPACE(11) C IX = ISCRX( XWRLD ) IY = ISCRY( YWRLD ) INX = IX .GE. IASCR .AND. IX .LE. IBSCR INY = IY .GE. ICSCR .AND. IY .LE. IDSCR INSIDE = INX .AND. INY WHEN ( LINTYP .GT. 0 ) LINNTP = MIN0( MAX0( LINTYP, 1 ), 8 ) DASH = SCRX * RDASH(LINNTP) FIN ELSE LINNTP = 0 FIN LIN1 = LINNTP IF ( INSIDE ) CALL DRDASH( IX, IY, IUD ) IXCUR = IX IYCUR = IY C RETURN END SUBROUTINE DRDASH( IX, IY, IUD ) INTEGER LIND(11) LOGICAL INSIDE, START_NEW REAL IDASH(11), ISPACE(11) COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /LINDAT/ IDASH, ISPACE COMMON /CHKBON/ INSIDE, START_NEW, LINNTP, LIN1, DASH DATA LIND / 1, 2, 3, 4, 5, 6, 9, 10, 7, 11, 8 / DATA IDASH/.02, .04, .08, .16, .24, .32, .16, .16, .04, .04, .04/ DATA ISPACE/.08, .08, .08, .08, .12, .16, .08, .08, .08, .08, .08/ DATA LINNTP, LIN1 / 0, 0 / C WHEN ( IUD .EQ. 1 .AND. LINNTP .NE. 0 ) DX = IX - X0 DY = IY - Y0 DS = SQRT( DX * DX + DY * DY ) IF ( DS .GT. 0. ) C = DX / DS S = DY / DS FIN WHILE ( DS .GT. 0. ) WHEN ( DASH .GT. 0. ) DDS = AMIN1 ( DS, DASH ) DS = DS - DDS DASH = DASH - DDS IF( DASH .LE. 0. ) SPACE = SCRX * ISPACE(LIN1) X0 = X0 + DDS * C Y0 = Y0 + DDS * S IX0 = X0 + .5 IY0 = Y0 + .5 CALL PLOT( IX0, IY0, 1 ) FIN ELSE DDS = AMIN1 ( DS, SPACE ) DS = DS - DDS SPACE = SPACE - DDS IF( SPACE .LE. 0. ) LIN1 = LIND(LIN1) DASH = SCRX * IDASH(LIN1) FIN X0 = X0 + DDS * C Y0 = Y0 + DDS * S IX0 = X0 + .5 IY0 = Y0 + .5 CALL PLOT( IX0, IY0, 0 ) FIN FIN FIN ELSE CALL PLOT( IX, IY, IUD ) FIN X0 = IX Y0 = IY C RETURN END SUBROUTINE PLTSTR( IX, IY, STR, LEN, IROT, ISIZE ) BYTE STR(LEN) LOGICAL INX, INY COMMON /HFRAME/ IXMINF, IXMAXF, IYMINF, IYMAXF C INX = IX .GE. IXMINF .AND. IX .LE. IXMAXF INY = IY .GE. IYMINF .AND. IY .LE. IYMAXF IF ( INX .AND. INY ) CALL PLOT ( IX, IY, 0 ) CALL WRTSTR ( STR, LEN, IROT, ISIZE ) FIN C RETURN END SUBROUTINE DRWREC( XMIN, XMAX, YMIN, YMAX, ICOL ) C CALL COLTYP(ICOL) CALL MOVETO(XMIN, YMIN, 0, 0) CALL MOVETO(XMAX, YMIN, 1, 0) CALL MOVETO(XMAX, YMAX, 1, 0) CALL MOVETO(XMIN, YMAX, 1, 0) CALL MOVETO(XMIN, YMIN, 1, 0) C RETURN END SUBROUTINE TRIMSP( TITLE, LEN, IST, IEND ) BYTE TITLE(LEN) C IST = 1 IEND = LEN WHILE ( IST .LT. LEN .AND. TITLE(IST) .EQ. ' ' ) IST = IST + 1 WHILE ( IEND .GT. IST .AND. TITLE(IEND) .EQ. ' ' ) IEND = IEND - 1 C RETURN END SUBROUTINE TRIML( LABEL, N, LEN ) BYTE LABEL(N) C I = 1 WHILE ( I .LT. N .AND. LABEL(I) .EQ. ' ' ) I = I + 1 LEN = 0 DO ( J = I, N ) LEN = LEN + 1 LABEL(LEN) = LABEL(J) FIN C RETURN END FUNCTION ISCRX( XWRLD ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST C X = AMIN1( XWRLD * XSLOPE + XCONST, 32767. ) X = AMAX1 ( X, -32767. ) ISCRX = IFIX( X + .5 ) C RETURN END FUNCTION ISCRY( YWRLD ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST C Y = AMIN1 ( YWRLD * YSLOPE + YCONST, 32767. ) Y = AMAX1 ( Y, -32767. ) ISCRY = IFIX ( Y + .5 ) C RETURN END FUNCTION XWORLD( IX ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST C XWORLD = ( IX - XCONST ) / XSLOPE C RETURN END FUNCTION YWORLD( IY ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST C YWORLD = ( IY - YCONST ) / YSLOPE C RETURN END SUBROUTINE CURPOS( ICURX, ICURY ) COMMON /HCURPO/ IXCUR, IYCUR C ICURX = IXCUR ICURY = IYCUR C RETURN END SUBROUTINE INILGN( XMIN, XMAX, YMIN, YMAX ) COMMON /HFRAME/ I1(4) COMMON /HSCALE/ X1(4) COMMON /HWINDO/ SCRX, SCRY, I2(6) COMMON /WORLD/ X2(4) COMMON /CHRSIZ/ ICHW(5), ICHH(5) COMMON /SAVPAR/ J1(4), Y1(4), J2(6), Y2(4) COMMON /LGND/ YSTRT, DELY, DELX, X(2) C DO ( I = 1, 6 ) J2(I) = I2(I) DO ( I = 1, 4 ) J1(I) = I1(I) Y1(I) = X1(I) Y2(I) = X2(I) FIN C CALL FRAME( XMIN, XMAX, YMIN, YMAX ) CALL WINDOW( 0., XMAX - XMIN, 0., YMAX - YMIN ) CALL VUPORT( 0., 1., 0., 1. ) DELY = YWORLD( ICHH(2) ) - YWORLD(0) DELX = XWORLD( ICHW(2) ) - XWORLD(0) YSTRT = .99 - DELY X(1) = .05 X(2) = .2 C RETURN END SUBROUTINE ENDLGN COMMON /HFRAME/ I1(4) COMMON /HSCALE/ X1(4) COMMON /HWINDO/ SCRX, SCRY, I2(6) COMMON /WORLD/ X2(4) COMMON /SAVPAR/ J1(4), Y1(4), J2(6), Y2(4) C DO ( I = 1, 6 ) I2(I) = J2(I) DO ( I = 1, 4 ) I1(I) = J1(I) X1(I) = Y1(I) X2(I) = Y2(I) FIN C RETURN END SUBROUTINE WRILGN( TITLE, N, ICOL, ISYM, INUM, LINTYP ) BYTE TITLE(N) DIMENSION X(2), Y(2) COMMON /LGND/ YSTRT, DELY, DELX, XX(2) DATA XX / .05, .2 / C Y(1) = YSTRT Y(2) = YSTRT X(2) = XX(2) CONDITIONAL ( INUM .LT. 0 ) NUM = -2 X(1) = XX(2) FIN ( INUM .GT. 0 ) NUM = 1 X(1) = XX(1) FIN ( INUM .EQ. 0 ) NUM = 0 X(1) = XX(1) FIN FIN CALL DASHLN( X, Y, 2, ICOL, ISYM, 2, NUM, LINTYP ) IX = ISCRX( X(2) + DELX ) IY = ISCRY( YSTRT - .5 * DELY ) CALL PLTSTR( IX, IY, TITLE, N, 1, 2 ) YSTRT = YSTRT - DELY C RETURN END SUBROUTINE RECLGN( NL, TITLE, N, ICOL, ISYM, INUM, LINTYP, 1 XSTRT, XLEN, YSTRT ) BYTE TITLE(1) DIMENSION XSTRT(NL), XLEN(NL), YSTRT(NL) INTEGER N(NL), ICOL(NL), ISYM(NL), INUM(NL), LINTYP(NL) COMMON /PAGSIZ/ XBOND, YBOND COMMON /LGND/ YSTART, DELY, DELX, X(2) C CALL INILGN( 0., XBOND, 0., YBOND ) IST = 1 DO ( I = 1, NL ) X(1) = XSTRT(I) X(2) = XSTRT(I) + XLEN(I) YSTART = YSTRT(I) CALL WRILGN(TITLE(IST),N(I),ICOL(I),ISYM(I),INUM(I),LINTYP(I)) IST = IST + N(I) FIN CALL ENDLGN C RETURN END SUBROUTINE INIPLT( IUNIT, XSIZE, YSIZE ) BYTE ESC, FF, SUB, ENQ, CHAR, MES(10), TRANS(2), VTBUFR(128) BYTE MESCLR(4) !Line added for VT125. INTEGER VTPOS, VTBUFL INTEGER VCHR_WIDTH(5), VCHR_HEIGHT(5) INTEGER HCHR_WIDTH(5), HCHR_HEIGHT(5) LOGICAL VISUAL COMMON /PAGSIZ/ XBOND, YBOND COMMON /HFRAME/ IXMINF, IXMAXF, IYMINF, IYMAXF COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /CHRSIZ/ ICHW(5), ICHH(5) COMMON /PENPOS/ IUPDWN COMMON /HBYTE/ ESC, FF, SUB, ENQ, CHAR COMMON /VTBUF/ VTBUFR, VTPOS, VTBUFL DATA MES / ';', ':', 'E', 'H', 'H', 'O', 'U', 'A', 'L', '0' / DATA FF , ENQ, SUB, ESC, TRANS / 12, 5, 26, 27, 29, 77 / DATA VCHR_WIDTH, VCHR_HEIGHT / 7,10,20,30,40, 10,15,30,45,60 / DATA HCHR_WIDTH, HCHR_HEIGHT / 18,24,36,48,72, 24,36,54,72,108 / DATA IASCR, IBSCR, ICSCR, IDSCR, IXORIG, IYORIG, XCONST, YCONST 1 / 6 * 0, 2 * 0. / DATA MESCLR /27,'[','2','J'/ !Line added for VT125. C ITTNUM = 7 LUNPLT = IUNIT VISUAL = LUNPLT .EQ. ITTNUM VTBUFL = 128 VTPOS = 0 IUPDWN = 0 WHEN ( VISUAL ) !Modified for VT125 C********CALL WRITCH(TRANS, 2) !Line removed. CALL WRITCH (MESCLR,4) !Line added to clear alpha screen on 125. CALL PLTON !Line added. CALL ERASE SCRX = 75. SCRY = 75. DO ( I = 1, 5 ) ICHW(I) = VCHR_WIDTH(I) ICHH(I) = VCHR_HEIGHT(I) FIN FIN ELSE IF ( IUNIT .EQ. 8 ) LUNPLT = ITTNUM CALL PLTON FIN CALL WRITCH(MES, 10 ) SCRX = 200. SCRY = 200. DO ( I = 1, 5 ) ICHW(I) = HCHR_WIDTH(I) ICHH(I) = HCHR_HEIGHT(I) FIN FIN XBOND = XSIZE YBOND = YSIZE XMINW = 0. XMAXW = 1. YMINW = 0. YMAXW = 1. CALL FRAME( 0., XSIZE, 0., YSIZE ) CALL WINDOW( .2 * XSIZE, .8 * XSIZE, .2 * YSIZE, .8 * YSIZE ) C RETURN END SUBROUTINE ENDPLT BYTE MES(12) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MES /'P','0','E','F','3','0','0','0',',','0',' ','@'/ C WHEN ( VISUAL ) CALL PLTOFF CALL DMPPLT FIN ELSE CALL WRITCH(MES, 12 ) IF( LUNPLT .EQ. ITTNUM ) CALL PLTOFF CALL DMPPLT FIN IF ( LUNPLT .NE. ITTNUM ) CLOSE( UNIT = LUNPLT ) C RETURN END SUBROUTINE PENDWN BYTE MESH(2), MESV(5) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /PENPOS/ IUPDWN DATA MESH, MESV / 'D', ' ', 27, '/', '0', 'd', 29 / C WHEN ( VISUAL ) C********CALL WRITCH( MESV, 5 ) !Removed for VT125. IUPDWN = 1 !Added for VT125. FIN ELSE IF( IUPDWN .EQ. 0 ) CALL WRITCH(MESH, 2) IUPDWN = 1 FIN C RETURN END SUBROUTINE PENUP BYTE MESH(2), MESV(5) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /PENPOS/ IUPDWN DATA MESH, MESV / 'U', ' ', 27, '/', '1', 'd', 28 / C WHEN ( VISUAL ) C********CALL WRITCH( MESV, 5 ) !Removed for VT125. IUPDWN = 0 !Added for VT125. FIN ELSE IF( IUPDWN .EQ. 1 ) CALL WRITCH(MESH, 2) IUPDWN = 0 FIN C RETURN END SUBROUTINE WRTSTR( STR, LEN, IROT, ISIZE ) BYTE STR(LEN), MES(5), XL, XH, YL, YH INTEGER POSIT(96), BLOCK(693) LOGICAL VISUAL, DONE COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHRSIZ/ ICHW(5), ICHH(5) COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA N, YL, YH, XL, XH / 693, 96, 32, 64, 32 / DATA POSIT / 1,2,173,26,34,48,71,177,94,98,86,106,183,102,189,200, . 602,611,616,624,637,641,650,662,666,682,163,152,194,110,197,202, . 6,217,222,234,242,249,255,260,270,276,282,287,292,295,300,304, . 313,320,331,340,352,356,362,365,370,374,379,126,213,130, 68,104, . 120,383,393,403,411,421,431,438,451,458,468,479,486,491,502,509, . 518,528,538,544,556,563,570,573,584,588,598,134,215,143,114, 1/ DATA BLOCK / . 2192,156,1173,146,3216,208,1104,1042,1050,1116,1244,1306,1300, . 1267,1235,1204,1208,183,1176,1144,1111,1110,1141,1173,3254,92, . 1104,220,1232,24,1304,20,3348,51,1106,1234,1267,1269,1238,1110, . 1079,1081,1114,1242,1273,156,3216,60,1051,1050,1081,1113,1146, . 1147,1116,1084,284,1040,240,1297,1298,1267,1235,1202,1201,1232, . 3312,20,1176,3348,276,1236,1203,1201,1168,1072,1041,1044,1176, . 1178,1148,1116,1082,1080,3345,26,1298,18,1306,22,1302,154,3218, . 188,1146,1138,3248,124,1210,1202,3184,22,3350,12,3468,154,1170, . 22,3350,24,1304,20,3348,22,1079,1143,1205,1269,3350,123,1179, . 1180,1148,1147,3257,188,1148,1136,3248,124,1212,1200,3184,252, . 1212,1179,1176,1110,1172,1169,1200,3312,60,1148,1179,1176,1238, . 1172,1169,1136,3120,181,1206,1238,1237,1205,208,1200,1201,1233, . 1232,3214,117,1142,1174,1173,1141,112,1137,1169,1168,3184,92, . 1114,220,3290,219,1211,1212,1244,1243,3225,208,1200,1201,1233, . 1232,3214,112,1137,1169,1168,3184,284,1046,3344,28,1302,3088,218, . 3088,59,1116,1244,1275,1272,1239,1207,1174,1173,146,3216,26,3280, . 156,3216,16,1180,1296,51,3315,16,1052,1244,1306,1304,1238,1046, . 214,1300,1298,1232,3088,282,1244,1116,1050,1042,1104,1232,3346, . 16,1052,1244,1306,1298,1232,3088,284,1052,1040,1296,22,3222,284, . 1052,1040,22,3222,282,1244,1116,1050,1042,1104,1232,1298,1301, . 3221,16,1052,22,1302,284,3344,28,1308,156,1168,16,3344,284,1298, . 1232,1104,3090,16,1052,284,1046,3344,28,1040,3344,16,1052,1168, . 1308,3344,16,1052,1296,3356,208,1104,1042,1050,1116,1244,1306, . 1298,3280,16,1052,1244,1306,1304,1238,3094,208,1104,1042,1050, . 1116,1244,1306,1298,1232,210,3344,16,1052,1244,1306,1304,1238, . 1046,214,3344,18,1104,1232,1298,1300,1238,1110,1048,1050,1116, . 1244,3354,28,1308,156,3216,28,1042,1104,1232,1298,3356,28,1168, . 3356,28,1040,1174,1296,3356,28,1296,16,3356,28,1174,1308,150, . 3216,28,1308,1040,3344,244,1206,1110,1044,1042,1104,1200,1266, . 246,3312,26,1040,18,1104,1200,1266,1268,1206,1110,3092,213,1206, . 1110,1044,1042,1104,1200,3281,244,1238,1110,1044,1042,1104,1200, . 1266,250,3312,19,1267,1269,1206,1110,1044,1042,1104,1200,3312, . 249,1242,1178,1144,1136,21,3285,212,1174,1110,1044,1042,1104, . 1168,1234,214,1229,1196,1068,3085,26,1040,20,1110,1206,1268,3312, . 122,1178,1177,1145,1146,118,1174,1168,80,3280,154,1210,1209,1177, . 1178,150,1206,1197,1164,1068,3085,26,1040,214,1107,1043,83,3280, . 122,1178,1168,112,3248,16,1045,1078,1142,1173,1168,1173,1206, . 1270,1301,3344,22,1040,20,1110,1206,1268,3312,242,1200,1104,1042, . 1044,1110,1206,1268,3314,22,1036,18,1104,1200,1266,1268,1206, . 1110,3092,244,1206,1110,1044,1042,1104,1200,1266,246,3308,22, . 1040,20,1110,1206,3285,17,1072,1200,1233,1234,1203,1075,1044, . 1045,1078,1206,3285,122,1137,1168,1200,1233,54,3254,22,1042,1104, . 1200,1266,246,3312,22,1136,3286,22,1041,1072,1136,1169,1171,145, . 1200,1264,1297,3350,22,1232,16,3286,22,1042,1104,1168,1234,214, . 1229,1196,1068,3085,22,1238,1040,3280,210,1168,1104,1042,1050, . 1116,1180,1242,3282,90,1180,1168,80,3280,27,1084,1212,1243,1240, . 1042,1040,3280,27,1084,1212,1243,1240,1174,1110,150,1236,1233, . 1200,1072,3089,208,1244,1044,3348,220,1052,1046,1206,1237,1233, . 1200,1072,3089,219,1212,1084,1051,1041,1072,1200,1233,1237,1206, . 1078,3093,28,1244,1242,3088,86,1048,1051,1084,1212,1243,1240, . 1174,1110,1044,1041,1072,1200,1233,1236,3222,17,1072,1200,1233, . 1243,1212,1084,1051,1047,1078,1206,3287 / C IF ( VISUAL ) CALL PENDWN !V550 specific lines deleted. C MES(2) = MOD( IYCUR, 32 ) .OR. YL C MES(1) = ( IYCUR / 32 ) .OR. YH C MES(4) = MOD( IXCUR, 32 ) .OR. XL C MES(3) = ( IXCUR / 32 ) .OR. XH C MES(5) = 31 C CALL WRITCH( MES, 5 ) FIN ISZ = MIN0( MAX0( ISIZE, 1 ), 5 ) IRT = MOD( IROT - 1, 4 ) + 1 ISX = IABS( IRT - 3 ) - 1 ISY = IABS( IRT - 2 ) - 1 IXC = IXCUR IYC = IYCUR DO ( I = 1, LEN ) JCHR = STR(I) - 31 IF( JCHR .GT. 0 ) J = POSIT(JCHR) JWID = ICHW(ISZ) DONE = .FALSE. WHILE ( .NOT. DONE ) IXP = MOD( BLOCK(J), 1024 ) IUD = 0 IF( MOD( BLOCK(J), 2048 ) .GE. 1024 ) IUD = 1 IYP = MOD( IXP , 32 ) - 12 IYP = ( ICHH(ISZ) * IYP ) / 12. + .5 IXP = IXP / 32 IXP = ( ICHW(ISZ) * IXP ) / 12. + .5 IX = IXC + IXP * ISX - ISY * IYP IY = IYC + IXP * ISY + ISX * IYP CALL PLOT( IX, IY, IUD ) IF( BLOCK(J) .GE. 2048 ) DONE = .TRUE. J = J + 1 FIN IXC = IXC + JWID * ISX IYC = IYC + JWID * ISY FIN FIN IXCUR = IXC IYCUR = IYC C RETURN END SUBROUTINE MARKER( ISYM, ISIZE ) BYTE MES(4) INTEGER MARK_SIZE(5) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MARK_SIZE / 2, 3, 4, 6, 9 / 1 FORMAT('M ', 2I1) C ISZ = MAX0( MIN0(ISIZE, 5), 1 ) MRK = MIN0( MAX0(ISYM, 0), 5 ) WHEN ( VISUAL ) IW = MARK_SIZE(ISZ) CALL CURPOS( IX, IY ) SELECT ( MRK ) (0) ! PLUS SIGN CALL PLOT( IX-IW, IY, 0 ) CALL PLOT( IX+IW, IY, 1 ) CALL PLOT( IX, IY-IW, 0 ) CALL PLOT( IX, IY+IW, 1 ) FIN (1) ! CROSS CALL PLOT( IX-IW, IY-IW, 0 ) CALL PLOT( IX+IW, IY+IW, 1 ) CALL PLOT( IX+IW, IY-IW, 0 ) CALL PLOT( IX-IW, IY+IW, 1 ) FIN (2) ! SQUARE CALL PLOT( IX-IW, IY-IW, 0 ) CALL PLOT( IX+IW, IY-IW, 1 ) CALL PLOT( IX+IW, IY+IW, 1 ) CALL PLOT( IX-IW, IY+IW, 1 ) CALL PLOT( IX-IW, IY-IW, 1 ) FIN (3) ! CIRCLE CALL CIRCLE( IX, IY, IW ) FIN (4) ! TRIANGLE CALL PLOT( IX-IW, IY-IW, 0 ) CALL PLOT( IX+IW, IY-IW, 1 ) CALL PLOT( IX, IY+IW, 1 ) CALL PLOT( IX-IW, IY-IW, 1 ) FIN (5) ! HOURGLASS CALL PLOT( IX-IW, IY-IW, 0 ) CALL PLOT( IX+IW, IY+IW, 1 ) CALL PLOT( IX-IW, IY+IW, 1 ) CALL PLOT( IX+IW, IY-IW, 1 ) CALL PLOT( IX-IW, IY-IW, 1 ) FIN FIN FIN ELSE ENCODE( 4, 1, MES ) ( ISZ + 2 ) / 2, MRK IF ( MOD( ISZ, 2 ) .EQ. 1 ) MES(2) = MES(3) MES(3) = '+' FIN CALL WRITCH(MES, 4) FIN C RETURN END SUBROUTINE CIRCLE( IX, IY, IR ) BYTE MES(16) BYTE CENTER(12) !VT125 line added. BYTE MESCIR(9) !VT125 line added. LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM 1 FORMAT( 'CC', I4, ',', I4, I5 ) 2 FORMAT( A1, '/', I3, ';', I3, ';', I2, ';0A' ) 3 FORMAT('C[+',I4,',]') !VT125 line added. 4 FORMAT('P[',I4,',',I4,']') !VT125 line added. C WHEN ( VISUAL ) C********CALL PENDWN !550 Lines deleted. C********ENCODE( 15, 2, MES ) 27, IX, IY, IR C********DO ( I = 1, 15 ) IF( MES(I) .EQ. ' ' ) MES(I) = '0' C********CALL WRITCH( MES, 15 ) C !VT125 lines added. ENCODE (12, 4, CENTER) IX, 479-IY !Move to specified center. CALL WRITCH (CENTER,12) ENCODE (9, 3, MESCIR) IR !Draw circle. CALL WRITCH (MESCIR,9) FIN ELSE ENCODE( 16, 1, MES ) IX, IY, IR CALL WRITCH( MES, 16 ) FIN C RETURN END SUBROUTINE COLTYP( ICOL ) BYTE MES(2) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM C IF( .NOT. VISUAL ) ITYPE = ICOL + 1 ITYPE = MIN0(ITYPE, 8) ITYPE = MAX0(ITYPE, 1) MES(1) = 'P' MES(2) = ITYPE + 48 CALL WRITCH(MES, 2) FIN C RETURN END SUBROUTINE PLOT( IX, IY, IUD ) BYTE LOWY, HIGHY, LOWX, HIGHX, YL, YH, XL, XH BYTE MES(10) BYTE MESBEG(2),MESXY(10),MESEND !Line added for VT125. LOGICAL VISUAL COMMON /HFRAME/ IXMINF, IXMAXF, IYMINF, IYMAXF COMMON /HCURPO/ IXCUR, IYCUR COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA YL, YH, XL, XH / 96, 32, 64, 32 / DATA MESBEG /' ','['/ !Line added for VT125. DATA MESEND /']'/ !Line added for VT125. 1 FORMAT( I4, ',', I4, 1X ) C IX0 = IX IY0 = IY C C CHECK TO SEE IF IN BOUNDS C CONDITIONAL ( IX0 .LT. IXMINF ) IX0 = IXMINF ( IX0 .GT. IXMAXF ) IX0 = IXMAXF FIN CONDITIONAL ( IY0 .LT. IYMINF ) IY0 = IYMINF ( IY0 .GT. IYMAXF ) IY0 = IYMAXF FIN WHEN (IUD .EQ. 1) CALL PENDWN ELSE CALL PENUP C WHEN ( .NOT. VISUAL ) ENCODE( 10, 1, MES ) IX0, IY0 CALL WRITCH(MES, 10) FIN ELSE C MES(2) = MOD( IYCUR, 32 ) .OR. YL !Visual specific lines deleted. C MES(1) = ( IYCUR / 32 ) .OR. YH C MES(4) = MOD( IXCUR, 32 ) .OR. XL C MES(3) = ( IXCUR / 32 ) .OR. XH C MES(6) = MOD( IY0, 32 ) .OR. YL C MES(5) = ( IY0 / 32 ) .OR. YH C MES(8) = MOD( IX0, 32 ) .OR. XL C MES(7) = ( IX0 / 32 ) .OR. XH C CALL WRITCH(MES, 8) C FIN WHEN (IUD.EQ.1) MESBEG(1) = 'V' !If pendown draw vector. ELSE MESBEG(1) = 'P' !If penup reposition. IREALY = 479 - IY0 !Convert point to Regis coord. ENCODE (10,1,MESXY) IX0,IREALY !Encode message. CALL WRITCH (MESBEG,2) !Output Regis command string. CALL WRITCH (MESXY,10) CALL WRITCH (MESEND,1) FIN IXCUR = IX0 IYCUR = IY0 C RETURN END SUBROUTINE ERASE BYTE MES(2) BYTE MES125(4) !Line added for VT125. LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MES / 27, 12 / DATA MES125 /'S','(','E',')'/ !Line added for VT125. C C*****IF( VISUAL ) CALL WRITCH(MES, 2) !Modified for VT125 IF( VISUAL ) CALL WRITCH(MES125,4) !Line added for VT125. C RETURN END SUBROUTINE PLTON BYTE MES(4) BYTE MES125(3) !Line added for VT125. BYTE MESCLR(4) !Line added for VT125. LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MES/ 27, '[', '5', 'i' / DATA MES125 /"33,'P','p'/ !Enter REGIS = ESC P p DATA MESCLR /"33,'[','2','J'/ !Clear alpha screen. C WHEN ( .NOT. VISUAL ) CALL WRITCH(MES,4) FIN ELSE C*********CALL WRITCH(31,1) CALL WRITCH(MESCLR,4) !Clear 125 alpha plane. CALL WRITCH(MES125,3) !Enter Regis. FIN C RETURN END SUBROUTINE PLTOFF BYTE MES(4) BYTE BOTTOM(8) !Line added for VT125. BYTE MES125(2) !Line added for VT125. LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MES/ 27, '[', '4', 'i' / DATA MES125 /27,'\'/ !Line added for VT125. DATA BOTTOM /"33,'[','H',"33,'[','2','5','B'/ !Move cursor to bottom C of screen. WHEN ( .NOT. VISUAL ) CALL WRITCH(MES,4) FIN ELSE C*********CALL WRITCH(24, 1) CALL WRITCH(MES125,2) !Output REGIS command CALL WRITCH (BOTTOM,8) !terminator, move cursor to CALL DMPPLT !bottom of screen, and output FIN !characters remaining in buffer. C RETURN END SUBROUTINE WRITCH( CH, N ) BYTE VTBUFR(128), CH(N) INTEGER VTPOS, VTBUFL LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /VTBUF/ VTBUFR, VTPOS, VTBUFL C IF( VTPOS + N .GT. VTBUFL ) CALL DMPPLT DO ( I = 1, N ) VTPOS = VTPOS + 1 VTBUFR(VTPOS) = CH(I) FIN IF ( VTPOS .GE. VTBUFL ) CALL DMPPLT C RETURN END SUBROUTINE DMPPLT BYTE VTBUFR(128) INTEGER VTPOS, VTBUFL LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /VTBUF/ VTBUFR, VTPOS, VTBUFL 1 FORMAT( 1X, 128A1 ) 2 FORMAT( '+', 128( A1, $ ) ) C WHEN ( VISUAL ) WRITE(LUNPLT, 2) ( VTBUFR(I), I = 1, VTPOS ) ELSE WRITE(LUNPLT, 1) ( VTBUFR(I), I = 1, VTPOS ) VTPOS = 0 C RETURN END