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.tclgifblock.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.txtOh 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.
