/* ---------------------------------------------------------------- */ /* GIFPARSE.REX */ /* Read and parse the contents of a GIF file */ /* Syntax: GIFPARSE giffile [outputfile] */ /* E.g.: GIFPARSE photo.gif photo.ini */ /* 19 Jul 1999 Rex Swain, Independent Consultant, www.rexswain.com */ /* ---------------------------------------------------------------- */ parse arg infile outfile /* ----- Verify Arguments ----------------------------------------- */ if infile = '' then call err 'Output file must be specified' if outfile = '' then outfile = 'gifparse.ini' /* Default output file */ if chars(outfile) > 0 then call err 'Output file already exists:' outfile n = chars(infile) if n = 0 then call err 'Input file not found:' infile say 'GifParse starting file "' || infile || '" ...' if n < 6 then call err 'File is too small to be a GIF file!' call append '[File]' call append 'File name =' infile call append 'File size =' n /* ----- Header (Signature & Version) (6 bytes) ------------------- */ s = charin(infile,1,3) v = charin(infile,,3) if s \== 'GIF' then call err 'Not a GIF file!' if v \== '87a' & v \== '89a' then call err 'Invalid GIF version!' call append '[Header]' call append 'Signature =' s call append 'Version =' v /* ----- Screen Descriptor (7 bytes) ------------------------------ */ call append '[Logical Screen Descriptor]' w = charin2d(infile,,2) call append 'Logical Screen Width =' w h = charin2d(infile,,2) call append 'Logical Screen Height =' h g = charin2b(infile,,1) /* To binary */ gctf = left(g,1) call append 'Global Color Table Flag =' gctf /* Color resolution */ /* This value represents the size of the entire palette from which */ /* the colors in the graphic were selected, not the number of */ /* colors actually used in the graphic. */ cr = substr(g,2,3) cr = 1 + b2d(cr) call append 'Color Resolution =' cr /* Sort flag */ q = substr(g,5,1) call append 'Sort Flag =' q /* Size of global color table */ gctz = substr(g,6,3) gctz = b2d(gctz) gctz = 2 ** (1+gctz) call append 'Size of Global Color Table =' gctz /* Background color index */ bg = charin2d(infile,,1) call append 'Background Color Index =' bg /* Pixel Aspect Ratio */ q = charin2d(infile,,1) call append 'Pixel Aspect Ratio =' q if q > 0 then call append '; Aspect Ratio:' (q+15)/64 /* ----- Global Color Table --------------------------------------- */ if gctf then do call append '[Global Color Table]' q = length(gctz-1) do i = 0 to gctz-1 rgb = charin(infile,,3) call append 'GCT' right(i,q) '=' c2x2(rgb) end end /* ----- Extension Blocks and Image Descriptors ------------------- */ do until b = '3B' /* Until trailer */ b = charin2x(infile,,1) /* Next byte */ select when b = '21' then /* 21x = 033d = ! */ call extension /* Extension */ when b = '2C' then /* 2Cx = 044d = , */ call image /* Image Descriptor */ when b = '3B' then /* 3Bx = 059d = ; */ call trailer /* Trailer */ otherwise tilt end end say 'GifParse finished' EXIT /* ===== Block Subroutines ======================================== */ trailer: procedure expose outfile infile call append '[Trailer]' n = chars(infile) if n > 0 then do c = charin(infile,,n) call append '; Extraneous bytes remaining:' c2x2(c) end else call append '; No extraneous bytes remaining' return extension: procedure expose outfile infile call append '[Extension]' x = charin2x(infile,,1) /* Function Code */ call append 'Function Code =' x bd = '' do i = 1 z = charin2d(infile,,1) /* Block Size */ if z = 0 then leave call append 'Block' i 'Size =' z q = charin(infile,,z) /* Data */ call append 'Block' i 'Data =' c2x2(q) bd = bd || q end select when x = 'F9' then do call append '[Graphic Control Extension]' call gcx bd end when x = 'FE' then do call append '[Comment Extension]' call cx bd end when x = 'FF' then call append '[Application Extension]' otherwise call append '[Unknown Extension, Function Code' x || ']' end return gcx: procedure expose outfile /* Graphic Control Extension */ parse arg x /* 4 bytes */ g = substr(x,1,1) /* First byte */ g = c2b(g) q = substr(g,1,3) /* Reserved */ call append 'Reserved Bits =' q q = substr(g,4,3) /* Disposal method */ q = b2d(q) call append 'Disposal Method =' q q = substr(g,7,1) /* User input flag */ call append 'User Input Flag =' q q = substr(g,8,1) /* Transparent Color Flag */ call append 'Transparent Color Flag =' q g = substr(x,2,2) /* Second and third bytes */ q = c2d(reverse(g)) call append 'Delay time =' q /* 100th seconds */ g = substr(x,4,1) /* Fourth byte */ q = c2d(g) call append 'Transparent Color Index =' q return cx: procedure expose outfile /* Comment Extension */ parse arg x call append 'Comment Text =' x return image: procedure expose outfile infile call append '[Image Descriptor]' w = charin2d(infile,,2) h = charin2d(infile,,2) call append 'Image Left Origin =' w call append 'Image Top Origin =' h w = charin2d(infile,,2) h = charin2d(infile,,2) call append 'Image Width =' w call append 'Image Height =' h call append '; Pixels:' w*h g = charin2b(infile,,1) lct = substr(g,1,1) call append 'Local Color Table Flag =' lct /* 0=use global color map */ ilf = substr(g,2,1) call append 'Interlace Flag =' ilf /* 0=sequential, 1=interlaced */ q = substr(g,3,1) call append 'Sort Flag =' q q = substr(g,4,2) call append 'Reserved Bits =' q z = substr(g,6,3) z = b2d(z) z = 2 ** (1+z) z = z * lct call append 'Size of Local Color Table =' z /* ----- Local Color Table ---------------------------------------- */ if lct then do call append '[Local Color Table]' q = length(z-1) do i = 0 to z-1 rgb = charin(infile,,3) call append 'LCT' right(i,q) '=' c2x2(rgb) end end /* ----- Raster Data ---------------------------------------------- */ call append '[Raster Data]' cd = charin(infile,,1) /* First byte is code size */ call append 'Code Size =' c2d(cd) do i = 1 n = charin2d(infile,,1) /* Block byte count */ if n = 0 then leave bd = charin(infile,,n) call append 'Block' i 'data =' c2x2(bd) cd = cd || bd end t = length(cd) call append '; Compressed data:' t 'bytes' /* ----- Decompress ----------------------------------------------- */ call append '[Decompressed Raster Data]' dd = lzwd(cd) n = length(dd) call append '; Decompressed data:' n 'bytes' if n \= (w*h) then say '*** Oh oh -- wrong length --' n 'should be' w*h call append '; Decompressed/Compressed Ratio:' format(n/t,,1) q = length(h) do i = 1 to h r = substr(dd,1+w*(i-1),w) call append 'Row' right(i,q) '=' c2x2(r) end /* ----- Uninterlace ---------------------------------------------- */ if ilf then do call append '[Uninterlaced Raster Data]' dd = uninterlace(dd,w,h) q = length(h) do i = 1 to h r = substr(dd,1+w*(i-1),w) call append 'Row' right(i,q) '=' c2x2(r) end end return /* End of image() */ /* ===== Misc Subroutines ========================================= */ append: procedure expose outfile /* Say to outfile */ parse arg a call lineout outfile,a if left(a,1) = '[' then say a /* Show progress on console */ return err: procedure /* Error */ parse arg a say 'GifParse error:' a say 'GifParse finished' EXIT charin2d: procedure /* charin() to decimal */ parse arg file,,bytes c = charin(file,,bytes) c = reverse(c) /* In case bytes > 1 */ d = c2d(c) return d charin2b: procedure /* charin() to binary */ parse arg file,,bytes c = charin(file,,bytes) b = x2b(c2x(c)) /* c2b() */ return b charin2x: procedure /* charin() to hex */ parse arg file,,bytes c = charin(file,,bytes) x = c2x(c) return x b2d: procedure parse arg a return x2d(b2x(a)) c2b: procedure parse arg a return x2b(c2x(a)) c2x2: procedure /* Char to Hex, 2 digits */ parse arg in c = substr(in,1,1) r = c2x(c) n = length(in) do i = 2 to n c = substr(in,i,1) r = r c2x(c) end return r d2x2: procedure /* Dec to Hex, 2 digits */ parse arg d x = d2x(d) if 1 = length(x) // 2 then x = '0' || x return x /* ===== Un-Interlacing =========================================== */ uninterlace: procedure /* Un-interlace the rows of a GIF image */ /* Syntax: out = uninterlace(in,width,height) */ /* Arguments: */ /* in: raster data stream, after LZW decompression (char string) */ /* width: image width in pixels (integer) */ /* height: image height in pixels (integer) */ /* Returns un-shuffled raster data stream */ /* Coded for clarity, not speed! */ /* 18 Jun 1999 Rex Swain, Independent Consultant, www.rexswain.com */ parse arg in, w, h h = h - 1 /* We will use origin 0 here */ p = 1 /* Row pointer for substr() */ do r = 0 to h by 8 /* Pass 1: Every 8th row, starting with row 0 */ out.r = substr(in,p,w) ; p = p + w ; end do r = 4 to h by 8 /* Pass 2: Every 8th row, starting with row 4 */ out.r = substr(in,p,w) ; p = p + w ; end do r = 2 to h by 4 /* Pass 3: Every 4th row, starting with row 2 */ out.r = substr(in,p,w) ; p = p + w ; end do r = 1 to h by 2 /* Pass 4: Every 2nd row, starting with row 1 */ out.r = substr(in,p,w) ; p = p + w ; end out = '' /* Initialize result */ do r = 0 to h out = out || out.r end return out /* ===== LZW Decompression ======================================== */ lzwd: procedure /* LZW decompression for a GIF image */ /* Syntax: out = lzwd(in) */ /* Argument is the Table Based Image Data stream, */ /* including the first byte (the LZW Minimum Code Size), */ /* but not including the Block Size bytes */ /* I.e., while parsing a GIF file, once at the raster data... */ /* in = charin(gif,,1) /* Code size */ */ /* do forever */ /* b = charin(gif,,1) /* Byte count */ */ /* b = c2d(b) */ /* if n = 0 then leave */ /* in = in || charin(gif,,b) */ /* end */ /* out = lzwd(in) */ /* Returns expanded string of bytes (pointers into color table) */ /* For GIF, we use character strings for both input and output */ /* We assume a leading "clear" code (as called for in the spec) */ /* Requires no subroutines */ /* Warning: LZW compression is apparently patented by Unisys */ /* 21 Jun 1999 Rex Swain, Independent Consultant, www.rexswain.com */ parse arg in bits = left(in,1) /* First byte: code size */ bits = c2d(bits) /* Convert it to decimal */ tsz = 2 ** bits /* Initial table size */ do i = 0 to tsz-1 /* Initialize the table */ tab.i = d2c(i) end clr = tsz /* Clear code */ eoi = tsz + 1 /* End Of Information code */ csz = bits + 1 /* Initial code size */ in = reverse(in) /* Reverse entire data stream */ in = x2b(c2x(in)) /* Convert to bits (c2b) */ ptr = 1 + length(in) /* Pointer into input stream */ ptr = ptr - 8 /* Skip the code size byte */ out = '' /* Initialize output stream */ buf = '' /* For a little speed-up */ do forever /* Not really! */ ptr = ptr - csz /* Shift pointer left */ new = substr(in,ptr,csz) /* Get next code (bits) */ new = x2d(b2x(new)) /* Convert to decimal (b2d) */ if new = clr then do /* Clear? */ nxt = tsz + 2 /* Next available code value */ csz = bits + 1 /* Initial code size */ max = 2 ** csz /* Initial code limit */ first = 1 /* Special-case first code */ iterate /* Next code */ end if new = eoi then /* End Of Information? */ leave /* Bail out of do forever */ if first then do /* Special-case first code */ str = tab.new /* Fetch from table */ out = out || str /* Add to output */ old = str /* And now we have an old */ first = 0 /* Skip this until next clear */ iterate /* Next code */ end if new < nxt then do /* Is code already in table? */ str = tab.new /* To add to output */ tab.nxt = old || left(str,1) /* Add to table */ end else do /* Code is not in table */ str = old || left(old,1) /* To add to output */ tab.nxt = str /* Add to table */ end out = out || str /* Append to result */ old = str /* Remember for next */ nxt = nxt + 1 /* Bump table pointer */ if nxt = max then do /* Reached code table limit? */ if csz < 12 then do /* 12 is maximum code size */ csz = csz + 1 /* Bump code size */ max = 2 ** csz /* New code limit */ end buf = buf || out /* Move to buffer */ out = '' /* Reset output stream */ end end /* End do forever */ /* FYI, leftover bits (if any): left(in,ptr-1) */ return buf || out /* Combine buffer and output */