; $Id: read_gif.pro,v 1.11 1999/05/28 16:38:40 ali Exp $
;
; Copyright (c) 1992-1999, Research Systems, Inc.  All rights reserved.
;       Unauthorized reproduction prohibited.

;
;  GifReadByte
;	Read a single byte out of the given file
;
FUNCTION GifReadByte, unit
	COMPILE_OPT hidden

	ch	= 0b
	READU, unit, ch
	RETURN, ch
END

PRO READ_GIF, FILE, IMAGE, R, G, B, MULTIPLE=mult, CLOSE=close
;
;+
; NAME:
;	READ_GIF
;
; PURPOSE:
;	Read the contents of a GIF format image file and return the image
;	and color table vectors (if present) in the form of IDL variables.
;
; CATEGORY:
;	Input/Output.
;
; CALLING SEQUENCE:
;	READ_GIF, File, Image [, R, G, B]
;
; INPUTS:
;	File:	Scalar string giving the name of the rasterfile to read
;
; Keyword Inputs:
;	CLOSE = if set, closes any open file and returns if the MULTIPLE images
;		per file mode was used.  This keyword is used
;		without additional parameters.
;	
;	MULTIPLE = if set, read files containing multiple images per
;		file.  Each call to READ_GIF returns the next image,
;		with the file remaining open between calls.  The File
;		parameter is ignored after the first call.  Reading
;		past the last image returns a scalar value of -1 in IMAGE, and
;		closes the file.  When reading the 2nd and subsequent
;		images, R, G, and B are not returned.
;
; OUTPUTS:
;	Image:	The 2D byte array to contain the image.
;
;
; OPTIONAL OUTPUT PARAMETERS:
;     R, G, B:	The variables to contain the Red, Green, and Blue color vectors
;		if the rasterfile containes colormaps.
;
; SIDE EFFECTS:
;	None.
;
; COMMON BLOCKS:
;	READ_GIF_COMMON.
; RESTRICTIONS:
;	This routine only reads in the first image in a file (the format
;	allows many). Local colormaps are not supported.
;	Only 8 bit images are supported.
;
;	The Graphics Interchange Format(c) is the Copyright property
;	of CompuServ Incorporated.  GIF(sm) is a Service Mark property of
;	CompuServ Incorporated. 
;
; EXAMPLE:
;	To open and read the GIF image file named "foo.gif" in the current
;	directory, store the image in the variable IMAGE1, and store the color
;	vectors in the variables R, G, and B, enter:
;
;		READ_GIF, "foo.gif", IMAGE1, R, G, B
;
;	To load the new color table and display the image, enter:
;
;		TVLCT, R, G, B
;		TV, IMAGE1
; 
; MODIFICATION HISTORY:
;	Written June 1992, JWG
;	Added GIF89a and interlaced format, Jan, 1995, DMS.
;	Added MULTIPLE and CLOSE, Aug, 1996.
;	
;-
;

;	Define GIF header (and screen descriptor)

COMMON READ_GIF_COMMON, unit, width, height

if n_elements(unit) eq 0 then unit = -1


on_error, 2		;Return to caller on errors
image  = -1		;No image read yet

if keyword_set(close) then begin
	if unit gt 0 then FREE_LUN, unit
	unit = -1
	return
	endif

h	= { 	magic:bytarr(6),				$
		width_lo:0b, width_hi:0b,			$
		height_lo:0b, height_hi:0b,			$
		screen_info:0b, background:0b, reserved:0b }

;	Image header declaration

ihdr	= { 	left:0, top:0,			$	; we read this but
		iwidth:0, iheight:0,		$	; mostly we ignore
		image_info:0b }				; its content

if keyword_set(mult) and unit gt 0 then goto, next_image
if unit gt 0 then free_lun, unit

OPENR, unit, file, /GET_LUN, /BLOCK, ERROR=i
if i ne 0 then message, 'Error occured opening file: '+file+'.'

READU, unit, h		;Read gif header

;	Check Magic in header: GIF87a or GIF89a.
gif	= STRING(h.magic[0:2])
vers = STRING(h.magic[3:5])

IF gif NE 'GIF' THEN BEGIN
	FREE_LUN, unit
	unit = -1
	MESSAGE, 'File ' + file + ' is not a GIF file.'
ENDIF

IF vers ne '87a' and vers ne '89a' then $
	MESSAGE, /INFO, 'GIF Version incompatible:'+vers+'.'

width	= h.width_hi * 256 + h.width_lo
height	= h.height_hi * 256 + h.height_lo

;	Find out how big the color map is

bits_per_pixel	= (h.screen_info AND 'F'X) + 1
color_map_size	= 2 ^ bits_per_pixel

;	Read in the colormap (optional)

IF (h.screen_info AND '80'X) NE 0 THEN BEGIN
	map	= BYTARR(3,color_map_size, /NOZERO)
	READU, unit, map
	map	= transpose(map)
	r	= map[*,0]
	g	= map[*,1]
	b	= map[*,2]
	ENDIF


;	Read the image description

next_image:  while 1 do begin		;Read till we get a terminator
  cmd = GifReadByte(unit)		;Loop thru commands in file.
  CASE STRING(cmd) OF

';':	BEGIN				; GIF trailer (0x3b)
	FREE_LUN, unit
	unit = -1
	return
	ENDCASE

',':	BEGIN				; Image description (0x2c)
	READU,unit,ihdr

	; Check for file formats we don't support
	; We don't support local colormaps

	if (ihdr.image_info AND '80'X) NE 0 THEN begin  ;Local color map
	   lcolor_map_size = 2^((ihdr.image_info and 7) + 1)
	   junk = bytarr(3, lcolor_map_size, /NOZERO)
	   readu, unit, junk
	   message,'Local colormaps ignored.', /CONTINUE
	   endif

	;	Allocate an array to hold the image
	image	= BYTARR(width, height, /NOZERO)

	;	Now call special GIF-LZW routine hidden within IDL
	;	to do the ugly serial bit stream decoding

	DECODE_GIF,unit,image		; magic
;		This should be the 0 byte that ends the series:
	dummy = GifReadByte(unit)	;Loop thru commands in file.
	if dummy ne 0 then message,/info,'No trailing 0.'

	;	Reorder rows in an interlaced image

	if (ihdr.image_info AND '40'X) NE 0 THEN BEGIN
	    l = lindgen(height)	;Row indices...
			;Giff interlace ordering
	    p = [l[where(l mod 8 eq 0)], l[where(l mod 8 eq 4)], $
		 l[where(l mod 4 eq 2)], l[where(l and 1)]]
	    image2 = bytarr(width, height, /NOZERO)
	    h1 = height-1
	    for i=0, h1 do image2[0, h1-p[i]] = image[*,h1-i]
	    image = temporary(image2)
	ENDIF
	if keyword_set(mult) then return	;Leave file open
		FREE_LUN, unit
		unit = -1
		RETURN
	ENDCASE

'!':	BEGIN				;Gif Extention block (ignored) (0x21)
	label = GifReadByte(unit)	;toss extension block label
	repeat begin			;read and ignore blkss
	  blk_size = GifReadByte(unit)	;block size
	  if blk_size ne 0 then begin
		junk = BYTARR(blk_size, /NOZERO)
		READU, unit, junk
		endif
	endrep until blk_size eq 0
	ENDCASE

ELSE:	message,'Unknown GIF keyword in ' + file + string(cmd, format='(2x,Z2)')
ENDCASE
endwhile

END