tG2 .gif animation wrapper

Hello, the following is a wrapper developed in & for tG² which is using a dedicated namespace to provide the user the ability to control a .gif animation inside a tk-label widget. Unfortunately, I can not demonstrate it, since the functionality makes use of timers, a dedicated functionality I created specificly for the tG² interface long time ago. It makes also use of other custom wrappers, created in other tcl-libraries. To summarize the abilities of this wrapper:

  1. detect if .gif image has multiple frames
  2. manage a deciated array, such that multiple animations in different label widgets is possible
  3. play a .gif
  4. pause a .gif
  5. repeated play or play once (reverse and other combinations could have been implemented, but I dont feel like at the moment)
  6. delete all images specific for that label to free up memory
  7. delete all images specific for toplevel to free up memory
  8. control animation speed (framerate)
  9. etract original animation framerate from file

Adding an animated .gif to a tG2-layout is childsplay now, by "dragon drop" & play/pause buttons in the Layout Editor. tG² is under heavy (re)construction, release date unknown.

# Inspired from : https://wiki.tcl-lang.org/4882, Richard Suchenwirth & several authors & contributors
# Wrapper Created for tG2 integration, copyright (C) 2015 Sedat Serper
# License: BSD, retain this header information when distributed.
# Usage : ::gifAnim::doAnimation <labelpath> <.gif filename> ?frame speed?
# source ./procedures/gifAnimations_1.tcl 

namespace eval ::gifAnim {
  set cfg(timers) ""

  image create photo ::gifAnim::icon -data {
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAFJUlEQVR42sVXa2wUVRT+ZmefM9vd
bQstaSsRqUppi6hoJGhpU8UENdE0UX+ABOMfkxpM24Dgq1ijJkCNRjQmGpUQEzVE+FOjRIu1TVsf
gBRRUx7a2uj2td3tPmd2dr1n1ll3O7NliwZOc7PTuffO+e53nper2P6OveCWDZ0ANrFRgMsjs2wc
DA31tXBVn4y8yf55/GI7rCZg3WIr1rKx0m1GucCjwMKlviYnMRZWcMYfR/+EhD42pEReQN4iAIH5
Tu5iSh65RkDTUjvcDEUymYQsy0gkEuozCcdxMJlMsFgs6rOfaT80EsWB82EE5OS8TBCAnCs2ltvQ
ttIJNwMhSZKqmJSSIp7nVWUk9E5RFMhxGRz7o3mr1Qo/U773TBBdY7GcCAwB8Oy7u2qceGCpQ1Ua
jUbTHyWlmuK5QkBoaGDtdru679ORCF46HYSSzAMAKd9zkwv1S2yIRCIq1Q6HY17FRkBoHwEn09D+
7r9i2H48oAOhA/BsberkoVBI3UynyFexEZBYLKaaRxRFlYmOoWBuAGTzF1e71JOT/BflmSCICRJi
4pmTgSyfSAMgbz9cXwSRUxCTYhAFMUt5rzeKtYss6B6XUb/YnOWEmqKjYxHcWWbHMW8M60us6hpt
LhwOqz4USvK4/9h0OjrSAJqvF7F1uQPBYFCli+jPlOeO+1BskvGtn8PuKjOK3a6s+SgzbsvgFG4r
MmE0nEAHY5JOrAmZgUA4nU68dy6CN34N/QuAksznjcWwJ1NhZrPZdNTv/8mHzVfx6DyXgE0Ow27h
s+ZjLPHMSgp21rqwfziKJ1YIEByCzh/ou1HOgru/nFKTlQqgodSKfWvc6ukFQdCdXmOgkJNwIsCh
s9oEt9utM8GW3mnc6gFGmQt1rC5Qv5UpxAL5F7HQ+r0f3V4pBYBinjIdAaBJI8d77bQPTWVmvPu7
gm3LYAjg6cFxNK8Q8f75KJ6symZAW6PpoExJuUEFcHCdB5VCKnbJ843khRM+lPMx9PtN2FNjgcfj
0QHY2jOOuiLgl2AS7Te4dAyovvJPbjgb5rCpbyYFoPuuYtgSkuq1lLmMZO8pHxpLeHw8pmDHcs6Q
gdb+cWypFHFkNMpSuJ4BEsqQZIqYyYqGo1MpAD9sXJROt2az2RDAyz/6UG2X0DVpwr1LTCgscOqi
4KPhGdzH5gZ8zBy1BYYMxOPxdJq+uWtyYQDWFPI48qeCejEMwWZRC08aQCKJz7wJPLhMRA/LA09V
GzNgCCBfE9zuknHIy2HntbzqA3MdrG1gAg9X8OhiQHbUGDNgaIK8nPCkD5WiCT2TCl6pMg7DR7+Z
wAaWCU9Nx1hNEQ0ZMHTCdBiGWIiIOcJwyId7imV8MMahpdJsGAW7Brx47GoeH/6RQGu1noGcYZhP
InqehWGZncPgdAL7qjl43HoAm7+eQB0r42f9EtpX6RnImYjyTcUPlSp4/TcWgsxNXEK2qSgKvDOz
aLnOhrcvxLGtypnFgFYV6XC6VEwLMosRbdQqmSaUikutSTXE2iqiOgBUC9p/llFXasOFWRm7V2UD
mLcY0UNmOaaWijZnsvDVaAA3OhX0+jjcUZRKxXPl8PAkGkos6J1S0FgmpKthXuWYJLMhIeWZpqAI
yaSTqJzrA7SG3tOv1inn3ZBo8n+3ZKScAOXVkpEYNaUEYu6JL6b4kptSDYRRW05jPiCaYvIhSrmX
1JZnyoIvJmye3i30YkIXRWeuBZfjanZlL6dlza/a3eubrsj1fPa7L1r+BkExdRnjBgJiAAAAAElF
TkSuQmCC}

# ---
# Purpose : extracts and returns list of all image references from given .gif file
# Source  : https://wiki.tcl-lang.org/4882
# ---
  proc ::gifAnim::getImages {file} {
    set i 0
    set res {}
    while 1 {
      if [catch {image create photo -file $file -format "gif -index $i"} msg] {return $res}
      lappend res $msg
      incr i
    }
  }

# ---
# Purpose : cycles the list of images in forward motion, faster than tcl2_ListScroll?
# Source  : https://wiki.tcl-lang.org/4882
# ---
  proc ::gifAnim::lcycle {listName} {
    upvar 1 $listName list
    set res [lindex $list 0]
    set list [concat [lrange $list 1 end] [list $res]]
    set res
  }


# ---
# Purpose : set a different framerate or completely clear & free assigned timer
# ---
  proc ::gifAnim::animationSpeed {w speed {clear 0}} {
    variable cfg
    set i $cfg(${w},timer)
    if {$clear && ($speed==0)} {
      $w config -image [lindex $::gifAnim::animImages($i) 0]; set ::timer${i}_delay 0; set ::timer${i}_cmd ""
    } {
     switch $cfg(${w},mode) {
       "once"  {set cmd "if {\"[lindex $cfg(${w},images) 0]\"==\"\[lindex \$::gifAnim::animImages($i) 0]\"} {set ::timer${i}_delay 0}"}
       default {set cmd ""}
     }
     set ::timer${i}_cnt 0
     set ::timer${i}_delay $speed
     if {$speed>0} {set cfg(${w},speed) $speed}
     set ::timer${i}_cmd "
       if {\[catch {eval {$w configure -image \[::gifAnim::lcycle ::gifAnim::animImages($i)]}}] || (\[llength \$::gifAnim::animImages($i)]==1)} \{
         set ::timer${i}_cmd \"\"; set ::timer${i}_delay 0; ::gifAnim::delImages $w
       \}
       $cmd
     " 
    }
  }
  
  proc ::gifAnim::delImages {w {exception ""}} {
    variable cfg
    set i $cfg(${w},timer)
    foreach j $::gifAnim::animImages($i) {if {$j!=$exception} {image delete $j}}
    if {$exception==""} {unset ::gifAnim::animImages($i); set cfg($w,file) ""} {set ::gifAnim::animImages($i) [lindex $::gifAnim::animImages($i) 0]}
  }

# ---
# Purpose : use this to delete frame images in case animation was stopped before toplevel deletion
# ---
  proc ::gifAnim::delImagesTop {win} {
    variable cfg
    set w [winfo toplevel $win]
    set t 0
    foreach j $cfg($w) {if {![catch {image delete $j}]} {incr t}}
    unset cfg($w)
    return $t
  }
  
# ---
# Purpose : same as ::gifAnim::killAnimation4, including first image
# ---
  proc ::gifAnim::destroy {w} {::gifAnim::killAnimation4 $w; ::gifAnim::delImages $w}

# ---
# Purpose : stops animation and deletes all, but first, images.  
# ---
  proc ::gifAnim::killAnimation4 {w} {
    variable cfg
    set i $cfg(${w},timer)
    set ::gifAnim::animImages($i) [lsort $::gifAnim::animImages($i)]
    ::gifAnim::animationSpeed $w 0 1
    ::gifAnim::delImages $w [lindex $::gifAnim::animImages($i) 0]
  }
  
# ---
# Purpose : finds a free timer slot  
# ---
  proc ::gifAnim::nFTmr {} {
    set i 1
    while {$i<=$::maxTimers} {
      eval "if {\$::timer${i}_cmd==\"\"} {return \$i}"
      incr i 
    }
    return 0
  }

# ---
# Purpose : Tests and return if a given .gif file is an animated file
# Usage   : ::gifAnim::isAnimatedGif <.gif formatted file>
# ---
  proc ::gifAnim::isAnimatedGif {file} {
    set t [::gifAnim::getImages $file]
    if {[llength $t]==1} {set res 0} {set res [llength $t]}
    foreach i $t {image delete $i}
    return $res
  }
  
# ---
# Purpose : Check the frame rate as defined in the file
# Usage   : ::gifAnim::getGifFrameRate <.gif formatted file>
# Output  : returned value * 10ms is frame rate
# ---
  proc ::gifAnim::getGifFrameRate {file} {
    set d 0
    set i 0
    set f [open $file r]
    fconfigure $f -translation binary
    while {$i<1000} {
      binary scan [read $f 2] s B1
      if {$B1=="-1759"} {
             binary scan [read $f 2] s B1
             binary scan [read $f 2] s d
             break
      }
      incr i
    }
    close $f
    return $d
  }
  
# ---
# Purpose : wrapper for layout editor to place a label with animated .gif file
# ---
  proc ::gifAnim::place_gifLabelAnimation {tParent file x y {speed 5} {timer 0} {bg SystemButtonFace} {mode repeat} {packed ""}} {
    if {$tParent=="."} {set tParent ""}
    set w $tParent.anigif[getUniqueWidgetIndex]
    if {$packed==""} {place [label $w -bg $bg] -x $x -y $y} {eval "pack [label $w] $packed"}
    if {[file dirname $file]=="."} {set file "$::dev_folder/pictures/$file"}
    if {($file=="") || ![file exists $file] || [file isdirectory $file]} {$w config -image ::gifAnim::icon} {::gifAnim::doAnimation $w $file $speed $timer $mode}
    return $w
  }

# ---
# Purpose : a label with animated .gif can be paused with this proc  
# ---
  proc ::gifAnim::pauseAnim {w} {
    variable cfg
    set i $cfg(${w},timer)
    $w configure -image [::gifAnim::lcycle ::gifAnim::animImages($i)]
    ::gifAnim::animationSpeed $w 0
  }

# ---
# Purpose : a label with animated .gif can be (resumed to) play with this proc  
# ---
  proc ::gifAnim::playAnim {w} {
    variable cfg
    ::gifAnim::animationSpeed $w $cfg(${w},speed)
  }
  
# ---
# Purpose : in case user wants to implement a similar function by script  
# ---
  proc ::gifAnim::doAnimation {w afile {speed 5} {timer 0} {mode repeat}} {
    variable cfg
    if {[string trim $afile]!=""} {
      if {[file dirname $afile]=="."} {
        if {[catch {set afile "[$::targetFolder get]/pictures/$afile"}]} {set afile "$::dev_folder/pictures/$afile"}
      }
      if {![file exists $afile]} {
        mBox "Image file does not exist...\n$afile" "File not found" "error" ok
        return 0
      }
    } {return 0}
    if {$timer==0} {set i [::gifAnim::nFTmr]} {set i $timer}
    if {$i>0} {
      set cfg(${w},timer) $i
      set cfg(${w},speed) $speed
      set cfg(${w},mode) $mode 
      set cfg(${w},file) $afile
      set ::gifAnim::animImages($i) [::gifAnim::getImages $afile]
      set cfg(${w},images) $::gifAnim::animImages($i)
      ::gifAnim::animationSpeed $w $speed
      if {![info exists cfg([winfo toplevel $w])]} {set cfg([winfo toplevel $w]) ""}
      set cfg([winfo toplevel $w]) [luniq "$cfg([winfo toplevel $w])$::gifAnim::animImages($i) "]
      return $i
    } {
      mBox "Unable to allocate a free timer\nUnable to run gif animation...\nPlease increase ::maxTimers." "No free timer" "warning" ok
    }
    return 0
  }
}