You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
342 lines
8.5 KiB
342 lines
8.5 KiB
2 years ago
|
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
||
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
||
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
||
|
|
C
|
||
|
|
C See packages/seacas/LICENSE for details
|
||
|
|
|
||
|
|
C=======================================================================
|
||
|
|
SUBROUTINE PLTXTS(X,Y,TEXT)
|
||
|
|
REAL DEVCAP(23)
|
||
|
|
REAL DEFOUT(7)
|
||
|
|
COMMON /STATUS/DEVCAP,DEFOUT
|
||
|
|
REAL DEVP(5)
|
||
|
|
COMMON /DEVICE/DEVP
|
||
|
|
REAL COLP(3)
|
||
|
|
REAL PALETT(3,16)
|
||
|
|
COMMON /COLOR/COLP,PALETT
|
||
|
|
REAL TEXTP(40)
|
||
|
|
COMMON /TEXT/TEXTP
|
||
|
|
REAL VECTP(5)
|
||
|
|
REAL XCUR
|
||
|
|
REAL YCUR
|
||
|
|
COMMON /VECTRC/VECTP,XCUR,YCUR
|
||
|
|
INTEGER IDEX(200,2)
|
||
|
|
INTEGER NVECT(200,2)
|
||
|
|
REAL XSIZE(200,2)
|
||
|
|
REAL YSIZE(200,2)
|
||
|
|
REAL X0(2300,2)
|
||
|
|
REAL Y0(2300,2)
|
||
|
|
REAL X1(2300,2)
|
||
|
|
REAL Y1(2300,2)
|
||
|
|
COMMON /FONT/IDEX,NVECT,XSIZE,YSIZE,X0,Y0,X1,Y1
|
||
|
|
REAL GRAPHP(100)
|
||
|
|
COMMON /GRAPH/GRAPHP
|
||
|
|
COMMON /MAPPAR/MAPP(11)
|
||
|
|
REAL MAPP
|
||
|
|
COMMON /STORAG/MEMORY(1000)
|
||
|
|
LOGICAL CPUIFC
|
||
|
|
CHARACTER*(*) TEXT
|
||
|
|
CHARACTER*1 LASCHR,ESCCHR, textip1
|
||
|
|
CHARACTER*20 ESC
|
||
|
|
INTEGER ASCII
|
||
|
|
LOGICAL STATUS,CHRCI
|
||
|
|
|
||
|
|
ESCCHR = CHAR(92)
|
||
|
|
IFONT = 1
|
||
|
|
CALL PLTSVV
|
||
|
|
CALL PLTSTV(1,1.)
|
||
|
|
CALL PLTSTV(2,TEXTP(37))
|
||
|
|
CALL PLTRIM(TEXT,NCHAR)
|
||
|
|
TEXTP(18) = X
|
||
|
|
TEXTP(19) = Y
|
||
|
|
IFLAG = 0
|
||
|
|
YSAVE = Y
|
||
|
|
YCHRSZ = TEXTP(1)
|
||
|
|
LASCHR = 'M'
|
||
|
|
I = 1
|
||
|
|
2020 IF (.NOT. (I.LE.NCHAR)) GO TO 2040
|
||
|
|
ASCII = ICHAR(TEXT(I:I))
|
||
|
|
IF (ASCII.LT.1 .OR. ASCII.GT.126) THEN
|
||
|
|
CALL CHRIC(ASCII,LASCHR,LI)
|
||
|
|
CALL PLTFLU
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END IF
|
||
|
|
|
||
|
|
if (i .lt. nchar) then
|
||
|
|
textip1 = text(i+1:i+1)
|
||
|
|
else
|
||
|
|
textip1 = escchr
|
||
|
|
end if
|
||
|
|
|
||
|
|
IF (ASCII.EQ.ICHAR(ESCCHR) .AND. textip1.EQ.ESCCHR) THEN
|
||
|
|
I = I + 1
|
||
|
|
|
||
|
|
ELSE IF (ASCII.EQ.ICHAR(ESCCHR)) THEN
|
||
|
|
CALL PLTESC(TEXT,I,ESC)
|
||
|
|
CALL CHRUP(ESC,ESC)
|
||
|
|
IF (ESC.EQ.'^') THEN
|
||
|
|
IF (IFLAG.NE.1) THEN
|
||
|
|
IF (IFLAG.EQ.-1) THEN
|
||
|
|
CALL PLTNOR(YBUMP,YCHRSZ)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL PLTSUP(YBUMP,YCHRSZ)
|
||
|
|
IFLAG = 1
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'_') THEN
|
||
|
|
IF (IFLAG.NE.-1) THEN
|
||
|
|
IF (IFLAG.EQ.1) THEN
|
||
|
|
CALL PLTNOR(YBUMP,YCHRSZ)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL PLTSUB(YBUMP,YCHRSZ)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IFLAG = -1
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'-') THEN
|
||
|
|
IF (IFLAG.NE.0) THEN
|
||
|
|
CALL PLTNOR(YBUMP,YCHRSZ)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IFLAG = 0
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CLO') THEN
|
||
|
|
ASCII = 4
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CSQ') THEN
|
||
|
|
ASCII = 5
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CDI') THEN
|
||
|
|
ASCII = 6
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CCS') THEN
|
||
|
|
ASCII = 7
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CX') THEN
|
||
|
|
ASCII = 8
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CTR') THEN
|
||
|
|
ASCII = 9
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CCI') THEN
|
||
|
|
ASCII = 10
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CDO') THEN
|
||
|
|
ASCII = 11
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'LO') THEN
|
||
|
|
ASCII = 12
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'SQ') THEN
|
||
|
|
ASCII = 13
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'DI') THEN
|
||
|
|
ASCII = 14
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CS') THEN
|
||
|
|
ASCII = 15
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'X') THEN
|
||
|
|
ASCII = 16
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'TR') THEN
|
||
|
|
ASCII = 17
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CI') THEN
|
||
|
|
ASCII = 18
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'DO') THEN
|
||
|
|
ASCII = 19
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'PLUSMIN') THEN
|
||
|
|
ASCII = 20
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'LEQ') THEN
|
||
|
|
ASCII = 21
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'GEQ') THEN
|
||
|
|
ASCII = 22
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'NEQ') THEN
|
||
|
|
ASCII = 23
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'PRIME') THEN
|
||
|
|
ASCII = 24
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'NLEQ') THEN
|
||
|
|
ASCII = 25
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'NGEQ') THEN
|
||
|
|
ASCII = 26
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'LL') THEN
|
||
|
|
ASCII = 27
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'GG') THEN
|
||
|
|
ASCII = 28
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'SUM') THEN
|
||
|
|
ASCII = 29
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'NLT') THEN
|
||
|
|
ASCII = 30
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'NGT') THEN
|
||
|
|
ASCII = 31
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'APPROX') THEN
|
||
|
|
ASCII = 127
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CR') THEN
|
||
|
|
TEXTP(18) = X + TEXTP(30)*TEXTP(1)*TEXTP(29)
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'LF') THEN
|
||
|
|
TEXTP(19) = YSAVE - TEXTP(30)*TEXTP(1)*TEXTP(28)
|
||
|
|
YSAVE = TEXTP(19)
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'CL') THEN
|
||
|
|
TEXTP(18) = X + TEXTP(30)*TEXTP(1)*TEXTP(29)
|
||
|
|
TEXTP(19) = YSAVE - TEXTP(30)*TEXTP(1)*TEXTP(28)
|
||
|
|
YSAVE = TEXTP(19)
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'ENG') THEN
|
||
|
|
IFONT = 1
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'GR') THEN
|
||
|
|
IFONT = 2
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'DDLINE') THEN
|
||
|
|
CALL PLTSVV
|
||
|
|
CALL PLTSTV(1,3.)
|
||
|
|
CALL PLTDV2(TEXTP(14),1,0.,.5,4.,.5)
|
||
|
|
TEXTP(18) = TEXTP(18) + 4.*TEXTP(28)*YCHRSZ*TEXTP(31)
|
||
|
|
TEXTP(19) = TEXTP(19) + 4.*TEXTP(29)*YCHRSZ*TEXTP(31)
|
||
|
|
LASCHR = 'M'
|
||
|
|
CALL PLTREV
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'DLINE') THEN
|
||
|
|
CALL PLTSVV
|
||
|
|
CALL PLTSTV(1,2.)
|
||
|
|
CALL PLTDV2(TEXTP(14),1,0.,.5,4.,.5)
|
||
|
|
TEXTP(18) = TEXTP(18) + 4.*TEXTP(28)*YCHRSZ*TEXTP(31)
|
||
|
|
TEXTP(19) = TEXTP(19) + 4.*TEXTP(29)*YCHRSZ*TEXTP(31)
|
||
|
|
LASCHR = 'M'
|
||
|
|
CALL PLTREV
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'LDLINE') THEN
|
||
|
|
CALL PLTSVV
|
||
|
|
CALL PLTSTV(1,5.)
|
||
|
|
CALL PLTDV2(TEXTP(14),1,0.,.5,4.,.5)
|
||
|
|
TEXTP(18) = TEXTP(18) + 4.*TEXTP(28)*YCHRSZ*TEXTP(31)
|
||
|
|
TEXTP(19) = TEXTP(19) + 4.*TEXTP(29)*YCHRSZ*TEXTP(31)
|
||
|
|
LASCHR = 'M'
|
||
|
|
CALL PLTREV
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'MDLINE') THEN
|
||
|
|
CALL PLTSVV
|
||
|
|
CALL PLTSTV(1,6.)
|
||
|
|
CALL PLTDV2(TEXTP(14),1,0.,.5,4.,.5)
|
||
|
|
TEXTP(18) = TEXTP(18) + 4.*TEXTP(28)*YCHRSZ*TEXTP(31)
|
||
|
|
TEXTP(19) = TEXTP(19) + 4.*TEXTP(29)*YCHRSZ*TEXTP(31)
|
||
|
|
LASCHR = 'M'
|
||
|
|
CALL PLTREV
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'SDLINE') THEN
|
||
|
|
CALL PLTSVV
|
||
|
|
CALL PLTSTV(1,4.)
|
||
|
|
CALL PLTDV2(TEXTP(14),1,0.,.5,4.,.5)
|
||
|
|
TEXTP(18) = TEXTP(18) + 4.*TEXTP(28)*YCHRSZ*TEXTP(31)
|
||
|
|
TEXTP(19) = TEXTP(19) + 4.*TEXTP(29)*YCHRSZ*TEXTP(31)
|
||
|
|
LASCHR = 'M'
|
||
|
|
CALL PLTREV
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE IF (ESC.EQ.'SLINE') THEN
|
||
|
|
CALL PLTSVV
|
||
|
|
CALL PLTSTV(1,1.)
|
||
|
|
CALL PLTDV2(TEXTP(14),1,0.,.5,4.,.5)
|
||
|
|
TEXTP(18) = TEXTP(18) + 4.*TEXTP(28)*YCHRSZ*TEXTP(31)
|
||
|
|
TEXTP(19) = TEXTP(19) + 4.*TEXTP(29)*YCHRSZ*TEXTP(31)
|
||
|
|
LASCHR = 'M'
|
||
|
|
CALL PLTREV
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
STATUS = CHRCI(ESC,IESC)
|
||
|
|
IF (STATUS) THEN
|
||
|
|
ASCII = IESC
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
CALL PLTRIM(ESC,L)
|
||
|
|
CALL PLTFLU
|
||
|
|
CALL SIORPT('PLTXTS','Invalid escape sequence "'//
|
||
|
|
* ESC(1:L)//'"; escape sequence ignored.',2)
|
||
|
|
GO TO 2030
|
||
|
|
|
||
|
|
END IF
|
||
|
|
|
||
|
|
END IF
|
||
|
|
|
||
|
|
END IF
|
||
|
|
|
||
|
|
NOVECT = NVECT(ASCII,IFONT)
|
||
|
|
J = 0
|
||
|
|
2050 IF (.NOT. (J.LT.NOVECT)) GO TO 2060
|
||
|
|
JN = MIN(32,NOVECT-J)
|
||
|
|
CALL PLTDV2(TEXTP(14),JN,X0(IDEX(ASCII,IFONT)+J,IFONT),
|
||
|
|
* Y0(IDEX(ASCII,IFONT)+J,IFONT),
|
||
|
|
* X1(IDEX(ASCII,IFONT)+J,IFONT),
|
||
|
|
* Y1(IDEX(ASCII,IFONT)+J,IFONT))
|
||
|
|
J = J + JN
|
||
|
|
GO TO 2050
|
||
|
|
|
||
|
|
2060 CONTINUE
|
||
|
|
TEXTP(18) = TEXTP(18) + XSIZE(ASCII,IFONT)*TEXTP(28)*YCHRSZ*
|
||
|
|
* TEXTP(31)
|
||
|
|
TEXTP(19) = TEXTP(19) + XSIZE(ASCII,IFONT)*TEXTP(29)*YCHRSZ*
|
||
|
|
* TEXTP(31)
|
||
|
|
IF (I.LE.LEN(TEXT)) THEN
|
||
|
|
LASCHR = TEXT(I:I)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (CPUIFC(.FALSE.)) THEN
|
||
|
|
GO TO 2040
|
||
|
|
|
||
|
|
END IF
|
||
|
|
|
||
|
|
2030 I = I + 1
|
||
|
|
GO TO 2020
|
||
|
|
|
||
|
|
2040 CONTINUE
|
||
|
|
CALL PLTMOV(X,Y)
|
||
|
|
TEXTP(8) = TEXTP(18)
|
||
|
|
TEXTP(9) = TEXTP(19)
|
||
|
|
TEXTP(10) = X
|
||
|
|
TEXTP(11) = YSAVE
|
||
|
|
IF (IFLAG.NE.0) THEN
|
||
|
|
DO 2070 I = 14,17
|
||
|
|
TEXTP(I) = TEXTP(I)/TEXTP(32)
|
||
|
|
2070 CONTINUE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL PLTREV
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|