# hoppingslider
# derived from ttk::scale, implements -resolution found in older scale
package require snit

snit::widgetadaptor hoppingslider {

        option -resolution -default 1.0
        option -variable -configuremethod SetVariable
        option -command

        delegate option * to hull except -command
        delegate method * to hull

        variable oldval
        variable modified

        constructor { args } {
                installhull using ttk::scale -command [mymethod resolution]
                $self configurelist $args
                $hull configure -variable $options(-variable)
                set oldval [$hull cget -value]
                set modified false
                bind $self <ButtonPress-1> [mymethod ButtonPress]
                bind $self <ButtonPress-2> [mymethod ButtonPress]
                bind $self <ButtonPress-3> [mymethod ButtonPress]
                bind $self <ButtonRelease-1> [mymethod ButtonReleased]
                bind $self <ButtonRelease-2> [mymethod ButtonReleased]
                bind $self <ButtonRelease-3> [mymethod ButtonReleased]
        }

        method SetVariable { -variable varname } {
                set options(-variable) $varname
                $hull configure -variable $varname
                if { $varname ne {} } {
                        upvar #0 $varname tracevar
                        if { ![info exists tracevar] } { set tracevar [$hull cget -from] }
                        set oldval $tracevar
                }
        }

        method resolution { val } {

                # round value to nearest multiple of resolution
                set res $options(-resolution)
                set hopval [expr {$res * floor(double($val) / $res + 0.5)}]
                if { $options(-variable) ne {} } {
                        upvar #0 $options(-variable) var
                        set var $hopval
                }

                # run callback as in standard scale
                # only for a different value == integer hop
                if { $hopval != $oldval } {
                        set oldval $hopval
                        set modified true
                        if { $options(-command) ne {} } {
                                set command_with_value [linsert $options(-command) end $hopval]
                                uplevel #0 $command_with_value
                        }
                }

                return $hopval

        }

        method ButtonPress {} { set oldval [$hull cget -value] }

        method ButtonReleased {} {
                # when the mouse button is released, and the value was modified
                # generate release event
                if { $modified } {
                        event generate $win <<SliderReleased>>
                        set modified false
                }
        }

        #--------------------------test------------------------------#
        typemethod htest {} {
                toplevel .t
                pack [hoppingslider .t.l -from -10 -to 10 -resolution 2.0 -variable test -command echo] -expand yes -fill x
        }

}