1C*GIDRIV -- PGPLOT GIF drivers
2C+
3      SUBROUTINE GIDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE)
4      INTEGER IFUNC, NBUF, LCHR, MODE
5      REAL    RBUF(*)
6      CHARACTER*(*) CHR
7*
8* PGPLOT driver for Graphics Interchange Format (GIF) files.
9*
10************************************************************************
11*                           CAUTION                                    *
12*                                                                      *
13* The GIF specification incorporates the Lempel-Zev-Welch (LZW)        *
14* compression technology which is the subject of a patent awarded to   *
15* Unisys. Use of this technology, and in particular creation of GIF    *
16* format files using this PGPLOT device driver, may require a license  *
17* from Unisys.                                                         *
18************************************************************************
19*
20* Supported device: GIF87a file format
21*
22* Device type codes: /GIF or /VGIF
23*
24* Default device name: pgplot.gif.
25*
26* If you have more than one image to plot (i.e. use PGPAGE) with this
27* device, subsequent pages will be named: pgplot2.gif, pgplot3.gif,
28* etc, disrespective of the device name you specified.
29* You can however bypass this by specifying a device name including a
30* number sign (#), which will henceforth be replaced by the pagenumber.
31* Example: page#.gif will produce files page1.gif, page2.gif, ...,
32* page234.gif, etc.
33*
34* Default view surface dimensions are:
35* - GIF  : 850 x 680 pixels (translates to 10.0 x  8.0 inch).
36* - VGIF : 680 x 850 pixels (translates to  8.0 x 10.0 inch).
37* with an assumed scale of 85 pixels/inch.
38* Default width and height can be overridden by specifying environment
39* variables
40* PGPLOT_GIF_WIDTH  (default 850)
41* PGPLOT_GIF_HEIGHT (default 680)
42*
43* Color capability:
44* Indices 0 to 255 are supported. Each of these indices can be assigned
45* one color. Default colors for indices 0 to 15 are implemented.
46*
47* Obtaining hardcopy: Use a GIF viewer or converter.
48*=
49*  1-Aug-1994 - Created by Remko Scharroo
50*  9-Aug-1994 - New scheme for line plotting
51* 16-Aug-1994 - Provide multi-image plotting.
52*  8-Sep-1994 - Add opcode 29 [TJP].
53*  5-Nov-1994 - Adjust size of bitmap if necessary [TJP].
54* 18-Jan-1995 - Attempt to prevent integer overflow on systems where
55*               BYTE is signed [TJP].
56* 28-Dec-1995 - prevent concurrent access [TJP].
57* 29-Apr-1996 - use GRCTOI to decode environment variables [TJP].
58*  2-Sep-1997 - correct a byte overflow problem
59*-----------------------------------------------------------------------
60      CHARACTER*(*) LTYPE, PTYPE, DEFNAM
61      INTEGER DWD, DHT, BX, BY
62      PARAMETER (LTYPE=
63     1'GIF   (Graphics Interchange Format file, landscape orientation)',
64     2 PTYPE=
65     3'VGIF  (Graphics Interchange Format file, portrait orientation)')
66      PARAMETER (DEFNAM='pgplot.gif')
67      PARAMETER (DWD=850, DHT=680)
68
69      REAL XRES, YRES
70      PARAMETER (XRES=85., YRES=XRES)
71C
72      INTEGER UNIT, IC, NPICT, MAXIDX, STATE
73      INTEGER CTABLE(3,0:255), CDEFLT(3,0:15)
74      INTEGER IER, I, L, LL, IX0, IY0, IX1, IY1, USERW, USERH, JUNK
75      INTEGER GRGMEM, GRFMEM, GROFIL, GRCFIL, GRCTOI
76      CHARACTER*80 MSG, INSTR, FILENM
77C
78C Note: for 64-bit operating systems, change the following
79C declaration to INTEGER*8:
80C
81      INTEGER*8 PIXMAP, WORK
82C
83      SAVE UNIT, IC, CTABLE, NPICT, MAXIDX, BX, BY, PIXMAP, FILENM
84      SAVE CDEFLT, STATE
85      DATA CDEFLT /000,000,000, 255,255,255, 255,000,000, 000,255,000,
86     1             000,000,255, 000,255,255, 255,000,255, 255,255,000,
87     2             255,128,000, 128,255,000, 000,255,128, 000,128,255,
88     3             128,000,255, 255,000,128, 085,085,085, 170,170,170/
89      DATA STATE /0/
90C-----------------------------------------------------------------------
91C
92      GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,
93     1     110,120,130,140,150,160,170,180,190,200,
94     2     210,220,230,240,250,260,270,280,290), IFUNC
95  900 WRITE (MSG,'(I10)') IFUNC
96      CALL GRWARN('Unimplemented function in GIF device driver:'
97     1    //MSG)
98      NBUF = -1
99      RETURN
100C
101C--- IFUNC = 1, Return device name -------------------------------------
102C
103   10 IF (MODE.EQ.1) THEN
104         CHR = LTYPE
105         LCHR = LEN(LTYPE)
106      ELSE IF (MODE.EQ.2) THEN
107         CHR = PTYPE
108         LCHR = LEN(PTYPE)
109      ELSE
110         CALL GRWARN('Requested MODE not implemented in GIF driver')
111      END IF
112      RETURN
113C
114C--- IFUNC = 2, Return physical min and max for plot device, and range
115C               of color indices ---------------------------------------
116C     (Maximum size is set by GIF format to 2**16 pixels)
117   20 RBUF(1) = 0
118      RBUF(2) = 65536
119      RBUF(3) = 0
120      RBUF(4) = 65536
121      RBUF(5) = 0
122      RBUF(6) = 255
123      NBUF = 6
124      RETURN
125C
126C--- IFUNC = 3, Return device resolution -------------------------------
127C
128   30 RBUF(1) = XRES
129      RBUF(2) = YRES
130      RBUF(3) = 1
131      NBUF = 3
132      RETURN
133C
134C--- IFUNC = 4, Return misc device info --------------------------------
135C    (This device is Hardcopy, supports rectangle fill, pixel
136C     primitives, and query color rep.)
137C
138   40 CHR = 'HNNNNRPNYN'
139      LCHR = 10
140      RETURN
141C
142C--- IFUNC = 5, Return default file name -------------------------------
143C
144   50 CHR = DEFNAM
145      LCHR = LEN(DEFNAM)
146      RETURN
147C
148C--- IFUNC = 6, Return default physical size of plot -------------------
149C
150   60 RBUF(1) = 0
151      RBUF(2) = BX-1
152      RBUF(3) = 0
153      RBUF(4) = BY-1
154      NBUF = 4
155      RETURN
156C
157C--- IFUNC = 7, Return misc defaults -----------------------------------
158C
159   70 RBUF(1) = 1
160      NBUF=1
161      RETURN
162C
163C--- IFUNC = 8, Select plot --------------------------------------------
164C
165   80 CONTINUE
166      RETURN
167C
168C--- IFUNC = 9, Open workstation ---------------------------------------
169C
170   90 CONTINUE
171C     -- check for concurrent access
172      IF (STATE.EQ.1) THEN
173         CALL GRWARN('a PGPLOT GIF file is already open')
174         RBUF(1) = 0
175         RBUF(2) = 0
176         RETURN
177      END IF
178C     -- dimensions of plot buffer
179      USERW = 0
180      USERH = 0
181      CALL GRGENV('GIF_WIDTH', INSTR, L)
182      LL = 1
183      IF (L.GT.0) USERW = GRCTOI(INSTR(:L),LL)
184      CALL GRGENV('GIF_HEIGHT', INSTR, L)
185      LL = 1
186      IF (L.GT.0) USERH = GRCTOI(INSTR(:L),LL)
187      IF (MODE.EQ.1) THEN
188*     -- Landscape
189         BX = DWD
190         IF (USERW.GE.8) BX = USERW
191         BY = DHT
192         IF (USERH.GE.8) BY = USERH
193      ELSE
194*     -- Portrait
195         BX = DHT
196         IF (USERH.GE.8) BX = USERH
197         BY = DWD
198         IF (USERW.GE.8) BY = USERW
199      END IF
200      NPICT=1
201      MAXIDX=0
202*     -- Initialize color table
203      DO 95 I=0,15
204         CTABLE(1,I) = CDEFLT(1,I)
205         CTABLE(2,I) = CDEFLT(2,I)
206         CTABLE(3,I) = CDEFLT(3,I)
207 95   CONTINUE
208      DO 96 I=16,255
209         CTABLE(1,I) = 128
210         CTABLE(2,I) = 128
211         CTABLE(3,I) = 128
212 96   CONTINUE
213*
214      FILENM = CHR(:LCHR)
215      CALL GRGI10 (FILENM, NPICT, MSG)
216      UNIT = GROFIL (MSG)
217      RBUF(1) = UNIT
218      IF (UNIT.LT.0) THEN
219         CALL GRWARN('Cannot open output file for GIF plot')
220         RBUF(2) = 0
221      ELSE
222         RBUF(2) = 1
223         STATE = 1
224      END IF
225      RETURN
226C
227C--- IFUNC=10, Close workstation ---------------------------------------
228C
229  100 CONTINUE
230      STATE = 0
231      RETURN
232C
233C--- IFUNC=11, Begin picture -------------------------------------------
234C
235  110 CONTINUE
236      BX = NINT(RBUF(1))+1
237      BY = NINT(RBUF(2))+1
238      IER = GRGMEM(BX*BY, PIXMAP)
239      IF (IER.NE.1) THEN
240         CALL GRGMSG(IER)
241         CALL GRWARN('Failed to allocate plot buffer.')
242         BX = 0
243         BY = 0
244         PIXMAP = 0
245      END IF
246C     -- initialize to zero (background color)
247      IF (PIXMAP.NE.0)
248     :     CALL GRGI03(1, 1, BX, BY, 0, BX, BY, %VAL(PIXMAP))
249      IF (NPICT.GT.1) THEN
250         CALL GRGI10 (FILENM, NPICT, MSG)
251         UNIT = GROFIL(MSG)
252         IF (UNIT.LT.0) THEN
253            CALL GRWARN('Cannot open output file for GIF plot')
254         END IF
255      END IF
256      RETURN
257C
258C--- IFUNC=12, Draw line -----------------------------------------------
259C
260  120 CONTINUE
261      IX0=NINT(RBUF(1))+1
262      IX1=NINT(RBUF(3))+1
263      IY0=BY-NINT(RBUF(2))
264      IY1=BY-NINT(RBUF(4))
265      IF (PIXMAP.NE.0)
266     :     CALL GRGI01(IX0, IY0, IX1, IY1, IC, BX, BY, %VAL(PIXMAP))
267      RETURN
268C
269C--- IFUNC=13, Draw dot ------------------------------------------------
270C
271  130 CONTINUE
272      IX0=NINT(RBUF(1))+1
273      IY0=BY-NINT(RBUF(2))
274      IF (PIXMAP.NE.0)
275     :     CALL GRGI01(IX0, IY0, IX0, IY0, IC, BX, BY, %VAL(PIXMAP))
276      RETURN
277C
278C--- IFUNC=14, End picture ---------------------------------------------
279C
280  140 CONTINUE
281      IF (UNIT.GE.0) THEN
282         IER = GRGMEM(2*256*4098, WORK)
283         IF (IER.NE.1) THEN
284            CALL GRGMSG(IER)
285            CALL GRWARN('Failed to allocate work array.')
286         ELSE
287            CALL GRGI06(UNIT, BX, BY, CTABLE, %VAL(PIXMAP), MAXIDX,
288     :                  %VAL(WORK))
289         END IF
290         JUNK = GRCFIL(UNIT)
291         IER = GRFMEM(2*256*4098, WORK)
292      END IF
293      NPICT = NPICT+1
294      IER = GRFMEM(BX*BY, PIXMAP)
295      IF (IER.NE.1) THEN
296         CALL GRGMSG(IER)
297         CALL GRWARN('Failed to deallocate plot buffer.')
298      END IF
299      RETURN
300C
301C--- IFUNC=15, Select color index --------------------------------------
302C
303  150 CONTINUE
304      IC = RBUF(1)
305      MAXIDX = MAX(MAXIDX, IC)
306      RETURN
307C
308C--- IFUNC=16, Flush buffer. -------------------------------------------
309C    (Not used.)
310C
311  160 CONTINUE
312      RETURN
313C
314C--- IFUNC=17, Read cursor. --------------------------------------------
315C    (Not implemented: should not be called)
316C
317  170 CONTINUE
318      GOTO 900
319C
320C--- IFUNC=18, Erase alpha screen. -------------------------------------
321C    (Not implemented: no alpha screen)
322C
323  180 CONTINUE
324      RETURN
325C
326C--- IFUNC=19, Set line style. -----------------------------------------
327C    (Not implemented: should not be called)
328C
329  190 CONTINUE
330      GOTO 900
331C
332C--- IFUNC=20, Polygon fill. -------------------------------------------
333C    (Not implemented: should not be called)
334C
335  200 CONTINUE
336      GOTO 900
337C
338C--- IFUNC=21, Set color representation. -------------------------------
339C
340  210 CONTINUE
341      I = RBUF(1)
342      CTABLE(1, I) = NINT(RBUF(2)*255)
343      CTABLE(2, I) = NINT(RBUF(3)*255)
344      CTABLE(3, I) = NINT(RBUF(4)*255)
345      RETURN
346C
347C--- IFUNC=22, Set line width. -----------------------------------------
348C    (Not implemented: should not be called)
349C
350  220 CONTINUE
351      GOTO 900
352C
353C--- IFUNC=23, Escape --------------------------------------------------
354C    (Not implemented: ignored)
355C
356  230 CONTINUE
357      RETURN
358C
359C--- IFUNC=24, Rectangle fill ------------------------------------------
360C
361  240 CONTINUE
362      IX0=NINT(RBUF(1))+1
363      IX1=NINT(RBUF(3))+1
364      IY1=BY-NINT(RBUF(2))
365      IY0=BY-NINT(RBUF(4))
366      IF (PIXMAP.NE.0)
367     :     CALL GRGI03(IX0, IY0, IX1, IY1, IC, BX, BY, %VAL(PIXMAP))
368      RETURN
369C
370C--- IFUNC=25, Not implemented -----------------------------------------
371C
372  250 CONTINUE
373      RETURN
374C
375C--- IFUNC=26, Line of pixels ------------------------------------------
376C
377  260 CONTINUE
378      CALL GRGI04(NBUF, RBUF, BX, BY, %VAL(PIXMAP), MAXIDX)
379      RETURN
380C
381C--- IFUNC=27, Not implemented -----------------------------------------
382C
383  270 CONTINUE
384      RETURN
385C
386C--- IFUNC=28, Not implemented -----------------------------------------
387C
388  280 CONTINUE
389      RETURN
390C
391C--- IFUNC=29, Query color representation. -----------------------------
392C
393  290 CONTINUE
394      I = RBUF(1)
395      RBUF(2) = CTABLE(1,I)/255.0
396      RBUF(3) = CTABLE(2,I)/255.0
397      RBUF(4) = CTABLE(3,I)/255.0
398      NBUF = 4
399      RETURN
400C-----------------------------------------------------------------------
401      END
402
403**GRGI01 -- PGPLOT GIF driver, draw line
404*+
405      SUBROUTINE GRGI01 (IX0, IY0, IX1, IY1, ICOL, BX, BY, PIXMAP)
406      INTEGER IX0, IY0, IX1, IY1
407      INTEGER ICOL, BX, BY
408      BYTE PIXMAP(BX,BY)
409*
410* Draw a straight-line segment from absolute pixel coordinates
411* (IX0, IY0) to (IX1, IY1).
412*
413* Arguments:
414*  ICOL            (input): Color index
415*  PIXMAP   (input/output): The image data buffer.
416*-----------------------------------------------------------------------
417      INTEGER IX, IY, IS
418      REAL    D
419      BYTE    VAL
420*
421      IF (ICOL.GT.127) THEN
422         VAL = ICOL-256
423      ELSE
424         VAL = ICOL
425      END IF
426      IF (IX0.EQ.IX1 .AND. IY0.EQ.IY1) THEN
427         PIXMAP(IX0,IY0)=VAL
428      ELSE IF (ABS(IY1-IY0).GT.ABS(IX1-IX0)) THEN
429         D=(IX1-IX0)/REAL(IY1-IY0)
430         IS=1
431         IF (IY1.LT.IY0) IS=-1
432         DO 10 IY=IY0,IY1,IS
433            IX=NINT(IX0+(IY-IY0)*D)
434            PIXMAP(IX,IY)=VAL
435 10      CONTINUE
436      ELSE
437         D=(IY1-IY0)/REAL(IX1-IX0)
438         IS=1
439         IF (IX1.LT.IX0) IS=-1
440         DO 20 IX=IX0,IX1,IS
441            IY=NINT(IY0+(IX-IX0)*D)
442            PIXMAP(IX,IY)=VAL
443 20      CONTINUE
444      END IF
445      END
446
447**GRGI03 -- PGPLOT GIF driver, fill rectangle
448*+
449      SUBROUTINE GRGI03 (IX0, IY0, IX1, IY1, ICOL, BX, BY, PIXMAP)
450      INTEGER IX0, IY0, IX1, IY1
451      INTEGER ICOL, BX, BY
452      BYTE PIXMAP(BX,BY)
453*
454* Arguments:
455*  IX0, IY0        (input): Lower left corner.
456*  IX1, IY1        (input): Upper right corner.
457*  ICOL            (input): Color value.
458*  BX, BY          (input): dimensions of PIXMAP.
459*  PIXMAP   (input/output): The image data buffer.
460*-----------------------------------------------------------------------
461      INTEGER IX, IY
462      BYTE VAL
463C
464      IF (ICOL.GT.127) THEN
465         VAL = ICOL-256
466      ELSE
467         VAL = ICOL
468      END IF
469      DO 20 IY=IY0,IY1
470         DO 10 IX=IX0,IX1
471            PIXMAP(IX,IY) = VAL
472 10      CONTINUE
473 20   CONTINUE
474      END
475
476**GRGI04 -- PGPLOT GIF driver, fill image line
477*+
478      SUBROUTINE GRGI04(NBUF,RBUF,BX,BY,PIXMAP,MAXIDX)
479      INTEGER I,J,NBUF,BX,BY,N,IC,MAXIDX
480      REAL RBUF(NBUF)
481      BYTE PIXMAP(BX,BY)
482*-
483      I = NINT(RBUF(1))+1
484      J = BY-NINT(RBUF(2))
485      DO 10 N=3,NBUF
486         IC=RBUF(N)
487         MAXIDX=MAX(MAXIDX,IC)
488         IF (IC.GT.127) IC = IC-256
489         PIXMAP(I+N-3,J)=IC
490 10   CONTINUE
491      END
492
493**GRGI06 -- PGPLOT GIF driver, write GIF image
494*+
495      SUBROUTINE GRGI06 (UNIT, BX, BY, CTABLE, PIXMAP, MAXIDX, CODE)
496      INTEGER UNIT, BX, BY, MAXIDX
497      INTEGER CTABLE(3,0:255)
498      BYTE PIXMAP(BX * BY)
499      INTEGER*2 CODE(0:4097,0:255)
500*
501* Write GIF image to UNIT.
502*
503* Arguments:
504* UNIT   (input): Output unit
505* BX,BY  (input): `Screen' size
506* CTABLE  (input): Color map
507* PIXMAP (input): Image data
508* MAXIDX (input): maximum color index used.
509*--
510* 16-Nov-94: fixed bug (BYTE is signed)
511*-----------------------------------------------------------------------
512      CHARACTER GIF1*6, GIF2*7, GIF3*3, GIF4*10
513      CHARACTER*2 GRGI09
514      INTEGER BMAX, BMULT, BREST, BOUT
515      INTEGER PIXEL, I, J, K, M, CLEAR, EOI, TABLE, IN, TOTAL, PRE, EXT
516      INTEGER OLDPRE, BITS
517      INTEGER GRWFCH, GRWFIL
518      BYTE BLKOUT(0:254)
519      COMMON /GRGICO/ BMAX, BMULT, BREST, BOUT, BLKOUT
520
521      BITS = 1
522 10   IF (MAXIDX .LT. 2**BITS) GOTO 20
523      BITS = BITS + 1
524      GOTO 10
525 20   CONTINUE
526*
527* Write Header.
528*
529      GIF1 = 'GIF87a'
530      I = GRWFCH(UNIT, GIF1)
531      IF (I.NE.6) CALL GRWARN ('Error writing GIF header')
532*
533* Write Logical Screen Descriptor (screen width, screen height,
534* color data, background color index [0], pixel aspect ratio [0]).
535*
536      GIF2(1:2) = GRGI09(BX)
537      GIF2(3:4) = GRGI09(BY)
538      GIF2(5:5) = CHAR(128 + 17 * (BITS - 1))
539      GIF2(6:6) = CHAR(0)
540      GIF2(7:7) = CHAR(0)
541      I = GRWFCH(UNIT, GIF2)
542*
543* Write Global Color Table.
544*
545      DO 30 J=0,2**BITS-1
546         GIF3(1:1) = CHAR(CTABLE(1,J))
547         GIF3(2:2) = CHAR(CTABLE(2,J))
548         GIF3(3:3) = CHAR(CTABLE(3,J))
549         I = GRWFCH(UNIT, GIF3)
550 30   CONTINUE
551*
552      PIXEL = MAX(BITS, 2)
553*
554* Write Image Descriptor.
555*
556      GIF4(1:1) = ','
557      GIF4(2:3) = GRGI09(0)
558      GIF4(4:5) = GRGI09(0)
559      GIF4(6:7) = GRGI09(BX)
560      GIF4(8:9) = GRGI09(BY)
561      GIF4(10:10) = CHAR(0)
562      I = GRWFCH(UNIT, GIF4)
563*
564* Write Table Based Image Data, in sub-blocks of up to 255 bytes.
565*
566      I = GRWFCH(UNIT, CHAR(PIXEL))
567C
568C LZW-compression; initialize counters; define clear code and EOI code.
569C Start packing variable-size codes into 8-bit bytes.
570C Push a clear code first.
571C `Read' first character.
572C
573      DO 100 M=0,255
574         DO 100 K=0,4095
575  100       CODE(K,M)=0
576      CLEAR=2**PIXEL
577      EOI=CLEAR + 1
578      BREST=0
579      BOUT=0
580      BMULT=1
581      BMAX=CLEAR*2
582      CALL GRGI07(UNIT, CLEAR)
583      IN=1
584      TOTAL=BX*BY
585      PRE=PIXMAP(IN)
586      IF (PRE.LT.0) PRE = PRE+256
587*
588* Start new data stream at line 310:
589* 2**n-1  (n+1)-bit codes
590* 2*2**n  (n+2)-bit codes
591* 4*2**n  (n+3)-bit codes
592*    .         .      .
593*   1024     11-bit codes
594*   2048     12-bit codes (incl. one clear code)
595*
596  310 TABLE=EOI
597      BMAX=CLEAR*2
598*
599* `Read' next character; check if combination prefix&extension occurred earlier
600*
601  320 IF (IN.GE.TOTAL) GOTO 350
602      IN=IN+1
603      EXT=PIXMAP(IN)
604      IF (EXT.LT.0) EXT = EXT+256
605      OLDPRE=PRE
606      PRE=CODE(PRE,EXT)
607      IF (PRE.GT.0) GOTO 320
608*
609* If no earlier occurrence add combination to table
610*
611      TABLE=TABLE+1
612      CALL GRGI07(UNIT, OLDPRE)
613      CODE(OLDPRE,EXT)=TABLE
614      PRE=EXT
615      IF (TABLE.EQ.BMAX) BMAX=BMAX*2
616      IF (TABLE.LT.4095) GOTO 320
617      CALL GRGI07(UNIT, CLEAR)
618      DO 330 M=0,255
619         DO 330 K=0,4095
620  330       CODE(K,M)=0
621      GOTO 310
622*
623* Last character
624*
625  350 CALL GRGI07(UNIT, PRE)
626      CALL GRGI07(UNIT, EOI)
627      IF (BMULT.GT.1) CALL GRGI08(UNIT, BREST)
628      IF (BOUT.GT.0) THEN
629         IF (BOUT.GT.127) THEN
630            BLKOUT(0) = BOUT-256
631         ELSE
632            BLKOUT(0) = BOUT
633         END IF
634         I = GRWFIL (UNIT, BOUT+1, BLKOUT(0))
635         BOUT = 0
636      END IF
637      BLKOUT(0) = 0
638      I = GRWFIL (UNIT, 1, BLKOUT(0))
639*
640* Write GIF Trailer.
641*
642      I = GRWFCH (UNIT, ';')
643      END
644
645**GRGI07 -- Compile GIF output code
646*
647      SUBROUTINE GRGI07(UNIT, INCODE)
648      INTEGER UNIT, INCODE
649      INTEGER BMAX, BMULT, BREST, BOUT
650      BYTE BLKOUT(0:254)
651      COMMON /GRGICO/ BMAX, BMULT, BREST, BOUT, BLKOUT
652C
653      BREST = BREST + BMULT * INCODE
654      BMULT = BMULT * BMAX
655C
656   10 IF (BMULT .LT. 256) RETURN
657      CALL GRGI08(UNIT, BREST)
658      BREST = BREST / 256
659      BMULT = BMULT / 256
660      GOTO 10
661C
662      END
663
664**GRGI08 -- Compile and write GIF output buffer
665*
666      SUBROUTINE GRGI08(UNIT, INCODE)
667      INTEGER UNIT, INCODE, I, J, GRWFIL
668      INTEGER BMAX, BMULT, BREST, BOUT
669      BYTE BLKOUT(0:254)
670      COMMON /GRGICO/ BMAX, BMULT, BREST, BOUT, BLKOUT
671C
672      BOUT = BOUT + 1
673      J = MOD(INCODE,256)
674      IF (J.GT.127) J = J-256
675      BLKOUT(BOUT) = J
676      IF (BOUT .LT. 254) RETURN
677C!        changed 1997-Sep-2
678      BLKOUT(0) = 254-256
679      I = GRWFIL(UNIT, 255, BLKOUT(0))
680      BOUT = 0
681      END
682
683**GRGI09 -- Encode integer in 2-char string
684*
685      CHARACTER*2 FUNCTION GRGI09(I)
686      INTEGER I
687      INTEGER I1, I2
688*
689      I1 = MOD(I,256)
690      I2 = MOD(I/256,256)
691      GRGI09(1:1) = CHAR(I1)
692      GRGI09(2:2) = CHAR(I2)
693      END
694
695**GRGI10 -- Replace # in filename by picture number
696*
697      SUBROUTINE GRGI10 (NAME1, NP, NAME2)
698      CHARACTER*(*) NAME1
699      CHARACTER*(*) NAME2
700      CHARACTER*80  TMP
701      INTEGER GRTRIM
702      INTEGER NP, IDX, L, LN
703
704      LN = GRTRIM(NAME1)
705      IDX = INDEX(NAME1,'#')
706      IF (IDX.GT.0) THEN
707C        -- if the supplied name contains a #-character, replace
708C           it with the page number
709         CALL GRFAO(NAME1, L, TMP, NP, 0, 0, 0)
710      ELSE IF (NP.EQ.1) THEN
711C        -- if this is the first page, use the supplied name
712         NAME2 = NAME1
713         RETURN
714      ELSE IF (LN+2.LE.LEN(NAME1)) THEN
715C        -- append an underscore and the page number to the supplied
716C           name
717         NAME1(LN+1:LN+2) = '_#'
718         CALL GRFAO(NAME1, L, TMP, NP, 0, 0, 0)
719      ELSE
720C        -- last resort: invent a new name
721         CALL GRFAO('pgplot#.gif', L, TMP, NP, 0, 0, 0)
722      END IF
723      CALL GRWARN ('Writing new GIF image as: '//TMP(:L))
724      NAME2 = TMP(:L)
725      END
726