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.
378 lines
9.3 KiB
378 lines
9.3 KiB
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 vdicgi_char - FORTRAN shell for handling strings
|
|
|
|
C CESC - Escape
|
|
SUBROUTINE CESC2 (FUNCID, N, ARGS)
|
|
INTEGER FUNCID
|
|
REAL ARGS(N+1)
|
|
INTEGER LDR
|
|
CHARACTER*80 DATA
|
|
c CGI enumerated type definitions for FORTRAN programs
|
|
c 8 Sep 1989, last date modified
|
|
c Pat McGee, jpm@lanl.gov
|
|
|
|
c SRCP escapes
|
|
integer XEMFNM, XEMXCL, XEPCTL, XEAGMD, XEPCCL, XESVDI
|
|
parameter (XEMFNM= -28372, XEMXCL= -19281, XEPCTL= -190,
|
|
* XEAGMD= -23671, XEPCCL= -12048, XESVDI= -1001)
|
|
|
|
c SRCP definitions
|
|
c maximum error class
|
|
integer XMXERR
|
|
parameter (XMXERR = 9)
|
|
|
|
c maximum function identifier
|
|
integer XMXFCL
|
|
parameter (XMXFCL = 61)
|
|
|
|
c CGI definitions
|
|
c (used in many places)
|
|
integer CNO, CYES
|
|
parameter (CNO= 0, CYES= 1)
|
|
|
|
c force clear viewsurface (argument of CPDS)
|
|
integer CFORCC, CCONDC
|
|
parameter (CFORCC= 0, CCONDC= 1)
|
|
|
|
c view surface state (arg of most CQxxxx routines)
|
|
integer CDIRTY, CCLEAN
|
|
parameter (CDIRTY=0, CCLEAN=1)
|
|
|
|
c clip indicator
|
|
integer COFF, CON
|
|
parameter (COFF=0, CON=1)
|
|
|
|
c drawing surface clip indicator
|
|
integer CDCOFF, CDCREC, CVPORT
|
|
parameter (CDCOFF=0, CDCREC=1, CVPORT=2)
|
|
|
|
c error handling flag (arg of CERHCT)
|
|
integer CEHON, CEHROF, CEHDOF
|
|
parameter (CEHON=0, CEHROF=1, CEHDOF=2)
|
|
|
|
c device class (arg of CQID)
|
|
integer COUTPT, CINPUT, COUTIN
|
|
parameter (COUTPT=0, CINPUT=1, COUTIN=2)
|
|
|
|
c hard/soft copy flag
|
|
integer CHARD, CSOFT
|
|
parameter (CHARD= 0, CSOFT= 1)
|
|
|
|
c display type
|
|
integer CVECT, CRAST, COTHER
|
|
parameter (CVECT= 0, CRAST= 1, COTHER= 2)
|
|
|
|
c dynamic modification
|
|
integer CIRG, CCBS, CIMM
|
|
parameter (CIRG= 0, CCBS= 1, CIMM= 2)
|
|
|
|
c pixel location relative to coordinates */
|
|
integer CPXON, CPXBET
|
|
parameter (CPXON=0, CPXBET=1)
|
|
|
|
c support indicator
|
|
integer CSNO, CSYES, CSUNR
|
|
parameter (CSNO= 0, CSYES= 1, CSUNR=2)
|
|
|
|
c text final flag
|
|
integer CNOTFI, CFINAL
|
|
parameter (CNOTFI=0, CFINAL=1)
|
|
|
|
c clipping mode
|
|
integer CLOCUS, CSHAPE, CLOCSH
|
|
parameter(CLOCUS=0, CSHAPE=1, CLOCSH=2)
|
|
|
|
c text precision
|
|
integer CSTRNG, CCHAR, CSTROK
|
|
parameter(CSTRNG=0, CCHAR=1, CSTROK=2)
|
|
|
|
c text path
|
|
integer CTPRIT, CTPLFT, CTPUP, CTPDWN
|
|
parameter(CTPRIT=0, CTPLFT=1, CTPUP=2, CTPDWN=3)
|
|
|
|
c text horizontal alignment
|
|
integer CTALFT, CTACTR, CTARIT, CTANH, CTACOH
|
|
parameter(CTALFT=0, CTACTR=1, CTARIT=2, CTANH=3, CTACOH=4)
|
|
|
|
c text vertical alignment
|
|
integer CTATOP, CTACAP, CTAHAF, CTABAS
|
|
integer CTABOT, CTANV, CTACOV
|
|
parameter(CTATOP=0, CTACAP=1, CTAHAF=2, CTABAS=3)
|
|
parameter(CTABOT=4, CTANV=5, CTACOV=6)
|
|
|
|
c interior style
|
|
integer CHOLLO, CSOLID
|
|
parameter (CHOLLO= 0, CSOLID= 1)
|
|
|
|
c color selection mode (arg of CCSM, CQTXA)
|
|
integer CDRECT, CINDEX
|
|
parameter (CDRECT= 0, CINDEX= 1)
|
|
|
|
c line, edge width specification mode
|
|
c marker specification mode
|
|
|
|
c cell array fill capability
|
|
integer COUTLN, CFILLD
|
|
parameter (COUTLN=0, CFILLD=1)
|
|
|
|
c cell array alignment
|
|
integer CAXIS, CSKEW
|
|
parameter (CAXIS=0, CSKEW=1)
|
|
|
|
c compound text capability
|
|
c and closed figure capability
|
|
integer CCNONE, CGLOBL, CLOCAL
|
|
parameter (CCNONE=0, CGLOBL=1, CLOCAL=2)
|
|
|
|
c pattern transformation support
|
|
|
|
c color selection mode availability
|
|
integer CCLRI, CCLRID
|
|
parameter (CCLRI=0, CCLRID=1)
|
|
|
|
c color overwrite capability
|
|
|
|
c response validity
|
|
integer CINVAL, CVAL
|
|
parameter (CINVAL= 0, CVAL= 1)
|
|
|
|
c input class
|
|
|
|
c request status
|
|
|
|
c input device state
|
|
|
|
c direction
|
|
integer CINCR, CDECR
|
|
parameter (CINCR= 0, CDECR= 1)
|
|
|
|
c action required flag
|
|
integer CNOACT, CACT
|
|
parameter (CNOACT= 0, CACT= 1)
|
|
|
|
c pixel validity flag
|
|
integer CVNONE, CVALL, CVSOME
|
|
parameter (CVNONE= 0, CVALL= 1, CVSOME= 2)
|
|
|
|
LDR = 1
|
|
DATA = ' '
|
|
IF (FUNCID .EQ. XEAGMD) THEN
|
|
IF (ARGS(1) .EQ. 0) THEN
|
|
DATA(1:5) = 'ALPHA'
|
|
ELSE
|
|
DATA(1:8) = 'GRAPHICS'
|
|
ENDIF
|
|
ELSE
|
|
c*** I know this won't work for real, real numbers
|
|
DO 10 I = 1,N
|
|
DATA(I:I) = CHAR(INT(ARGS(I)))
|
|
10 CONTINUE
|
|
ENDIF
|
|
|
|
CALL CESC( FUNCID, LDR, DATA )
|
|
RETURN
|
|
END
|
|
|
|
C CTX - Text
|
|
SUBROUTINE CTX2(X, Y, TEXT1, LENGTH )
|
|
REAL X,Y
|
|
INTEGER FLAG
|
|
INTEGER TEXT1(LENGTH)
|
|
CHARACTER*136 TEXT2
|
|
|
|
FLAG = 1
|
|
|
|
DO 20 I=1,LENGTH
|
|
TEXT2(I:I) = CHAR(TEXT1(I))
|
|
20 CONTINUE
|
|
|
|
CALL CTX( X, Y, FLAG, TEXT2(1:LENGTH))
|
|
RETURN
|
|
END
|
|
|
|
C CGTXX - Get Text Extent
|
|
SUBROUTINE CGTXX2 ( X, Y, VSTAT, VCONC, XCONC, YCONC,
|
|
1 X1, Y1, X2, Y2, X3, Y3, X4, Y4)
|
|
REAL X,Y
|
|
CHARACTER*1 STRING
|
|
INTEGER VSTAT, VCONC
|
|
REAL XCONC, YCONC
|
|
REAL X1, Y1, X2, Y2, X3, Y3, X4, Y4
|
|
|
|
STRING = 'M'
|
|
CALL CGTXX( X, Y, STRING, VSTAT, VCONC, XCONC, YCONC,
|
|
1 X1, Y1, X2, Y2, X3, Y3, X4, Y4 )
|
|
RETURN
|
|
END
|
|
|
|
C CQCHH - Inquire Character Height
|
|
SUBROUTINE CQCHH2 (txp, nreq, first, vstat, ntotal,
|
|
1 nlist, chhit)
|
|
CHARACTER*1 FONT
|
|
INTEGER TXP, NREQ, FIRST, VSTAT, NTOTAL, NLIST
|
|
INTEGER CHHIT(*)
|
|
|
|
FONT = char(0)
|
|
CALL CQCHH( FONT, TXP, NREQ, FIRST, VSTAT, NTOTAL,
|
|
1 NLIST, CHHIT)
|
|
RETURN
|
|
END
|
|
|
|
C vdgnam -
|
|
subroutine vdgnam(name)
|
|
character *(*) name
|
|
c CGI enumerated type definitions for FORTRAN programs
|
|
c 8 Sep 1989, last date modified
|
|
c Pat McGee, jpm@lanl.gov
|
|
|
|
c SRCP escapes
|
|
integer XEMFNM, XEMXCL, XEPCTL, XEAGMD, XEPCCL, XESVDI
|
|
parameter (XEMFNM= -28372, XEMXCL= -19281, XEPCTL= -190,
|
|
* XEAGMD= -23671, XEPCCL= -12048, XESVDI= -1001)
|
|
|
|
c SRCP definitions
|
|
c maximum error class
|
|
integer XMXERR
|
|
parameter (XMXERR = 9)
|
|
|
|
c maximum function identifier
|
|
integer XMXFCL
|
|
parameter (XMXFCL = 61)
|
|
|
|
c CGI definitions
|
|
c (used in many places)
|
|
integer CNO, CYES
|
|
parameter (CNO= 0, CYES= 1)
|
|
|
|
c force clear viewsurface (argument of CPDS)
|
|
integer CFORCC, CCONDC
|
|
parameter (CFORCC= 0, CCONDC= 1)
|
|
|
|
c view surface state (arg of most CQxxxx routines)
|
|
integer CDIRTY, CCLEAN
|
|
parameter (CDIRTY=0, CCLEAN=1)
|
|
|
|
c clip indicator
|
|
integer COFF, CON
|
|
parameter (COFF=0, CON=1)
|
|
|
|
c drawing surface clip indicator
|
|
integer CDCOFF, CDCREC, CVPORT
|
|
parameter (CDCOFF=0, CDCREC=1, CVPORT=2)
|
|
|
|
c error handling flag (arg of CERHCT)
|
|
integer CEHON, CEHROF, CEHDOF
|
|
parameter (CEHON=0, CEHROF=1, CEHDOF=2)
|
|
|
|
c device class (arg of CQID)
|
|
integer COUTPT, CINPUT, COUTIN
|
|
parameter (COUTPT=0, CINPUT=1, COUTIN=2)
|
|
|
|
c hard/soft copy flag
|
|
integer CHARD, CSOFT
|
|
parameter (CHARD= 0, CSOFT= 1)
|
|
|
|
c display type
|
|
integer CVECT, CRAST, COTHER
|
|
parameter (CVECT= 0, CRAST= 1, COTHER= 2)
|
|
|
|
c dynamic modification
|
|
integer CIRG, CCBS, CIMM
|
|
parameter (CIRG= 0, CCBS= 1, CIMM= 2)
|
|
|
|
c pixel location relative to coordinates */
|
|
integer CPXON, CPXBET
|
|
parameter (CPXON=0, CPXBET=1)
|
|
|
|
c support indicator
|
|
integer CSNO, CSYES, CSUNR
|
|
parameter (CSNO= 0, CSYES= 1, CSUNR=2)
|
|
|
|
c text final flag
|
|
integer CNOTFI, CFINAL
|
|
parameter (CNOTFI=0, CFINAL=1)
|
|
|
|
c clipping mode
|
|
integer CLOCUS, CSHAPE, CLOCSH
|
|
parameter(CLOCUS=0, CSHAPE=1, CLOCSH=2)
|
|
|
|
c text precision
|
|
integer CSTRNG, CCHAR, CSTROK
|
|
parameter(CSTRNG=0, CCHAR=1, CSTROK=2)
|
|
|
|
c text path
|
|
integer CTPRIT, CTPLFT, CTPUP, CTPDWN
|
|
parameter(CTPRIT=0, CTPLFT=1, CTPUP=2, CTPDWN=3)
|
|
|
|
c text horizontal alignment
|
|
integer CTALFT, CTACTR, CTARIT, CTANH, CTACOH
|
|
parameter(CTALFT=0, CTACTR=1, CTARIT=2, CTANH=3, CTACOH=4)
|
|
|
|
c text vertical alignment
|
|
integer CTATOP, CTACAP, CTAHAF, CTABAS
|
|
integer CTABOT, CTANV, CTACOV
|
|
parameter(CTATOP=0, CTACAP=1, CTAHAF=2, CTABAS=3)
|
|
parameter(CTABOT=4, CTANV=5, CTACOV=6)
|
|
|
|
c interior style
|
|
integer CHOLLO, CSOLID
|
|
parameter (CHOLLO= 0, CSOLID= 1)
|
|
|
|
c color selection mode (arg of CCSM, CQTXA)
|
|
integer CDRECT, CINDEX
|
|
parameter (CDRECT= 0, CINDEX= 1)
|
|
|
|
c line, edge width specification mode
|
|
c marker specification mode
|
|
|
|
c cell array fill capability
|
|
integer COUTLN, CFILLD
|
|
parameter (COUTLN=0, CFILLD=1)
|
|
|
|
c cell array alignment
|
|
integer CAXIS, CSKEW
|
|
parameter (CAXIS=0, CSKEW=1)
|
|
|
|
c compound text capability
|
|
c and closed figure capability
|
|
integer CCNONE, CGLOBL, CLOCAL
|
|
parameter (CCNONE=0, CGLOBL=1, CLOCAL=2)
|
|
|
|
c pattern transformation support
|
|
|
|
c color selection mode availability
|
|
integer CCLRI, CCLRID
|
|
parameter (CCLRI=0, CCLRID=1)
|
|
|
|
c color overwrite capability
|
|
|
|
c response validity
|
|
integer CINVAL, CVAL
|
|
parameter (CINVAL= 0, CVAL= 1)
|
|
|
|
c input class
|
|
|
|
c request status
|
|
|
|
c input device state
|
|
|
|
c direction
|
|
integer CINCR, CDECR
|
|
parameter (CINCR= 0, CDECR= 1)
|
|
|
|
c action required flag
|
|
integer CNOACT, CACT
|
|
parameter (CNOACT= 0, CACT= 1)
|
|
|
|
c pixel validity flag
|
|
integer CVNONE, CVALL, CVSOME
|
|
parameter (CVNONE= 0, CVALL= 1, CVSOME= 2)
|
|
|
|
call cesc(XEMFNM,1,name)
|
|
return
|
|
end
|
|
|