# 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
  }
}