1C*GRSY00 -- initialize font definition
2C+
3      SUBROUTINE GRSY00
4C
5C This routine must be called once in order to initialize the tables
6C defining the symbol numbers to be used for ASCII characters in each
7C font, and to read the character digitization from a file.
8C
9C Arguments: none.
10C
11C Implicit input:
12C  The file with name specified in environment variable PGPLOT_FONT
13C  is read, if it is available.
14C  This is a binary file containing two arrays INDFON and BUFFER.
15C  The digitization of each symbol occupies a number of words in
16C  the INTEGER*2 array BUFFER; the start of the digitization
17C  for symbol number N is in BUFFER(INDFON(N)), where INDFON is an
18C  integer array of 3000 elements. Not all symbols 1...3000 have
19C  a representation; if INDFON(N) = 0, the symbol is undefined.
20C
21*  PGPLOT uses the Hershey symbols for two `primitive' operations:
22*  graph markers and text.  The Hershey symbol set includes several
23*  hundred different symbols in a digitized form that allows them to
24*  be drawn with a series of vectors (polylines).
25*
26*  The digital representation of all the symbols is stored in common
27*  block /GRSYMB/.  This is read from a disk file at run time. The
28*  name of the disk file is specified in environment variable
29*  PGPLOT_FONT.
30*
31* Modules:
32*
33* GRSY00 -- initialize font definition
34* GRSYDS -- decode character string into list of symbol numbers
35* GRSYMK -- convert marker number into symbol number
36* GRSYXD -- obtain the polyline representation of a given symbol
37*
38* PGPLOT calls these routines as follows:
39*
40* Routine          Called by
41*
42* GRSY00          GROPEN
43* GRSYDS          GRTEXT, GRLEN
44* GRSYMK          GRMKER,
45* GRSYXD          GRTEXT, GRLEN, GRMKER
46***********************************************************************
47C--
48C (2-Jan-1984)
49C 22-Jul-1984 - revise to use DATA statements [TJP].
50C  5-Jan-1985 - make missing font file non-fatal [TJP].
51C  9-Feb-1988 - change default file name to Unix name; overridden
52C               by environment variable PGPLOT_FONT [TJP].
53C 29-Nov-1990 - move font assignment to GRSYMK.
54C-----------------------------------------------------------------------
55      CHARACTER*(*) UNIX
56      PARAMETER  (UNIX='/usr/local/vlb/pgplot/grfont.dat')
57      INTEGER MAXCHR
58      PARAMETER (MAXCHR=3000)
59C
60      CHARACTER*128 FF
61      INTEGER    FNTFIL, I, IER, IREC, IS, K, NC3
62      INTEGER    L
63C
64      INTEGER*2  BUFFER(27000)
65      INTEGER    INDFON(3000), NC1, NC2
66      COMMON     /GRSYMB/ NC1, NC2, INDFON, BUFFER
67C
68C Read the font file. If an I/O error occurs, it is ignored; the
69C effect will be that all symbols will be undefined (treated as
70C blank spaces).
71C
72      CALL GRGENV('FONT', FF, L)
73      IF (L.EQ.0) THEN
74          FF = UNIX
75          L = LEN(UNIX)
76      END IF
77      CALL GRGLUN(FNTFIL)
78      IF(INDEX(FF(:L),'dat').GT.0) THEN
79         OPEN (UNIT=FNTFIL, FILE=FF(:L), FORM='UNFORMATTED',
80     2      STATUS='OLD', IOSTAT=IER)
81         IF (IER.EQ.0) READ (UNIT=FNTFIL, IOSTAT=IER)
82     1            NC1,NC2,NC3,INDFON,BUFFER
83         IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER)
84      ELSE
85         OPEN (UNIT=2, STATUS='OLD', FILE=FF(:L),
86     :      ACCESS='DIRECT', RECL=MAXCHR/4)
87         IREC=0
88         IS=1
89         READ(2, REC=IREC+1) (INDFON(K),K=IS,IS+MAXCHR/4-1)
90         IREC=IREC+1
91         IF(INDFON(1).NE.123) THEN
92            CALL GRWARN('Bad magic number in font file.')
93            IER=1
94            GOTO 190
95         END IF
96         NC1=INDFON(2)
97         NC2=INDFON(3)
98         IS=1
99         DO 140 I=1,4
100            READ(2, REC=IREC+1) (INDFON(K),K=IS,IS+MAXCHR/4-1)
101            IREC=IREC+1
102            IS=IS+MAXCHR/4
103  140    CONTINUE
104         IS=1
105         DO 160 I=1,18
106            READ(2, REC=IREC+1) (BUFFER(K),K=IS,IS+MAXCHR/2-1)
107            IREC=IREC+1
108            IS=IS+MAXCHR/2
109  160    CONTINUE
110      END IF
111C
112  190 CONTINUE
113      CALL GRFLUN(FNTFIL)
114      IF (IER.NE.0) CALL GRWARN('Unable to read font file: '//FF(:L))
115      RETURN
116      END
117