#
# 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 eval $::anigif::img(asdf,$img) [list $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 {image create photo 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
	eval $::anigif::img(asdf,$img) [list $::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

