Updated 2013-09-02 00:02:29 by RLE

Here's a friendly package to play with GIF streams. It does not encode or decode GIF images. It only parses them into their block structures so that you can play with them. Great for intimately manipulating animated GIFs and truecolor GIFs.

The package comes in two files: "gifblock.tcl" --the one you need to use it, and "gifblock.txt" --complete documentation. Both are listed on this page.

Enjoy.

gifblock.tcl
 # gifblock.tcl
 #
 #   Manipulate GIF streams in pure Tcl
 #
 # Copyright (c) 2006-2008 Michael Thomas Greer
 #
 # Boost Software License - Version 1.0 - August 17th, 2003
 # 
 # Permission is hereby granted, free of charge, to any person or organization
 # obtaining a copy of the software and accompanying documentation covered by
 # this license (the "Software") to use, reproduce, display, distribute,
 # execute, and transmit the Software, and to prepare derivative works of the
 # Software, and to permit third-parties to whom the Software is furnished to
 # do so, all subject to the following:
 #
 # The copyright notices in the Software and this entire statement, including
 # the above license grant, this restriction and the following disclaimer,
 # must be included in all copies of the Software, in whole or in part, and
 # all derivative works of the Software, unless such copies or derivative
 # works are solely in the form of machine-executable object code generated by
 # a source language processor.
 #
 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 # FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT
 # SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE
 # FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE,
 # ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 # DEALINGS IN THE SOFTWARE.
 #
 # See gifblock.txt for documentation
 #
 
 namespace eval ::gifblock:: {
   namespace export \
     gif.blocknames \
     gif.get        \
     gif.index      \
     gif.load       \
     gif.save       \
     gif.set
   package provide gifblock 1.0
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.blocknames varName {
 #-----------------------------------------------------------------------------
   upvar 1 $varName blocks
   set cntr -1
   set count [llength $blocks]
   set result {}
   while {[incr cntr] < $count} {lappend result [gif.get blocks $cntr type]}
   return $result
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.get {varName index args} {
 #-----------------------------------------------------------------------------
   upvar 1 $varName blocks
 
   foreach {index args} [eval gif.IndexBlock blocks [list $index] $args] break
 
   if {$args eq {}} {return [lindex $blocks $index]}
 
   array set block [lindex $blocks $index]
 
   foreach name $args {if {![info exists block($name)]} {
     if {$name eq {type}} \
       then {return -code error "element \"type\" required in all blocks; missing in block #$index"} \
       else {return -code error "element \"$name\" not found in block #$index ($block(type))"}
     } }
 
   if {[llength $args] == 1} {return $block([lindex $args 0])}
 
   foreach name $args {lappend result $block($name)}
   return $result
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.index {varName index args} {
 #-----------------------------------------------------------------------------
   upvar 1 $varName blocks
   return [lindex [eval gif.IndexBlock blocks [list $index] $args] 0]
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.load {varName filename} {
 #-----------------------------------------------------------------------------
   upvar 1 $varName result
   set result {}
 
   set f [open $filename r]
   fconfigure $f -translation binary
 
   set iserror [catch {
 
   # ................................................................... Header
   set sig [encoding convertfrom ascii [read $f 3]]
   set ver [encoding convertfrom ascii [read $f 3]]
   if {($sig ne {GIF}) \
     || ![string is integer -strict [string range $ver 0 1]] \
     || ![string is alpha   -strict [string index $ver 2]]} {
     error "not a valid GIF"
     }
   lappend result [list \
     type      {GIF Header} \
     version   $ver \
     ]
 
   # ................................................ Logical Screen Descriptor
   gif.LoadBlock $f {
     unsigned           width
     unsigned           height
     packed {
       7                iscolormap
       color.resolution colorres
       3                issorted
       color.table.size size
       }
     byte               bgcidx
     aspect             aspect
     }
   if {$iscolormap} {                                  # GIF Global Color Table
     lappend result [list \
       type      {Color Table} \
       sorted?   $issorted \
       colors    [gif.LoadColorTable $f $size] \
       ]
     }
   lappend result [list \
     type                     {Logical Screen Descriptor} \
     width                    $width \
     height                   $height \
     {color resolution}       $colorres \
     {background color index} $bgcidx \
     {pixel aspect ratio}     $aspect \
     ]
 
   # ..........................................................................
   while {true} {
     gif.LoadBlock $f {byte blocktype}
     if {$blocktype == 0x21} {
       gif.LoadBlock $f {byte exttype}
       set blocktype ext-$exttype
       }
 
     switch -glob -- $blocktype {
       44 { # ................................................ Image Descriptor
         gif.LoadBlock $f {
           unsigned           left
           unsigned           top
           unsigned           width
           unsigned           height
           packed {
             7                iscolormap
             6                isinterlaced
             5                issorted
             43               reserved
             color.table.size size
             }
           }
         if {$iscolormap} {                             # GIF Local Color Table
           lappend result [list \
             type    {Color Table} \
             sorted? $issorted \
             colors  [gif.LoadColorTable $f $size] \
             ]
           }
         gif.LoadBlock $f {byte codesize}
         lappend result [list \
           type                    {Image Descriptor} \
           left                    $left \
           top                     $top \
           width                   $width \
           height                  $height \
           interlaced?             $isinterlaced \
           reserved                $reserved \
           {lzw minimum code size} $codesize \
           data                    [gif.LoadSubBlocks $f unpack] \
           ]
         }
 
       ext-249 { # .................................. Graphic Control Extension
         gif.LoadBlock $f {
           byte     size
           packed {
             75     reserved
             42     method
             1      isui
             0      istransp
             }
           unsigned delay
           byte     transidx
           byte     term
           }
         set temp [list \
           type              {Graphic Control} \
           reserved          $reserved \
           {disposal method} $method \
           {user input?}     $isui \
           {delay time}      $delay \
           ]
         if {$istransp} {lappend temp {transparent color index} $transidx}
         lappend result $temp
         }
 
       ext-254 { # .......................................... Comment Extension
         lappend result [list \
           type Comment \
           text [encoding convertfrom ascii [gif.LoadSubBlocks $f unpack]] \
           ]
         }
 
       ext-1 { # ......................................... Plain Text Extension
         gif.LoadBlock $f {
           byte     size
           unsigned left
           unsigned top
           unsigned width
           unsigned height
           byte     cellwidth
           byte     cellheight
           byte     fgcidx
           byte     bgcidx
           }
         lappend result [list \
           type                     {Plain Text} \
           left                     $left \
           top                      $top \
           width                    $width \
           height                   $height \
           {cell width}             $cellwidth \
           {cell height}            $cellheight \
           {foreground color index} $fgcidx \
           {background color index} $bgcidx \
           text    [encoding convertfrom ascii [gif.LoadSubBlocks $f unpack]] \
           ]
         }
 
       ext-255 { # ...................................... Application Extension
         read $f 1
         set id [encoding convertfrom ascii [read $f 8]]
         gif.LoadBlock $f {
           byte a0
           byte a1
           byte a2
           }
         set datablocks [gif.LoadSubBlocks $f leavepacked]
         lappend result [list \
           type                  Application \
           identifier            $id \
           {authentication code} [list $a0 $a1 $a2] \
           datablocks            $datablocks \
           ]
         }
 
       ext-* { # ....................................... Unknown extension type
         lappend result [list \
           type "Extension $exttype" \
           datablocks [gif.LoadSubBlocks $f leavepacked] \
           ]
         }
 
       59 { # ..................................................... GIF Trailer
         break
         }
 
       default {
         error {cannot understand block types not listed in the GIF89a specification}
         }
       }
     }
 
   } errmsg]
 
   close $f
 
   if {$iserror} {return -code error $errmsg}
 
   return ;# $result
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.save {varName filename} {
 #-----------------------------------------------------------------------------
   upvar 1 $varName blocks
 
   set count [llength $blocks]
   if {$count == 0} return
 
   set f [open $filename w]
   fconfigure $f -translation binary
 
   set iserror [catch {
 
   # Every block must have a proper type
   gif.blocknames blocks
 
   # ............................................................... GIF Header
   array set block {type {} version {}}
   array set block [lindex $blocks 0]
   if {$block(type) ne {GIF Header}} {error {first block must be "GIF Header"}}
   if {$block(version) eq {}} {
     set version 87a
     set blocknames [gif.blocknames blocks]
     foreach pattern {
       {Graphic Control} Comment {Plain Text} Application Extension*
       } {
       if {[lsearch -glob $blocknames $pattern] >= 0} {
         set version 89a
         break
         }
       }
     set block(version) $version
     }
 
   puts -nonewline $f [encoding convertto ascii GIF]
   puts -nonewline $f [encoding convertto ascii $block(version)]
 
   # ..........................................................................
   set cntr 0
   while {[incr cntr] < $count} {
     array unset block
     array set block [lindex $blocks $cntr]
     switch -glob -- $block(type) {
 
       {Color Table} { # .......................................... Color Table
         gif.ValidateBlock block colors {{{sorted?} 0}}
         set len [llength $block(colors)]
         if {($len < 2) || ($len > 256)} {
           error {color table must have from 2 to 256 entries}
           }
         array set colorblock [lindex $blocks $cntr]
         }
 
       {Logical Screen Descriptor} { # .............. Logical Screen Descriptor
         if {$cntr > (1 +[info exists colorblock])} {
           error {invalid index for the Logical Screen Descriptor}
           }
         gif.ValidateBlock block {width height} {
           {{color resolution}       4}
           {{background color index} 0}
           {{pixel aspect ratio}     0}
           }
         set iscolormap [info exists colorblock]
         if {$iscolormap} \
           then {
             set issorted [expr {!!$colorblock(sorted?)}]
             set size     [gif.CalcColorTableSize [llength $colorblock(colors)]]
             } \
           else {
             set issorted 0
             set size     0
             }
         gif.WriteBlock $f [list \
           unsigned           $block(width) \
           unsigned           $block(height) \
           packed             [list \
             7                $iscolormap \
             color.resolution ${block(color resolution)} \
             3                $issorted \
             20               $size \
             ] \
           byte               ${block(background color index)} \
           aspect             ${block(pixel aspect ratio)} \
           ]
         if {$iscolormap} {
           gif.WriteColorTable $f $colorblock(colors) $size
           array unset colorblock
           }
         }
 
       {Image Descriptor} { # ................................ Image Descriptor
         gif.ValidateBlock block {
           width height {lzw minimum code size} data} {
           {left 0} {top 0} {interlaced? 0} {reserved 0}
           }
         set iscolormap [info exists colorblock]
         if {$iscolormap} \
           then {
             set issorted [expr {!!$colorblock(sorted?)}]
             set size     [gif.CalcColorTableSize [llength $colorblock(colors)]]
             } \
           else {
             set issorted 0
             set size     0
             }
         gif.WriteBlock $f [list \
           byte           44 \
           unsigned       $block(left) \
           unsigned       $block(top) \
           unsigned       $block(width) \
           unsigned       $block(height) \
           packed         [list \
             7            $iscolormap \
             6            $block(interlaced?) \
             5            $issorted \
             43           $block(reserved) \
             20           $size \
             ] \
           ]
         if {$iscolormap} {
           gif.WriteColorTable $f $colorblock(colors) $size
           array unset colorblock
           }
         gif.WriteBlock $f "byte ${block(lzw minimum code size)}"
         gif.WriteSubBlocks $f $block(data) pack
         gif.WriteBlock $f {byte 0}
         }
 
       {Graphic Control} { # ........................ Graphic Control Extension
         gif.ValidateBlock block {} {
           { reserved                  0}
           {{disposal method}          0}
           {{user input?}              0}
           {{delay time}               0}
           {{transparent color index} -1}
           }
         set istransidx [expr {${block(transparent color index)} >= 0}]
         if {!$istransidx} {set {block(transparent color index)} 0}
         gif.WriteBlock $f [list \
           byte              0x21 \
           byte              249 \
           byte              4 \
           packed            [list \
             75              $block(reserved) \
             42              ${block(disposal method)} \
             1               ${block(user input?)} \
             0               $istransidx \
             ] \
           unsigned          ${block(delay time)} \
           byte              ${block(transparent color index)} \
           byte              0 \
           ]
         }
 
       Comment { # .......................................... Comment Extension
         gif.ValidateBlock block text {}
         gif.WriteBlock $f [list \
           byte 0x21 \
           byte 254 \
           ]
         gif.WriteSubBlocks $f [encoding convertto ascii $block(text)] pack
         gif.WriteBlock $f {byte 0}
         }
 
       {Plain Text} { # .................................. Plain Text Extension
         gif.ValidateBlock block {
           left top width height {cell width} {cell height}
           {foreground color index} {background color index} text
           } {}
         gif.WriteBlock $f [list \
           byte     0x21 \
           byte     1 \
           byte     12 \
           unsigned $block(left) \
           unsigned $block(top) \
           unsigned $block(width) \
           unsigned $block(height) \
           byte     ${block(cell width)} \
           byte     ${block(cell height)} \
           byte     ${block(foreground color index)} \
           byte     ${block(background color index)} \
           ]
         gif.WriteSubBlocks $f $block(text) pack
         gif.WriteBlock $f {byte 0}
         }
 
       Application { # .................................. Application Extension
         gif.ValidateBlock block {identifier {authentication code}} {{datablocks {}}}
         gif.WriteBlock $f [list \
           byte 0x21 \
           byte 255 \
           byte 11 \
           ]
         if {[llength ${block(authentication code)}] < 3} {
           error {application authentication code must be a list of three 8-bit integers}
           }
         puts -nonewline $f [encoding convertto ascii $block(identifier)]
         puts -nonewline $f [binary format ccc ${block(authentication code)}]
         gif.WriteSubBlocks $f $block(datablocks) prepacked
         gif.WriteBlock $f {byte 0}
         }
 
       Extension* { # .................................. Unknown extension type
         gif.ValidateBlock block datablocks {}
         if {![llength $block(datablocks)]} {
           error "$block(type) must specify datablocks"
           }
         gif.WriteBlock $f [list byte 0x21 byte [lindex $block(type) 1]]
         gif.WriteSubBlocks $f $block(datablocks) prepacked
         gif.WriteBlock $f {byte 0}
         }
 
       default {
         error {cannot understand block types not listed in the GIF89a specification}
         }
       }
     }
 
   # .............................................................. GIF Trailer
   gif.WriteBlock $f {byte 59}
 
   } errmsg]
 
   close $f
 
   if {$iserror} {return -code error $errmsg}
   return
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.set {varName index args} {
 #-----------------------------------------------------------------------------
   upvar 1 $varName blocks
 
   foreach {index args} [eval gif.IndexBlock blocks [list $index] $args] break
   array set block [lindex $blocks $index]
 
   if {([llength $args] % 2) == 1} {
     unset block([lindex $args end])
     set args [lrange $args 0 end-1]
     }
   foreach {element value} $args {set block($element) $value}
 
   lset blocks $index [array get block]
   return
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.CalcColorTableSize size {                      # gif.save
 #-----------------------------------------------------------------------------
   if {($size < 2) || ($size > 256)} {
     return -code error {color table must have from 2 to 256 entries}
     }
   foreach min {2 4 8 16 32 64 128 256} value {0 1 2 3 4 5 6 7} {
     if {$size <= $min} {return $value}
     }
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.IndexBlock {varName index args} {   # gif.index,.get,.set
 #-----------------------------------------------------------------------------
   upvar 1 $varName blocks
 
   if {![info exists blocks]} {
     return -code error "can't read \"$varName\": no such variable"
     }
 
   set count [llength $blocks]
 
   if {![string is integer -strict $index]} {
     if {![string is integer -strict [lindex $args 0]]} {
       return -code error {incorrect args: should be "gif.index varName ?type? index"}
       }
     set type  $index
     set index [lindex $args 0]
     set args  [lrange $args 1 end]
     for {set cntr 0} {$cntr < $count} {incr cntr} {
       array set block [lindex $blocks $cntr]
       if {$block(type) eq $type} {if {[incr index -1] < 0} break}
       }
     if {$block(type) ne $type} {return -1}
     set index $cntr
     }
   if {$index >= $count} {return -1}
 
   return [list $index $args]
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.LoadBlock {f fargs} {                          # gif.load
 #-----------------------------------------------------------------------------
   foreach {format varName} $fargs {
     switch -exact -- $format {
       unsigned {
         binary scan [read $f 2] s val
         set val [expr {$val & 0xFFFF}]
         uplevel 1 [list set $varName $val]
         }
       byte {
         binary scan [read $f 1] c val
         set val [expr {$val & 0xFF}]
         uplevel 1 [list set $varName $val]
         }
       packed {
         uplevel 1 [list gif.LoadPacked $f $varName]
         }
       aspect {
         binary scan [read $f 1] c val
         set val [expr {$val & 0xFF}]
         set n [expr {($val) ? (($val +15) /64.0) : 0}]
         uplevel 1 [list set $varName $n]
         }
       }
     }
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.LoadColorTable {f size} {                      # gif.load
 #-----------------------------------------------------------------------------
   set result {}
   incr size
   while {[incr size -1]} {
     gif.LoadBlock $f {
       byte red
       byte green
       byte blue
       }
     lappend result [list $red $green $blue]
     }
   return $result
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.LoadPacked {f fargs} {                         # gif.load
 #-----------------------------------------------------------------------------
   binary scan [read $f 1] c data
   foreach {format varName} $fargs {
     switch -exact -- $format {
       0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 {
         set n [expr (($data >> $format) & 1) ? true : false]
         }
       color.resolution { set n [expr {(($data >> 4) & 0x7) +1}] }
       color.table.size { set n [expr {int( pow( 2, ($data & 0x7) +1 ))}] }
       default {
         if {![string is integer -strict $format] || (10 > $format) || ($format > 76)} {
           return -code error {invalid packed bitfield specification}
           }
         set length [expr [string index $format 0] -[string index $format 1] +1]
         set index [lsearch -exact {2 3 4 5 6 7} $length]
         if {$index < 0} {
           return -code error {invalid packed bitfield specification}
           }
         set mask [lindex {0x3 0x7 0xF 0x1F 0x3F 0x7F} $index]
         set n [expr ($data >> [string index $format 1]) & $mask]
         }
       }
     uplevel 1 [list set $varName $n]
     }
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.LoadSubBlocks {f mode} {                       # gif.load
 #-----------------------------------------------------------------------------
 # mode := unpack | leavepacked
   set result {}
   for {gif.LoadBlock $f {byte size}} {$size} {gif.LoadBlock $f {byte size}} {
     set data [read $f $size]
     if {$mode eq {unpack}} \
       then { append result $data} \
       else {lappend result $data}
     }
   return $result
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.ValidateBlock {varName requireds optionals} {  # gif.save
 #-----------------------------------------------------------------------------
   upvar 1 $varName block
   foreach name $requireds {
     if {![info exists block($name)] || ($block($name) eq {})} {
       return -code error "$block(type) requires element '$name'"
       }
     }
   foreach name $optionals {
     set elt [lindex $name 0]
     set val [lindex $name 1]
     if {![info exists block($elt)] || ($block($elt) eq {})} {
       set block($elt) $val
       }
     }
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.WriteBlock {f fargs} {                         # gif.save
 #-----------------------------------------------------------------------------
   foreach {format value} $fargs {
     switch -exact -- $format {
       unsigned {puts -nonewline $f [binary format s $value]}
       byte     {puts -nonewline $f [binary format c $value]}
       packed   {gif.WritePacked $f $value}
       aspect   {
         if {$value != 0} {
           set value [expr {(int( ($value *64.0) +0.5 ) -15) & 0xFF}]
           }
         puts -nonewline $f [binary format c $value]
         }
       default  {return -code error {invalid field specification}}
       }
     }
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.WriteColorTable {f colors size} {              # gif.save
 #-----------------------------------------------------------------------------
   set count [llength $colors]
   for {set cntr 0} {$cntr < $count} {incr cntr} {
     gif.WriteBlock $f "
       byte [lindex $colors $cntr 0]
       byte [lindex $colors $cntr 1]
       byte [lindex $colors $cntr 2]
       "
     }
   while {$cntr < $size} {
     gif.WriteBlock $f {byte 0 byte 0 byte 0}
     incr cntr
     }
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.WritePacked {f fargs} {                        # gif.save
 #-----------------------------------------------------------------------------
   set result 0
   foreach {format value} $fargs {
     switch -exact -- $format {
       0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 {
         set value [expr {!!$value}]
         set result [expr {$result | ($value << $format)}]
         }
       color.resolution {
         set result [expr {$result | ((($value -1) & 0x7) << 4)}]
         }
       default {
         if {![string is integer -strict $format] || (10 > $format) || ($format > 76)} {
           return -code error {invalid packed bitfield specification}
           }
         set length [expr [string index $format 0] -[string index $format 1] +1]
         set index [lsearch -exact {2 3 4 5 6 7} $length]
         if {$index < 0} {
           return -code error {invalid packed bitfield specification}
           }
         set mask [lindex {0x3 0x7 0xF 0x1F 0x3F 0x7F} $index]
         set result [expr {$result | (($value & $mask) << [string index $format 1])}]
         }
       }
     }
   puts -nonewline $f [binary format c $result]
   }
 
 #-----------------------------------------------------------------------------
 proc ::gifblock::gif.WriteSubBlocks {f data mode} {                 # gif.save
 #-----------------------------------------------------------------------------
 # mode := pack | prepacked
 # Does NOT write a sub-block terminator
 #
   if {$mode eq {pack}} {
     set length [string length $data]
     while {$length > 0} {
       if {$length >= 255} \
         then {
           gif.WriteBlock $f {byte 255}
           puts -nonewline $f [string range $data 0 254]
           set data [string range $data 255 end]
           incr length -255
           } \
         else {
           gif.WriteBlock $f "byte $length"
           puts -nonewline $f $data
           set length 0
           }
       }
     return
     }
 
   foreach subblock $data {
     gif.WriteBlock $f [string length $subblock]
     puts -nonewline $f $subblock
     }
   }
 
 #end gifblock.tcl

gifblock.txt
 gifblock.txt

     Manipulate GIF streams in pure Tcl

   Copyright (c) 2006-2008 Michael Thomas Greer

     Boost Software License - Version 1.0 - August 17th, 2003

     Permission is hereby granted, free of charge, to any person or organization
     obtaining a copy of the software and accompanying documentation covered by
     this license (the "Software") to use, reproduce, display, distribute,
     execute, and transmit the Software, and to prepare derivative works of the
     Software, and to permit third-parties to whom the Software is furnished to
     do so, all subject to the following:

     The copyright notices in the Software and this entire statement, including
     the above license grant, this restriction and the following disclaimer,
     must be included in all copies of the Software, in whole or in part, and
     all derivative works of the Software, unless such copies or derivative
     works are solely in the form of machine-executable object code generated by
     a source language processor.

     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
     IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
     FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT
     SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE
     FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE,
     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
     DEALINGS IN THE SOFTWARE.

 //////////////////////////////////////////////////////////////////////////////
   gifblock documentation
 //////////////////////////////////////////////////////////////////////////////

   A GIF file (or 'stream') is an ordered list of 'blocks'. This library
   decomposes a GIF file into a list of blocks, composes a list of blocks
   into a GIF file, and gives a couple of useful functions for inspecting
   and modifying a list of blocks.

   Each block listed is stored as a record of key-value pairs
   (see the tcl proc 'array get' and 'array set' for more information).

   A sample block:
     {
       type                     {Logical Screen Descriptor}
       width                    800
       height                   600
       {color resolution}       3
       {background color index} 255
     }

   The best way to become familiar with the block structure is to play with a
   few GIFs and dump the structure. For example:

     # List the blocks, in order, found in 'my_image.gif'
     gif.load sunset sunset.gif
     set cntr -1
     foreach name [gif.blocknames sunset] {puts "[incr cntr]: $name"}

   For those of you familiar with the GIF specification, please pay attention
   to the way the Color Table block is handled -- it is more conveniently
   coupled to the LSD and Image Descriptor blocks than in the GIF spec.

   The ORDER of blocks in the list is important. The relative order of elements
   in any given block is not.

   Each block must always have a 'type' element naming the type of the block.
   Block types and data are as follows.

 ------------------------------------------------------------------------------
   type {GIF Header}
     Required. This must always be the first block in the list.
     Only one of these may appear in a list.

   version
     Optional. One of "87a" or "89a". If not given, gif.save will choose
     the appropriate version when writing the GIF file.

 ------------------------------------------------------------------------------
   type {Logical Screen Descriptor}
     Required. Only one of these may appear in a list. It must always be the
     second or third block in the list, and may only be preceeded by the GIF
     Header block and an optional Color Table block.

   width
   height
     Required. The size of the GIF image. Unsigned 16-bit integers.

   color resolution
     Optional. The number of bits per primary color available
     to the original image. Defaults to 4.

   background color index
     Optional. Unsigned 8-bit integer. Defaults to 0.

   pixel aspect ratio
     Optional. The quotient of a pixel's width over its height.
     Defaults to 0 (meaning that the aspect ratio is not defined).

 ------------------------------------------------------------------------------
   type {Color Table}
     Optional. A GIF file will generally have one of these, positioned
     immediately following the GIF Header block and immediately before the
     Logical Screen Descriptor block (making it the Global Color Table).

     Color Table blocks can also be located anywhere in the list preceeding an
     Image Descriptor block, indicating that the image data refers to this
     Local Color Table and not the Global Color Table (if any).

   sorted?
     Optional. Must be true or false (any valid Tcl boolean string will do).
     If true, indicates that the Color Table lists colors with the most
     frequently used color first and the least frequently used last.
     Defaults to false.

   colors
     Required. A list of triplets of the form
       {red green blue}
     where red, green, and blue are unsigned 8-bit integers. That is, it is a
     list of colors. The length of the color table may not exceed 256.

 ------------------------------------------------------------------------------
   type {Image Descriptor}
     Optional. Image data.

   left
   top
     Optional. The location of the upper-left edge of the image in the
     Logical Screen. The upper-left corner of the Logical Screen is (0, 0).
     Unsigned 16-bit integers. Default to 0.

   width
   height
     Required. The image dimentions. Unsigned 16-bit integers.

   interlaced?
     Optional. Must be true or false (any valid Tcl boolean string will do).
     If true, the GIF Image Data is interlaced. See the GIF specification for
     more. Defaults to false.

   reserved
     Optional. Unsigned 2-bit integer. Should be 0.

   lzw minimum code size
     Required. The GIF LZW Minimum Code Size unsigned 8-bit integer value.

   data
     Required. The GIF Variable-Length-Code LZW Compressed binary image data.

   The {lzw minimum code size} and data are not modified or utilized by this
   library.

 ------------------------------------------------------------------------------
   type {Graphic Control}
     Optional. This is everyone's favorite extension block, because it is the
     one that gives GIFs a transparent color and enables GIF animations.
     See the GIF 89a specification for more information.

     This block modifies the way the next 'graphic rendering block'
     (Image Descriptor block or Plain Text block) it is to be displayed.

   reserved
     Optional. Unsigned 3-bit integer. Should be 0.

   disposal method
     Optional. Unsigned 3-bit integer. One of:
       0    No disposal method specified (default).
       1    Leave the graphic block in place after drawing it.
       2    After drawing the graphic but before drawing the next, fill the
            area used with the background color (see the Logical Screen
            Descriptor block).
       3    After drawing the graphic but before drawing the next,
            restore the area used to its prior state
            (as if the graphic had never been drawn).
       4-7  Undefined. Do not use.

   user input?
     Optional. Must be true or false (any valid Tcl boolean string will do).
     If true, the user must do something (like click a button or press a key)
     before the decoder displays the next graphic rendering block.
     Defaults to false.

     If true and a delay time is given, the decoder continues processing when
     the user gives input or the delay time times-out --whichever comes first.

   delay time
     Optional. Unsigned 16-bit integer. If non-zero, indicates the number of
     1/100 seconds to pause before drawing the next graphic rendering block.
     Defaults to 0.

   transparent color index
     Optional. If present, indicates that the specified unsigned 8-bit color
     index is to be treated as transparent. Defaults to 'not present',
     i.e. no transparency.

 ------------------------------------------------------------------------------
   type Comment
     Optional. Non-displayable textual data (stuff like "this image is
     copyright (c) 2027 Spiff Industries", etc.)

   text
     Required. A string containing the textual data.
     The GIF specification does not give any clear recommendations on what
     character codes may or may not appear in a GIF Comment string, but in
     real life it is not uncommon to have newline and carriage return codes
     embedded.

 ------------------------------------------------------------------------------
   type {Plain Text}
     Optional. Textual information to display.

     Be aware that not many GIF decoders properly recognize this block. For
     example, the famous Irfanview complains that the GIF is invalid when it
     is in fact properly formed. You should generally use an image block
     instead.

   left
   top
     Required. The location of the upper-left edge of the image in the
     Logical Screen. The upper-left corner of the Logical Screen is (0, 0).
     Unsigned 16-bit integers.

   width
   height
     Required. The text grid dimentions. Unsigned 16-bit integers.
     Should be a multiple of cell width and cell height, respectively.

   cell width
   cell height
     Required. The cell grid dimentions. Unsigned 8-bit integers.

   foreground color index
   background color index
     Required. Always references the Global Color Table.
     Also, a Graphic Control block may modify this block,
     so the specified index might be a transparent color index...

   text
     Required. Plain ASCII text in the range 20h..F7h (out of range characters
     are recommended to be displayed as spaces [ASCII 20h]). The text should be
     pre-formatted (with spaces) to fit the grid appropriately. For example:

       +-+-+-+-+-+-+
       |W|h|a|t|'|s|
       +-+-+-+-+-+-+  -->   "What's  up?"
       | | |u|p|?| |
       +-+-+-+-+-+-+        Notice the two spaces between words, so that the
                            6 by 2 grid is filled with the "up?" centered.
       +-+-+-+-+-+-+
       |W|h|a|t|'|s|
       +-+-+-+-+-+-+  -->   "What'sup?"
       |u|p|?| | | |
       +-+-+-+-+-+-+        Notice the lack of spaces between words, so that
                            the text is left-justified in the 6 by 2 grid.

 ------------------------------------------------------------------------------
   type Application
     Optional. Application-specific data.

   identifier
     Required. An 8-character string identifying the data.

   authentication code
     Required. A list of three unsigned 8-bit integer values.

   datablocks
     Optional. A list of binary application data sub-blocks.

 ------------------------------------------------------------------------------
   type {Extension 12}
     Optional. Any number (except 1, 249, 254, and 255).
     This is an unknown extension block.

     You can specify those other numbers if you like, but they represent the
     Plain Text, Graphic Control, Comment, and Application extension blocks,
     which are treated specially.

     The number used identifies the type of block:
         0..127  Graphic Rendering blocks (like the Plain Text and Image)
       128..249  Control blocks (like the Graphic Control)
       250..255  Special Purpose (like the Comment)

     See the GIF specification for more information.

   datablocks
     Required. A list of binary data sub-blocks.

 //////////////////////////////////////////////////////////////////////////////
   function reference
 //////////////////////////////////////////////////////////////////////////////

 ------------------------------------------------------------------------------
 gif.blocknames varName
 ------------------------------------------------------------------------------
   Return an ordered list of block types belonging to a named list of blocks.
   Most GIF files will look something like this:
     GIF Header
     Color Table
     Logical Screen Descriptor
     Graphic Control
     Image Descriptor

   See the top of this file for an example of use.

 ------------------------------------------------------------------------------
 gif.get varName ?type? index ?element ...?
 ------------------------------------------------------------------------------
   Find an indexed block and return one or more elements.

   arguments
     varName      The name of the variable holding the list of blocks.
     type         The type of block to index.
                  If omitted, all block types are indexed.
     index        Find the (n-1)th block (of the specified type).
     element ...  One or more element names to find.

   returns
     The value of the specified element. Or
     A list of the values of the specified elements, in same order. Or
     The entire block, if no elements are specified.

   examples
     What is the width and height of the 4th image block?
       gif.get blocks {Image Descriptor} 3 width height
     --> a list, e.g.:
       320 240

     What is the type of the 3rd block (in a GIF with a Global Color Table)?
       gif.get blocks 2 type
     --> Logical Screen Descriptor

     Get the LSD screen dimentions (GIF image size):
       gif.get blocks {Logical Screen Descriptor} 0 width height
     --> a list, e.g.:
       800 600

     Get the entire 4th block, regardless of type:
       gif.get blocks 3
     Use it as an array:
       array set block [gif.get blocks 3]

 ------------------------------------------------------------------------------
 gif.index varName ?type? index
 ------------------------------------------------------------------------------
   Return the absolute index of a GIF block. For example, given the blocks:
     0: GIF Header
     1: Color Table
     2: Logical Screen Descriptor
     3: Graphic Control
     4: Image Descriptor
     5: Graphic Control
     6: Image Descriptor
then
gif.index blocks {Logical Screen Descriptor} 0
returns
2
and
gif.index blocks {Image Descriptor} 1
returns
6
   See also gif.get

 ------------------------------------------------------------------------------
 gif.save varName filename
 ------------------------------------------------------------------------------
   Compile the blocks listed with the named variable and write them to a GIF
   file named as given by filename. Always overwrites.

   Be aware that
     gif.load blocks one.gif
     gif.save blocks two.gif

   may produce a GIF file (two.gif) that is binary distinct from the original
   GIF file (one.gif). This is because image data (and some other sub-blocks)
   are unpacked by gif.load and re-packed by gif.save. Gif.make always packs
   sub-blocks optimally, whereas some encoders may not. The resultant GIF file
   (two.gif) is valid and produces identically to the source GIF file
   (one.gif).

   All this means is that if you unpack and repack a GIF file using this
   library you might end-up with a smaller GIF than you began with.

 ------------------------------------------------------------------------------
 gif.load varName filename
 ------------------------------------------------------------------------------
   Read the named GIF file and set the named variable to the list of blocks.

   See the top of this file for an example of use.

 ------------------------------------------------------------------------------
 gif.set varName ?type? index element ?value? ...
 ------------------------------------------------------------------------------
   Index an element of a block the same way as gif.get and set one or more
   element values. If no value is specified, the named element is removed.

 end gifblock.txt

Oh yeah, the code has been fairly carefully tested, but that doesn't mean that there aren't any odd bugs lying underneath. Should you find something wrong go ahead and fix it here. Thanks! --Duoas

Duoas 2008-10-09 This was originally licensed under the LGPL, but I have since become disenamoured of the GPL in general. The current Boost license is compatible with the Tcl/BSD/MIT licenses and is completely non-viral.