# $Id: arrowbut.tcl,v 2.6 2002/05/30 17:13:10 jfontain Exp $


class arrowButton {}

proc arrowButton::arrowButton {this parentPath args} composite {
    [new canvas $parentPath\
        -relief $widget::option(button,relief) -background $widget::option(button,background)\
        -borderwidth $widget::option(button,borderwidth) -height $widget::option(scrollbar,width)\
        -highlightbackground $widget::option(button,highlightbackground) -highlightcolor $widget::option(button,highlightcolor)\
        -highlightthickness $widget::option(button,highlightthickness) -width $widget::option(scrollbar,width)\
    ] $args
} {
    set ($this,triangle) [$widget::($this,path) create polygon 0 0 0 0 0 0]
    bind $widget::($this,path) <Configure> "arrowButton::redraw $this %w %h"
    set ($this,active) 0
    composite::complete $this
}

proc arrowButton::~arrowButton {this} {}

proc arrowButton::options {this} {
    # force initialization on direction, on state to initialize foreground color
    # force takefocus initialization to initialize key bindings
    return [list\
        [list -activebackground $widget::option(button,activebackground) $widget::option(button,activebackground)]\
        [list -background $widget::option(button,background) $widget::option(button,background)]\
        [list -borderwidth $widget::option(button,borderwidth) $widget::option(button,borderwidth)]\
        [list -command {} {}]\
        [list -direction down]\
        [list -disabledforeground $widget::option(button,disabledforeground) $widget::option(button,disabledforeground)]\
        [list -foreground $widget::option(button,foreground) $widget::option(button,foreground)]\
        [list -height $widget::option(scrollbar,width) $widget::option(scrollbar,width)]\
        [list -highlightbackground $widget::option(button,highlightbackground) $widget::option(button,highlightbackground)]\
        [list -highlightcolor $widget::option(button,highlightcolor) $widget::option(button,highlightcolor)]\
        [list -highlightthickness $widget::option(button,highlightthickness) $widget::option(button,highlightthickness)]\
        [list -repeatdelay 0 0]\
        [list -state normal]\
        [list -takefocus 1]\
        [list -width $widget::option(scrollbar,width) $widget::option(scrollbar,width)]\
    ]
}

# nothing to do since value is automatically taken into account in binding sequence
proc arrowButton::set-activebackground {this value} {}

proc arrowButton::set-state {this value} {
    set path $widget::($this,path)
    switch $value {
        normal {
            $path itemconfigure $($this,triangle) -fill $composite::($this,-foreground) -outline $composite::($this,-foreground)
            bind $path <Enter> "arrowButton::activate $this"
            bind $path <Leave> "arrowButton::deactivate $this; arrowButton::raise $this"
            bind $path <ButtonPress-1>\
                "set arrowButton::($this,buttonPressed) 1; arrowButton::sink $this; arrowButton::startTimer $this"
            bind $path <ButtonRelease-1>\
                "arrowButton::raise $this; arrowButton::invoke $this 0; set arrowButton::($this,buttonPressed) 0"
            if {$composite::($this,-takefocus)} {
                bind $path <KeyPress-space> "arrowButton::sink $this"
                bind $path <KeyRelease-space> "arrowButton::raise $this; arrowButton::invoke $this 1"
            } else {
                bind $path <KeyPress-space> {}
                bind $path <KeyRelease-space> {}
            }
        }
        disabled {
            $path itemconfigure $($this,triangle)\
                -fill $composite::($this,-disabledforeground) -outline $composite::($this,-disabledforeground)
            bind $path <Enter> {}
            bind $path <Leave> {}
            bind $path <ButtonPress-1> {}
            bind $path <ButtonRelease-1> {}
            bind $path <KeyPress-space> {}
            bind $path <KeyRelease-space> {}
        }
        default {
            error "bad state value \"$value\": must be normal or disabled"
        }
    }
}

foreach option {-background -borderwidth -height -highlightbackground -highlightcolor -highlightthickness -width} {
    proc arrowButton::set$option {this value} "\$widget::(\$this,path) configure $option \$value"
}

foreach option {-disabledforeground -foreground} {                           ;# state option automatically updates foreground colors
    proc arrowButton::set$option {this value} {set-state $this $composite::($this,-state)}
}

proc arrowButton::set-command {this value} {}                                ;# do nothing, command is stored at the composite level

proc arrowButton::set-direction {this value} {                   ;# valid directions are down, up, left or right or any abbreviation
    if {\
        ([string first $value down]!=0)&&([string first $value up]!=0)&&\
        ([string first $value left]!=0)&&([string first $value right]!=0)\
    } {
        error "bad direction value \"$value\": must be down, up, left or right (or any abbreviation)"
    }
    redraw $this [winfo width $widget::($this,path)] [winfo height $widget::($this,path)]
}

proc arrowButton::set-takefocus {this value} {
    if {![regexp {^(0|1)$} $value]} {
        error "bad takefocus value \"$value\": must be 0 or 1"
    }
    $widget::($this,path) configure -takefocus $value
    set-state $this $composite::($this,-state)
}

proc arrowButton::set-repeatdelay {this value} {}                              ;# do nothing, delay is stored at the composite level

proc arrowButton::redraw {this width height} {
    # in all cases, make sure largest dimension is even for best shaping
    set insideWidth [expr {$width-2*($composite::($this,-borderwidth)+$composite::($this,-highlightthickness))}]
    set insideHeight [expr {$height-2*($composite::($this,-borderwidth)+$composite::($this,-highlightthickness))}]
    switch -glob $composite::($this,-direction) {
        d* {
            set insideWidth [maximum [expr {$insideWidth/4}] 1]
            $widget::($this,path) coords $($this,triangle) 0 0 [expr {2*$insideWidth}] 0 $insideWidth $insideWidth
        }
        u* {
            set insideWidth [maximum [expr {$insideWidth/4}] 1]
            $widget::($this,path) coords $($this,triangle) 0 0 [expr {2*$insideWidth}] 0 $insideWidth -$insideWidth
        }
        l* {
            set insideHeight [maximum [expr {$insideHeight/4}] 1]
            $widget::($this,path) coords $($this,triangle) 0 0 0 [expr {2*$insideHeight}] -$insideHeight $insideHeight
        }
        r* {
            set insideHeight [maximum [expr {$insideHeight/4}] 1]
            $widget::($this,path) coords $($this,triangle) 0 0 0 [expr {2*$insideHeight}] $insideHeight $insideHeight
        }
    }
    centerTriangle $this $width $height
}

proc arrowButton::centerTriangle {this width height} {
    set box [$widget::($this,path) bbox $($this,triangle)]
    $widget::($this,path) move $($this,triangle)\
        [expr {($width-[lindex $box 2]-[lindex $box 0])/2}] [expr {($height-[lindex $box 3]-[lindex $box 1])/2}]
}

proc arrowButton::activate {this} {
    $widget::($this,path) configure -background $composite::($this,-activebackground)
    set ($this,active) 1
}

proc arrowButton::deactivate {this} {
    $widget::($this,path) configure -background $composite::($this,-background)
    set ($this,active) 0
}

proc arrowButton::sink {this} {                                                 ;# public procedure for forcing button to sunk state
    set path $widget::($this,path)
    $path configure -relief sunken
    centerTriangle $this [winfo width $path] [winfo height $path]                                    ;# eventually recenter triangle
    $path move $($this,triangle) 1 1                                                  ;# and move it slightly to achieve a 3D effect
}

proc arrowButton::raise {this} {                                              ;# public procedure for forcing button to raised state
    set path $widget::($this,path)
    $path configure -relief raised
    centerTriangle $this [winfo width $path] [winfo height $path]                                               ;# recenter triangle
    if {[info exists ($this,event)]} {
        after cancel $($this,event)
        unset ($this,event)
    }
}

proc arrowButton::invoke {this fromKey} {
    if {([string length $composite::($this,-command)]>0)&&($($this,active)||$fromKey)} {
        uplevel #0 $composite::($this,-command)                            ;# always invoke command at global level as tk buttons do
    }
}

proc arrowButton::startTimer {this} {
    if {$composite::($this,-repeatdelay)>0} {
        set ($this,event) [after $composite::($this,-repeatdelay) "arrowButton::processTimer $this"]
    }
}

proc arrowButton::processTimer {this} {
    if {$($this,buttonPressed)} {
        startTimer $this
        invoke $this 0
    } else {
        unset ($this,event)
    }
}

proc arrowButton::maximum {a b} {return [expr {$a>$b?$a:$b}]}
