# AniGif Package written in pure Tcl/Tk
#
# anigif.tcl v1.3 2002-09-09 (c) 2001-2002 Ryan Casey
#
# AniGif is distributed under the same license as Tcl/Tk.  As of
# AniGif 1.3, this license is applicable to all previous versions.
#
# Modified by Alexey Shchepin <alexey@sevcom.net>
#
# ###############################  USAGE  #################################
#
#  ::anigif::anigif IMAGE FILENAME INDEX
#    FILENAME: appropriate path and file to use for the animated gif
#    INDEX:    what image to begin on (first image is 0) (Default: 0)
#
#  ::anigif::stop IMAGE
#  ::anigif::restart IMAGE INDEX
#    INDEX:    defaults to next index in loop
#  ::anigif::destroy IMAGE
#
#  NOTES:
#    There is currently a -zoom and -subsample hack to keep transparency.
#    Anigif does not handle interlaced gifs properly.  The image will look
#      distorted.
#    A delay of 0 renders as fast as possible, per the GIF specification.
#      This is currently set to 40 ms to approximate the IE default.
#    If you experience a problem with a compressed gif, try uncompressing
#      it. Search the web for gifsicle.
#
# ############################## HISTORY #################################
#
#  1.3: Fixed error in disposal flag handling.
#       Added handling for non-valid comment/graphic blocks.
#       Searches for actual loop control block.  If it extists, loops.
#       Added more comments.
#  1.2: Now handles single playthrough gifs or gifs with partial images
#       Fixed bug in delay time (unsigned int was being treated as signed)
#  1.1: Reads default timing instead of 100 ms or user-defined.
#       You can no longer set the delay manually.
#  1.0: Moved all anigif variables to the anigif namespace
#  0.9: Initial release
#

namespace eval ::anigif {
    variable image_number 0
}

proc ::anigif::anigif2 {img list delay {idx 0}} {
    if {$idx >= [llength $list]} {
        set idx 0
        if {$::anigif::img(repeat,$img) == 0} {
            # Non-repeating GIF
            ::anigif::stop $img
            return
        }
    }
    set disposal_idx $idx
    incr disposal_idx -1
    if {$disposal_idx <= 0} {
        set disposal_idx 0
    }
    if {$idx == 0} {
        set dispflag "010"
    } else {
        set dispflag [lindex $::anigif::img(disposal,$img) $disposal_idx]
    }
    switch -- "$dispflag" {
        "000" {
            # Do nothing
        }
        "100" {
            # Do not dispose
        }
        "010" {
            # Restore to background
            $::anigif::img(curimage,$img) blank
        }
        "110" {
            # Restore to previous - not supported
            # As recommended, since this is not supported, it is set to blank
            [set ::anigif::img(curimage,$img)] blank
        }
        default { puts "no match: $dispflag" }
    }
    $::anigif::img(curimage,$img) copy [lindex $list $idx]
    if {[lindex $delay $idx] == 0} {
        ::anigif::stop $img
        return
    }
    # # #    update
    set ::anigif::img(asdf,$img) [list ::anigif::anigif2 $img $list]
    set ::anigif::img(loop,$img) \
        [after [lindex $delay $idx] \
           [list {*}$::anigif::img(asdf,$img) $delay [expr {$idx + 1}]]]
    set ::anigif::img(idx,$img) [incr idx]
}

proc ::anigif::anigif {img fnam {idx 0}} {
    variable image_number

    ::anigif::stop $img

    set n 0
    set images {}
    set delay {}
    set disposal {}
    set reserved {}
    #set img anigifimage[incr image_number]
    #set img [image create photo]

    image create photo $img

    set fin [open $fnam r]
    fconfigure $fin -translation binary
    set data [read $fin [file size $fnam]]
    close $fin

    # Find Loop Record
    set start [string first "\x21\xFF\x0B" $data]

    if {$start < 0} {
        set repeat 0
    } else {
        set repeat 1
    }

    # Find Control Records
    set start [string first "\x21\xF9\x04" $data]
    while {![catch {create_image xpic$n$img \
                            -file $fnam \
                            -format [list gif89 -index $n]}]} {
        set stop [expr $start + 7]
        set record [string range $data $start $stop]
        binary scan $record @4s thisdelay
        if {[info exists thisdelay]} {
            # Change to unsigned integer
            #set thisdelay [expr {$thisdelay & 0xFF}];
            binary scan $record @3b5 disposalval
            set disposalval [string range $disposalval 2 end]
            lappend images pic$n$img
            image create photo pic$n$img
            pic$n$img copy xpic$n$img
            image delete xpic$n$img
            lappend disposal $disposalval

            # Convert hundreths to thousandths for after
            set thisdelay [expr {$thisdelay * 10}]

            # If 0, set to fastest (25 ms min to seem to match browser default)
            if {$thisdelay == 0} {set thisdelay 40}

            lappend delay $thisdelay
            unset thisdelay

            incr n
        }

        if {($start >= 0) && ($stop >= 0)} {
            set start [string first "\x21\xF9\x04" $data [expr {$stop + 1}]]
        } else {
            break
        }
    }
    set ::anigif::img(repeat,$img) $repeat
    set ::anigif::img(delay,$img) $delay
    set ::anigif::img(disposal,$img) $disposal
    set ::anigif::img(curimage,$img) $img
    $img blank
    $img copy pic0${img}
    #$img configure -image [set ::anigif::img(curimage,$img)]

    anigif2 $img $images $delay $idx

    return $img
}

proc ::anigif::stop {img} {
    catch {
        after cancel $::anigif::img(loop,$img)
    }
}

# TODO
proc ::anigif::restart {img {idx -1}} {
    if {$idx == -1} {
        if {[lindex $::anigif::img(delay,$img) $idx] < 0} {
            set idx 0
        } else {
            set idx $::anigif::img(idx,$img)
        }
    }
    catch {
        ::anigif::stop $img
        {*}$::anigif::img(asdf,$img) $::anigif::img(delay,$img) $idx
    }
}

proc ::anigif::destroy {img} {
    catch {
        ::anigif::stop $img
        foreach imagename [image names] {
            if {[regexp {^pic\d+(.*)} $imagename -> tail] && \
                    [string equal $tail $img]} {
                image delete $imagename
            }
        }
        image delete $img
        array unset ::anigif::img *,$img
    }
}

package provide anigif 2.0

# vim:ts=8:sw=4:sts=4:et
