# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: imbutton.tcl,v 1.7 2006/01/28 19:16:59 jfontain Exp $


class imageButton {

    proc imageButton {this parentPath args} composite {[new frame $parentPath -borderwidth 1] $args} {
        composite::manage $this [new label $widget::($this,path) -text ?] label
        bind $widget::($this,path) <Leave> {%W configure -relief flat}
        set path $composite::($this,label,path)
        bind $path <Configure> "imageButton::update $this %w %h"
        place $path -x 0 -y 0
        composite::complete $this
    }

    proc ~imageButton {this} {
        catch {image delete $($this,grayed)}
    }

    proc options {this} {
        return [list\
            [list -command {} {}]\
            [list -disabledgray 0 0]\
            [list -image {} {}]\
            [list -state normal]\
        ]
    }

    proc set-command {this value} {}

    proc set-disabledgray {this value} {}               ;# whether image is processed to better looking gray tones in disabled state

    proc set-image {this value} {
        $composite::($this,label,path) configure -image $value
        catch {image delete $($this,grayed); unset ($this,grayed)}                                             ;# reset grayed image
    }

    proc set-state {this value} {
        set path $widget::($this,path)
        set label $composite::($this,label,path)
        switch $value {
            normal {
                bind $path <Enter> {%W configure -relief raised}
                bind $label <ButtonPress-1> "imageButton::action $this 1"
                bind $label <ButtonRelease-1> "imageButton::action $this 0"
                $label configure -image $composite::($this,-image)
            }
            disabled {
                bind $path <Enter> {}
                bind $label <ButtonPress-1> {}
                bind $label <ButtonRelease-1> {}
                if {$composite::($this,-disabledgray)} {
                    if {![info exists ($this,-grayed)]} {
                        set image $composite::($this,-image)
                        set ($this,-grayed)\
                            [image create photo -width [image width $image] -height [image height $image] -palette 256 -gamma 2]
                        $($this,-grayed) copy $image
                    }
                    $label configure -image $($this,-grayed)
                }
            }
            default {
                error "bad state value \"$value\": must be normal or disabled"
            }
        }
        if {!$composite::($this,-disabledgray)} {
            $label configure -state $value
        }
    }

    proc update {this width height} {                                     ;# 2 x 1 pixel border + 1 pixel offset when shifting image
        $widget::($this,path) configure -width [incr width 3] -height [incr height 3]
    }

    proc action {this pressed} {
        if {$pressed} {
            relief $this 1
            set ($this,inside) 1
            bind $composite::($this,label,path) <Motion> "imageButton::motion $this %X %Y"
        } else {
            relief $this 0
            bind $composite::($this,label,path) <Motion> {}
            if {$($this,inside) && ([string length $composite::($this,-command)] > 0)} {
                uplevel #0 $composite::($this,-command)                                     ;# always invoke command at global level
                # in case a dialog box is opened on top of button in which case leave event is never seen:
                after 1000 "$widget::($this,path) configure -relief flat"
            }
        }
    }

    proc motion {this X Y} {                         ;# when button is kept pressed, leave events do not occur, so track cursor here
        set inside [string equal [winfo containing $X $Y] $composite::($this,label,path)]
        if {$inside == $($this,inside)} return                                                                          ;# no change
        if {$inside} {
            relief $this 1
        } else {
            relief $this 0
            $widget::($this,path) configure -relief flat                                             ;# emulate KDE buttons behavior
        }
        set ($this,inside) $inside
    }

    proc relief {this sunken} {
        set label $composite::($this,label,path)
        if {$sunken} {
            $widget::($this,path) configure -relief sunken
            place $label -x 1 -y 1                                                                      ;# shift to simulate sinking
            $label configure -background $widget::option(button,activebackground)
        } else {
            $widget::($this,path) configure -relief raised
            place $label -x 0 -y 0
            $label configure -background $widget::option(button,background)
        }
    }

}
