File: pgpack.f

package info (click to toggle)
pgplot5 5.2-13
  • links: PTS
  • area: non-free
  • in suites: potato
  • size: 6,280 kB
  • ctags: 5,903
  • sloc: fortran: 37,938; ansic: 18,809; sh: 1,147; objc: 532; makefile: 363; perl: 234; pascal: 233; tcl: 178; awk: 51; csh: 25
file content (120 lines) | stat: -rw-r--r-- 4,027 bytes parent folder | download | duplicates (15)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
      PROGRAM PACK
C-----------------------------------------------------------------------
C Convert unpacked (ASCII) representation of GRFONT into packed
C (binary) representation used by PGPLOT.
C
C This version ignores characters in the input file with Hershey
C numbers 1000-1999 ("indexical" fonts) and 3000-3999 ("triplex"
C and "gothic" fonts).
C
C The binary file contains one record, and is a direct copy of the
C internal data structure used in PGPLOT. The format of the internal
C data structure (and the binary file) are private to PGPLOT: i.e.,
C they may be changed in a future release.
C
C NC1   Integer*4       Smallest Hershey number defined in file (1)
C NC2   Integer*4       Largest Hershey number defined in file (3000)
C NC3   Integer*4       Number of words of buffer space used
C INDEX Integer*4 array (dimension 3000)
C                       Element NC of INDEX contains either 0 if
C                       NC is not a defined Hershey character, or the
C                       index in array BUFFER at which the digitization
C                       of character number NC begins
C BUFFER Integer*2 array (dimension 27000)
C                       Coordinate pairs defining each character are
C                       packed two to a word in this array.
C
C Note: the array sizes are fixed by dimension statements in PGPLOT.
C New characters cannot be added if they would increase the size of
C the arrays.  Array INDEX is not very efficiently used as only about
C 1000 of the possible 3000 characters are defined.
C-----------------------------------------------------------------------
      INTEGER MAXCHR, MAXBUF
      PARAMETER (MAXCHR=3000)
      PARAMETER (MAXBUF=27000)
C
      INTEGER   INDEX(MAXCHR), IHEAD(MAXCHR/4)
      INTEGER*2 BUFFER(MAXBUF)
      INTEGER   I, IREC, IS, K, LENGTH, LOC
      INTEGER   NC, NC1, NC2, NCHAR, XYGRID(400)
C-----------------------------------------------------------------------
 1000 FORMAT (7(2X,2I4))
 2000 FORMAT (' Characters defined: ', I5/
     1        ' Array cells used:   ', I5)
 3000 FORMAT (' ++ERROR++ Buffer is too small: ',I7)
C-----------------------------------------------------------------------
C
C Initialize index.
C
      DO 1 I=1,MAXCHR
          INDEX(I) = 0
    1 CONTINUE
      LOC = 0
      NCHAR = 0
C
C Open stdin.
C
C Read input file.
C
   10 CONTINUE
C         -- read next character
          READ (*,1000,END=20) NC,LENGTH,(XYGRID(I),I=1,5)
          READ (*,1000) (XYGRID(I),I=6,LENGTH)
C         -- skip if Hershey number is outside required range
          IF (NC.LT.1 .OR. (NC.GT.999.AND.NC.LT.2000) .OR.
     1        NC.GT.2999) GOTO 10
C         -- store in index and buffer
          NCHAR = NCHAR+1
          LOC = LOC+1
          IF (LOC.GT.MAXBUF) GOTO 500
          INDEX(NC) = LOC
          BUFFER(LOC) = XYGRID(1)
          DO 15 I=2,LENGTH,2
              LOC = LOC + 1
              IF (LOC.GT.MAXBUF) GOTO 500
              BUFFER(LOC) = 128*(XYGRID(I)+64) + XYGRID(I+1) + 64
   15     CONTINUE
      GOTO 10
   20 CONTINUE
C
C Write output file.
C
      OPEN (UNIT=2, STATUS='NEW', FILE='grfont.daf',
     :      ACCESS='DIRECT', RECL=MAXCHR/4)
C      NC1 = 1
C      NC2 = 3000
C      WRITE (2) NC1,NC2,LOC,INDEX,BUFFER
C      WRITE (2) NC1,NC2,LOC,INDEX
C      WRITE (2) (BUFFER(K),K=1,13500)
C      WRITE (2) (BUFFER(K),K=13501,27000)
C Magic number (to get byte swap)
      IHEAD(1)=123
      IHEAD(2)=1
      IHEAD(3)=3000
      IHEAD(4)=LOC
      IREC=1
      WRITE(2, REC=IREC) IHEAD
      IS=1
      DO 140 I=1,4
         WRITE(2, REC=IREC+1) (INDEX(K),K=IS,IS+MAXCHR/4-1)
         IREC=IREC+1
         IS=IS+MAXCHR/4
  140 CONTINUE
      IS=1
      DO 160 I=1,18
         WRITE(2, REC=IREC+1) (BUFFER(K),K=IS,IS+MAXCHR/2-1)
         IREC=IREC+1
         IS=IS+MAXCHR/2
  160 CONTINUE
      CLOSE (UNIT=2)
C
C Write summary.
C
      WRITE (6,2000) NCHAR, LOC
      STOP
C
C Error exit.
C
  500 WRITE (6,3000) MAXBUF
C-----------------------------------------------------------------------
      END