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:
- detect if .gif image has multiple frames
- manage a deciated array, such that multiple animations in different label widgets is possible
- play a .gif
- pause a .gif
- repeated play or play once (reverse and other combinations could have been implemented, but I dont feel like at the moment)
- delete all images specific for that label to free up memory
- delete all images specific for toplevel to free up memory
- control animation speed (framerate)
- 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 : http://wiki.tcl.tk/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 : http://wiki.tcl.tk/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 : http://wiki.tcl.tk/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
}
}
