An extension that provides slightly modified ttk widgets, with the
ability to change the size and rotation angle of the image they display,
without modifying the underlying Tk image.

*** What you can do with it ***
All widgets that accept the '''-image''' opton, will have additional options to:
   * specify the size of the image
   * specify wether the aspect ratio of the original image should be kept when resizing
   * atomatically adapt the size of the image to the available space in the widget
   * rotate the image by any angle

*** Limitations, known bugs, notes ***
   * works only with photo images
   * does not apply to ttk::notebook and ttk::treeview
   * needs imgtools (http://tkimgtools.sourceforge.net)
   * custom options are not part of the options database.
   * [ image inuse ] won't work correctly
   * because the widget commands get renamed, error messages will show the wrong widget command 
   * widgets will react a little differently if an image is changed or deleted: while normally ttk widgets don't adapt their size on such an event, with this extension they will. 

----

======
#
#   -- dift - Dynamic Images For Tk
#
#       An extension that provides slightly modified ttk widgets, with the
#       ability to change the size and rotation angle of an image on the fly
#       without modifiying the underlying Tk image.
#
#   Author: Simon Bachmann <simonbachmann at bluewin dot ch>
#

#
# Usage
# =======
#
# The extension provides a set of widgets that can dynamically change the size 
# and rotation of the image they display, without affecting the tk image that was
# set with the -image option. For the rest, these widgets work exactly like their ttk
# counterparts:
#   
#   ::dift::ttk::label 
#   ::dift::ttk::button 
#   ::dift::ttk::checkbutton 
#   ::dift::ttk::menubutton 
#   ::dift::ttk::radiobutton
#
# The additional options are:
#
# -imagewidth size          
# -imageheight size         Reference width and height to use for image display.
#                           The actual size of the displayed image depends also
#                           on the -imageaspectratio option (see below).
#                           Accepted values:
#                           - integer greater than zero: size in pixels
#                           - 'orig': use size of original image
#                           - 'widget': use size of available space in widget.
#                               Gets updated automatically if the size of the 
#                               widget changes.
#                           Defaults to 'orig'.
#
# -imageaspectratio mode    Specify how the image should be resized with respect
#                           to the reference given with the size options above.
#                           May be one of:
#                           - 'ignore': scale image exactly to the reference size
#                               without preserving the aspect ratio
#                           - 'keep': keep the aspect ratio of the original image.
#                               Make the image as large as possible, without
#                               exceeding the bounds given by the size
#                               options
#                           - 'keepexpand': keep the aspect ratio. Make the image
#                               large enough to cover all of the reference area
#                               given by the size options, but not larger
#                           Does not affect -imagerotation.
#                           Defaults to 'ignore'
#
#
# -imagerotation angle      Turn the image clockwise by angle degrees. 
#                           Negative values for counter-clockwise rotation.
#                           The size of the image will not change.
#                           Defaults to 0°
#
# If more than one image is set for a particular widget (images bound to a statespec),
# these options affect all images.
#
# For convenience, the ttk widgets that do not have a '-image' option are also provided.
# (e.g. ::dift::ttk::labelframe). These commands are merely an alias to the ttk widgets.
#

package require Tk 8.6
package require imgtools 0.3

namespace eval ::dift {
    variable version 0.2
    
    #
    # List of all widget creation commands, that we consider
    variable modWidgets [list ::ttk::label ::ttk::button ::ttk::checkbutton \
        ::ttk::menubutton ::ttk::radiobutton]
    
    #
    # These ones don't get any special treatment
    variable unchangedWidgets [list ::ttk::scale ::ttk::panedwindow ::ttk::separator \
        ::ttk::entry ::ttk::frame ::ttk::labelframe ::ttk::sizegrip ::ttk::combobox \
        ::ttk::notebook ::ttk::progressbar ::ttk::treeview ::ttk::spinbox \
        ::ttk::scrollbar]
    
    #
    # create a ::dift::ttk namespace to hold commands to create widgets
    namespace eval ::dift::ttk {
        namespace export *
    }
    
    #
    # Custom options
    # the dict contains the command description ([pathName configure -option])
    # The values of the second dict (list) is: opt name, database name, database
    # class, default value. without current value, of course
    variable customOpts {
        -imagewidth 
        -imageheight
        -imageaspectratio
        -imagerotation
    }
    variable customOptsDescr {
        -imagewidth         {-imagewidth {} {} orig}
        -imageheight        {-imageheight {} {} orig}
        -imageaspectratio   {-imageaspectratio {} {} ignore}
        -imagerotation      {-imagerotation {} {} 0}
    }
    
    # 
    # In this dict we keep track of the images
    #   first key: name of widget
    #   second key: 
    #       'orig'  orignal images
    #       'mod'   transformed images. if name(s) are equal to the ones in 
    #               orig, we did no tranformation
    #   third key: ttk state for the image ('default' for default image)
    #   value: name of the image. Empty String if no data available
    variable imgIndex [dict create]
    
    #
    # This list holds the names of all transformed (mod) images we created.
    # Needed to decide if an image can be deleted when no longer used
    variable modImgList {}
    
    #
    # This one saves our custom options
    #   first key: name of widget
    #   second key: name of option
    #   value:  value of option
    variable optDict [dict create]
    
    #
    # Here we keep our images
    # the counter is for the names
    namespace eval imgs {}
    variable imgCounter 0
    
    #
    # To be able to calculate the available space for images at init, we need
    # an image to display. We'll use a single-pixel (black, fully transparent)
    # for that:
    image create photo ::dift::imgs::unitImg
    ::dift::imgs::unitImg put {#000000}
    ::dift::imgs::unitImg transparency set 0 0 1
    
    #
    # Renamed commands (where possible) go here
    namespace eval cmds {}
    variable wCmdPrefix ::dift::cmds::
}

#
#   -- initPackage
#
#       Rename all commands that create widgets that can contain images
#       and do other setup stuff
#
proc ::dift::initPackage {} {
    variable modWidgets
    variable unchangedWidgets

    foreach w $modWidgets {
        if {[info command ::dift::$w] ne {}} {
            continue
        }
        proc ::dift::$w {pathName args} [list apply {{wCreator} {
            upvar pathName myPathName
            upvar args myArgs
                        
            return [::dift::createWidget $wCreator $myPathName $myArgs]             
        }} $w ]
    }
    
    foreach w $unchangedWidgets {
        if {[info command ::dift::$w] ne {}} {
            continue
        }
        proc ::dift::$w {pathName args} [list apply {{wCreator} {
            upvar pathName myPathName
            upvar args myArgs
            
            return [$wCreator $myPathName {*}$myArgs]
        }} $w ]
    }
    
    return
}

#
# -- createWidget
#
#       Gets called whenever the user creates a new widget with one of the commands
#       we renamed at init. Filters out the interesting options, creates the 
#       widget as desired and renames the windget command.
#
proc ::dift::createWidget {wCreator pathName arglist} {
    variable imgIndex
    variable optDict
    variable customOptsDescr
    variable wCmdPrefix
    
    #
    # Set defaults
    dict set imgIndex $pathName orig {}
    dict set imgIndex $pathName mod {}
    dict set optDict $pathName -image {}
    dict set optDict $pathName -imagewidth \
        [lindex [dict get $customOptsDescr -imagewidth] 3]
    dict set optDict $pathName -imageheight \
        [lindex [dict get $customOptsDescr -imageheight] 3]
    dict set optDict $pathName -imageaspectratio \
        [lindex [dict get $customOptsDescr -imageaspectratio] 3]
    dict set optDict $pathName -imagerotation \
        [lindex [dict get $customOptsDescr -imagerotation] 3]
    
    #
    # Create widget without options first
    # rename the widget command
    if {[catch {$wCreator $pathName} procResult procOpts]} {
        cleanupWidget $pathName
        return -options $procOpts $procResult
    }
    rename ::$pathName ::$wCmdPrefix$pathName
    proc ::$pathName {subcmd args} {
        set w [lindex [info level 0] 0]
        ::dift::widgetCommand $w $subcmd $args
    }
    
    #
    # Configure the widget
    if {[catch {widgetConfigure $pathName $arglist} confResult confOpts]} {
        cleanupWidget $pathName
        return -options $confOpts $confResult
    }
    
    #
    # Bindings
    bind $pathName <Destroy> [list ::dift::cleanupWidget $pathName]
    bind $pathName <Configure> [list ::dift::configureEvent $pathName]
    
    return -options $procOpts $procResult
}

#
#   -- cleanupWidget
#
#       Get rid of everything related to widget pathName
#
proc ::dift::cleanupWidget {pathName} {
    variable optDict
    variable imgIndex
    variable wCmdPrefix
    
    catch {destroy $pathName}
    catch {rename ::$pathName {}}
    catch {rename ::$wCmdPrefix$pathName {}}
    
    # remove traces on orig imgs
    removeTraces $pathName [dict get $imgIndex $pathName orig]
    
    dict unset optDict $pathName

    catch {deleteModImgs $pathName}
    dict unset imgIndex $pathName
    
    return
}

#
#   -- updateImgView
#
#       Updates the displayed image(s) of widget pathName
#       based on the current settings in optDict and state
#       of the widget.
#       Does take care to perform only those actions that are
#       needed. We cannot, however, detect if an original image was changed
#       since last update. Thus, we assume that all original images might 
#       have changed. It is up to the caller to call this proc only 
#       when needed.
#
#   Ttk widgets react kinda strangely if an image gets modified or deleted.
#       While changes of the contents ofthe image are displayed ok, ttk widgets
#       don't adapt their size if the size of an image changes after it was 
#       set with configure -image. Also, if more than one image is set (per-state)
#       and one of them is deleted, the widget will show no image for all states.
#
#       We will not mimick this behaviour, as it would make it quite difficult to
#       implement the 'widget' size to the -imagewidth/height options correctly.
#       And, I suspect this behaviour is a bug.
#
#       We will have the widget resize itself if an original image changes.
#       However, we'll keep the rule, that if for one state the image is deleted,
#       we'll display no image for all states. In this case, the entry in imgIndex
#       in the orig branch will be {} for the image in question, the mod images
#       will all be set to unitImg.
#
proc ::dift::updateImgView {pathName} {
    variable optDict
    variable imgIndex
    variable wCmdPrefix
    
    set imgOpt [dict get $optDict $pathName -image]
    
    #
    # No value for -image option: this means that the widget was (re)configured
    # with '-image {}'. We delete mod imgs, reconfigure the real widget and quit
    # Orig branch of imgIndex should already be ok (newOrigImgs was called).
    if {$imgOpt eq {}} {
        deleteModImgs $pathName
        if {[dict get $imgIndex $pathName orig] ne {}} {
            error "::dift::updateImgView: internal error. Empty img list but orig entry in dict is [dict get $imgIndex $pathName orig]"
        }
        ${wCmdPrefix}${pathName} configure -image {}
        return
    }
    
    #
    # Recreate the orig branch of imgIndex and check if all orig images exist
    set imgOpt [list default {*}$imgOpt]
    set origImgsExist yes
    # if -image option is not set, orig branch is the empty string
    dict set imgIndex $pathName orig {}
    foreach {state img} $imgOpt {
        if {$img ni [image names]} {
            set origImgsExist no
            dict set imgIndex $pathName orig $state {}
        } else {
            dict set imgIndex $pathName orig $state $img
        }
    }
    
    #
    # actual widget has no images set: set the unitImg 
    if {[${wCmdPrefix}${pathName} cget -image] eq {}} {
        ${wCmdPrefix}${pathName} configure -image ::dift::imgs::unitImg
        #after idle [list ::dift::updateImgView $pathName]
        #return
    }
    
    #
    # some orig images don't exist: set all to unitPixel
    # otherwise: recalculate mod images
    if { ! $origImgsExist} {
        deleteModImgs $pathName
        foreach {state img} $imgOpt {
            dict set imgIndex $pathName mod $state ::dift::imgs::unitImg
        }
    } else {
        modifyImages $pathName
    }
    
    #
    # reconfigure the widget
    ${wCmdPrefix}${pathName} configure -image [getImgOptList $pathName]
    
    return
}

 
#
#   -- modifyImages
#
#       Modify image of widget pathName according to opts
#       in optDict. Does not update the view in the widget, just creates
#       the modified images and writes their name to the imgIndex.
#
#       This proc assumes that all original images exist
#
proc ::dift::modifyImages {pathName} {
    variable imgIndex
    variable imgCounter
    variable optDict
    variable modImgList
    
    #
    # We must wait to delte previously modified images until after transformation
    # as the previous imgs are needed to calculage available space in widget
    set delImgList [getModDeleteList $pathName]
    dict set imgIndex $pathName mod {}
    
    #
    # Transform where needed
    set imgList [list "default"]
    lappend imgList {*}[dict get $optDict $pathName -image]
    foreach {state img} $imgList {
        #
        # Create the modified image if needed and write its name to the index
        set sizespec [getSizeSpec $pathName $state]
        set origSizespec "[image width $img]x[image height $img]"
        set angle [dict get $optDict $pathName -imagerotation]
        
        if {$sizespec eq $origSizespec && $angle == 0} {
            # Nothing to do, just "link" to the original image
            dict set imgIndex $pathName mod $state $img
            continue
        }
        set newImg [image create photo "::dift::imgs::dti_image[incr imgCounter]"]
        lappend modImgList $newImg
        if {$sizespec ne $origSizespec} {
            ::imgtools::scale $img $sizespec -compositingrule set -shrink $newImg
            set img $newImg
        }
        if {$angle != 0} {
            ::imgtools::rotate $img $angle -clipping keepsize -compositingrule set \
            -shrink -interpolation linear $newImg
        }
        
        dict set imgIndex $pathName mod $state $newImg
    }
        
    #
    # delete previous mod images
    foreach img $delImgList {
        image delete $img
    }
    
    return
}

#
#   -- getSizeSpec
#
#       Generates a sizespec to be used as argument for Imgtools,
#       for the image specifed for state
#
proc ::dift::getSizeSpec {pathName state} {
    variable optDict
    variable imgIndex
    
    set width [dict get $optDict $pathName -imagewidth]
    set height [dict get $optDict $pathName -imageheight]
    
    lassign [getImgCavitySize $pathName] widgetWidth widgetHeight
    
    set origWidth [image width [dict get $imgIndex $pathName orig $state]]
    set origHeight [image height [dict get $imgIndex $pathName orig $state]]
    
    set ratioMode [dict get $optDict $pathName -imageaspectratio]
    set origRatio [expr {1.0 * [image width [dict get $imgIndex $pathName orig $state]] \
        / [image height [dict get $imgIndex $pathName orig $state]]}]
    
    set width [expr {$width eq "orig" ? $origWidth : $width}]
    set width [expr {$width eq "widget" ? $widgetWidth : $width}]
    set height [expr {$height eq "orig" ? $origHeight : $height}]
    set height [expr {$height eq "widget" ? $widgetHeight : $height}]
    
    set widthFromHeight [expr {round(1.0 * $height * $origRatio)}]
    set heightFromWidth [expr {round(1.0 * $width / $origRatio)}]
    
    switch $ratioMode {
        "ignore" {
            set sizespec "${width}x${height}"
        }
        "keep" {
            if {$widthFromHeight > $width} {
                set sizespec "${width}x${heightFromWidth}"
            } else {
                set sizespec "${widthFromHeight}x${height}"
            }
        }
        "keepexpand" {
            if {$widthFromHeight < $width} {
                set sizespec "${width}x${heightFromWidth}"
            } else {
                set sizespec "${widthFromHeight}x${height}"
            }
        }
    }
    
    return $sizespec
}

#
#   -- getImgCavitySize
#  
#       Returns a list with the size of the available space in widget
#       to display images.
#       
proc ::dift::getImgCavitySize {pathName} {
    #variable imgIndex
    variable wCmdPrefix
    
    set imglist [${wCmdPrefix}$pathName cget -image]
    if {$imglist eq {}} {
        # this should not happen!
        error "dift, getImgCavitySize: internal error. Got called for widget with no images set"
    }
    
    set img [getImgForState $pathName [$pathName state]]
    
    set imgWidth [image width $img]
    set imgHeight [image height $img]
    set horizDiff [expr {[winfo reqwidth $pathName] - $imgWidth}]
    set vertDiff [expr {[winfo reqheight $pathName] - $imgHeight}]
    
    # make sure we don't end up with a negative or zero size
    set cavityWidth [expr {[winfo width $pathName] - $horizDiff}]
    set cavityWidth [expr {$cavityWidth <= 0 ? 1 : $cavityWidth}]
    set cavityHeight [expr {[winfo height $pathName] - $vertDiff}]
    set cavityHeight [expr {$cavityHeight <= 0 ? 1 : $cavityHeight}]
    
    return [list $cavityWidth $cavityHeight]
}

#
#   -- getImgForState
#       returns the name of the image that is currently used for statespec
#       in widget $pathName
#       type may be orig or mod
#
proc ::dift::getImgForState {pathName statespec {type mod}} {
    variable wCmdPrefix
    
    # we can't use image names from imgIndex, because it might not 
    # have been updated.
    if {$type eq "mod"} {
        set imgList [${wCmdPrefix}${pathName} cget -image]
    } elseif {$type eq "orig"} {
        set imgList [$pathName cget -image]
    } else {
        error "::dift::getImgForState: internal error. Invalid type $type"
    }
    set stateImgs [lassign $imgList default]
    
    set resImg {}
    
    dict for {state img} $stateImgs {
        if {[stateMatch $state $statespec]} {
            set resImg $img
            break
        }
    }
    
    if {$resImg eq {}} {
        set resImg $default
    }
    
    return $resImg
}

#
#   -- stateMatch
#
#       returns true if statespec matches wstate, false othrewise
#
proc ::dift::stateMatch {statespec wstate} {
    
    set match true
    foreach state $statespec {
        if {[string index $state 0] eq "!"} {
            set state [string range $state 1 end]
            if {$state in $wstate} {
                set match false 
                break
            }
        } else {
            if {$state ni $wstate} {
                set match false 
                break
            }
        }
    }
    
    return $match
}
    
#
#   -- widgetCommand
#
#       Widget command for all widgets are rerouted throught this proc
#       Filters out the parts that we're interested in, passes everything else 
#       on to the original widget command
#
proc ::dift::widgetCommand {pathName subcmd arglist} {
    variable wCmdPrefix
    
    switch $subcmd {
        "cget" {
            return [widgetCget $pathName $arglist]
        }
        "configure" {
            if {[llength $arglist] <= 1} {
                return [widgetListOpts $pathName $arglist]
            } else {
                return [widgetConfigure $pathName $arglist]
            }
        }
        default {
            return [::$wCmdPrefix$pathName $subcmd {*}$arglist]
        }
    }
    
    error "switch is broken!"
    
    return 
}

#
#   -- widgetCget
#
#       Implements the cget widget subcommand
#
proc ::dift::widgetCget {pathName option} {
        variable optDict
        variable wCmdPrefix
        
        switch $option {
            "-image" -
            "-imagewidth" -
            "-imageheight" -
            "-imageaspectratio" -
            "-imagerotation" {
                return [dict get $optDict $pathName $option]
            }
            default {
                # we expand the option argument, so we can leave the task to
                # complain about wrong number of args to the original
                # widget command
                return [::$wCmdPrefix$pathName cget {*}$option]
            }
        }
     error "switch is broken!"
     return
}

#
#   -- widgetListOpts
#
#       Implements the information retrieving part of the configure
#       subcommand (no options, only one option as argument)
#
proc ::dift::widgetListOpts {pathName arglist} {
    variable customOpts
    variable wCmdPrefix
    
    if {[llength $arglist] == 0} {
    
        set optDescr [::$wCmdPrefix$pathName configure]
        foreach opt $customOpts {
            lappend optDescr [getOptDescr $pathName $opt]
        }
        return $optDescr
    } elseif {$arglist in $customOpts} {
        return [getOptDescr $pathName $arglist]
    } else {
        return [::$wCmdPrefix$pathName configure {*}$arglist]
    }
}
        
    

#
#   -- getOptDescr
#
#       returns a list describing the custom option passed as argument
#       the elements of the list are option name, database name, database 
#       class, default value and the current value
#
proc ::dift::getOptDescr {pathName opt} {
    variable optDict
    variable customOptsDescr
    
    set result [dict get $customOptsDescr $opt]
    lappend result [dict get $optDict $pathName $opt]
    
    return $result
}

#
#   -- widgetConfigure
#
#       The configure subcommand, when used for a real configure (i.e. at 
#       least one opt-val pair passed)
#       intercept custom options, modify the value of the -image opt
#
proc ::dift::widgetConfigure {pathName arglist} {
    variable optDict
    variable wCmdPrefix
    
    #
    # Go through options
    set forwardOpts {}
    set updateImgs no
    foreach {opt value} $arglist {
        switch $opt {
            "-image" {
                #
                # Existence of states is checked by ttk
                # existence of image is checked in newOrigImgs
                if {$value ne {} && [llength $value ] % 2 != 1} {
                    error "image specification must contain an odd number of elements"
                }
                newOrigImgs $pathName $value
                set updateImgs yes
            }
            "-imagewidth" -
            "-imageheight" {
                if {$value ne "orig" && $value ne "widget" \
                        && (! [string is integer -strict $value] || $value <= 0) } {
                    error "bad size \"$value\": must be orig, widget or integer greater than zero"
                }
                
                dict set optDict $pathName $opt $value
                set updateImgs yes
            }
            "-imageaspectratio" {
                if {$value ni {ignore keep keepexpand}} {
                    error "bad aspect ratio \"$value\": must be ignore, keep or keepexpand"
                }
                
                dict set optDict $pathName $opt $value
                set updateImgs yes
            }
            "-imagerotation" {
                if { ! [string is double -strict $value]} {
                    #cleanupWidget $pathName
                    error "bad angle of rotation \"$value\": expected floating-point number"
                }
                if {$value ne [dict get $optDict $pathName -imagerotation]} {
                    set updateImgs yes
                }
                dict set optDict $pathName -imagerotation $value
            }
            default {
                lappend forwardOpts $opt $value
            }
        }
    }
    
    #
    # Configure the widget
    if {[llength $forwardOpts] == 0} {
        # we got only custom opts and need not to pass anything on to 
        # the original widget command
        set result {}
    } elseif {[llength $forwardOpts] >= 2} {
        set result [::$wCmdPrefix$pathName configure {*}$forwardOpts]
    } else {
        error "dift::widgetConfigure: internal error, only 1 forwardOpt: $forwardOpts"
    }
    
    #
    # Update transformed images
    if {$updateImgs} {
        #after idle [list ::dift::updateImgView $pathName]
        updateImgView $pathName
    }
    
    return $result
}

#
#   -- getImgOptList
#
#       build a list suitable to be used as value for the -image option,
#       based on the value saved in our optDict, with the transformed Images.
#
proc ::dift::getImgOptList {pathName} {
    variable imgIndex
    variable optDict
    
    set optval [dict get $optDict $pathName -image]
    set newOptval {}
    
    if {$optval eq {} } {
        return $newOptval
    }
    
    lappend newOptval [dict get $imgIndex $pathName mod default]
    foreach {state img} [lrange $optval 1 end] {
        lappend newOptval $state [dict get $imgIndex $pathName mod $state]
    }
    
    return $newOptval
}

#
#   -- deleteModIMgs
#
#       delete all the modified images for pathName
#       no errors - even if no entries for pathName esist
#       Checks if an image in the mod branch of the dict really is a modifeed
#       one. If it's just a "link" to the original image (no transformation
#       needed) it does not delete it - of course!
#       Removes all entries in the mod branch of imgIndex. orig branch is left
#       untouched.
# 
proc ::dift::deleteModImgs {pathName} {
    variable imgIndex
    variable modImgList
    
    if { ! [dict exists $imgIndex $pathName mod]} {
        return
    }
    
    set delList [getModDeleteList $pathName]
    foreach img $delList {
        set idx [lsearch -exact $modImgList $img]
        set modImgList [lreplace $modImgList $idx $idx]
        catch {image delete $img}
    }
    dict set imgIndex $pathName mod {}
    
    return
}

#
#   -- getModDeleteList
#
#       Similar as deleteModImgs, but don't actually delete images.
#       just return a list of the images that should be deleted
#
proc ::dift::getModDeleteList {pathName} {
    variable imgIndex
    variable modImgList
    
    if { ! [dict exists $imgIndex $pathName mod]} {
        return
    }
    
    set delList {}
    
    dict for {state img} [dict get $imgIndex $pathName mod] {
        if {$img in $modImgList } {
            lappend delList $img
        }
    }
    
    return $delList
}

#
#   -- newOrigImgs
#
#       Checks if the new images exist (error if not)
#       Adds a trace on the image command of each new image (detect changes!)
#       Removes traces from previous orig images that get replaced
#       writes new imglist to optDict and to the orig branch of imgIndex.
#       Does not delete mod images
#       does NOT transform images, nor uptdate the widget's view
#
proc ::dift::newOrigImgs {pathName imglist} {
    variable optDict
    variable imgIndex
    
    if {$imglist eq {}} {
        set modlist {}
    } else {
        set modlist [list default {*}$imglist]
    }
    foreach {state img} $modlist {
        if { $img ni [image names] } {
            error "image \"$img\" doesn't exist"
        }
    }
    
    #
    # remove traces from previous orig images, add trace for new image(s)
    if {[dict exists $imgIndex $pathName orig]} {
        removeTraces $pathName [dict get $imgIndex $pathName orig]
    }
    addTraces $pathName $modlist
    
    #
    # delete mod images
    # NOPE! We might need them to calculate size of new images!
    # deleteModImgs $pathName
    
    #
    # write new value to optDict and imgIndex
    dict set optDict $pathName -image $imglist
    dict set imgIndex $pathName orig $modlist
    
    return
}

#
#   -- removeTraces
#
#       removes traces from orig images in imgIndex-style dict imgDict
#       imgDict must have the same format as the innermost dict in imgIndex
#       i.e. state-imageName pairs.
#
#       does not throw errors if a trace does not exist
#
proc ::dift::removeTraces {pathName imgDict} {
    
    dict for {state img} $imgDict {
        catch {trace remove execution $img leave [list ::dift::origImgModified $pathName $img]}
        catch {trace remove command $img delete \
            [list after 0 ::dift::origImgDeleted $pathName $img]}
    }
    
    return
}

#
#   -- addTraces
#
#       adds traces to orig images
#       imgDict must have the same format as the innermost dict in imgIndex
#       i.e. state-imageName pairs.
#       imgDict may be an empty string
#
#       may throw an error if trace fails
#
proc ::dift::addTraces {pathName imgDict} {
    
    dict for {state img} $imgDict {
        trace add execution $img leave [list ::dift::origImgModified $pathName $img]
        # we need an [after] callback here, because at the time the trace triggers, the
        # image still exists
        trace add command $img delete [list after 0 ::dift::origImgDeleted $pathName $img]
    }
    
    return
}

#
#   -- origImgModified
#       
#       Called by trace, whenever an original image is modified
#       Applies transformations and updates widget
#
proc ::dift::origImgModified {pathName imgName args} {
    #variable wCmdPrefix
    
    #modifyImages $pathName
    #::$wCmdPrefix$pathName configure -image [getImgOptList $pathName]
    
    #after idle [list ::dift::updateImgView $pathName]
    updateImgView $pathName
    
    return
}

#
#   -- origImgDeleted
#
#       Called by trace, whenever an orignial image gets deleted.
#       updateImgView handles the case where orig images no longer exist.
#       No need to remove traces: for deleted image(s) it's gone anyway,
#       for the other ones, it doesn't hurt to keep them.
#
proc ::dift::origImgDeleted {pathName imgName args} {
    
    # since there's an after callack involved, this proc might be callde
    # after pathName has been destroyed. In this case, there's nothing 
    # we have to do
    if { [winfo exists $pathName] } {
        updateImgView $pathName
    }
    
    return
}

#
#   -- configureEvent
#
#       Updates displayed image after a <Configure> event, if needed. 
#       This is the case if at least one size was set to 'widget'
#
proc ::dift::configureEvent {pathName} {
    variable optDict
    
    if {[dict get $optDict $pathName -image] ne {}} {
        updateImgView $pathName
    }
    return
}

::dift::initPackage


package provide dift $::dift::version

======


<<categories>>Category Image Processing|Category Widget|Category GUI