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