change [vslider2] to general purpose [slider2] (choose type with -orient horizontal/vertical)

svn path=/trunk/externals/tclpd/; revision=12370

1 files changed, 99 insertions, 68 deletions

diff --git a/vslider2.tcl b/slider2.tcl
index 0119c01..a09c9ce 100644
--- a/vslider2.tcl
+++ b/slider2.tcl
@@ -4,51 +4,63 @@ source pdlib.tcl
 
 set ::script_path [file dirname [info script]]
 
-pd::guiproc vslider2_draw_new {self c x y config} {
-    set headsz [dict get $config -headsz]
-    set x2 [expr {$x+[dict get $config -width]+1}]
-    set y2 [expr {$y+[dict get $config -height]+1}]
-    set fgcolor [dict get $config -fgcolor]
-    set bgcolor [dict get $config -bgcolor]
+pd::guiproc slider2_draw_new {self c x y config state} {
+    # import variables from dicts:
+    foreach v {headsz width height fgcolor bgcolor orient} \
+        {set $v [dict get $config -$v]}
+    set x2 [expr {$x+$width+1}]
+    set y2 [expr {$y+$height+1}]
     $c create rectangle $x $y $x2 $y2 \
         -outline $fgcolor -fill $bgcolor -tags [list $self border$self]
-    $c create rectangle $x [expr {$y2-$headsz}] $x2 $y2 \
-        -outline {} -fill $fgcolor -tags [list $self head$self]
-    vslider2_update $self $c $x $y $config
+    switch $orient {
+        horizontal {set y1 $y; set x3 [expr {$x+$headsz}]}
+        vertical {set y1 [expr {$y2-$headsz}]; set x3 $x2}
+    }
+    $c create rectangle $x $y1 $x3 $y2 -outline {} -fill $fgcolor \
+        -tags [list $self head$self]
+    slider2_update $self $c $x $y $config $state
 }
 
-pd::guiproc vslider2_update {self c x y config} {
-    set f [dict get $config -initvalue]
-    set w [dict get $config -width]
-    set h [dict get $config -height]
-    set b [dict get $config _min]
-    set t [dict get $config _max]
-    set r [dict get $config _rev]
-    set realvalue [expr {1.0*($f-$b)/($t-$b)}]
+pd::guiproc slider2_update {self c x y config state} {
+    # import variables from dicts:
+    foreach v {initvalue headsz width height label labelpos lblcolor orient} \
+        {set $v [dict get $config -$v]}
+    foreach v {min max rev} {set $v [dict get $state _$v]}
+    set realvalue [expr {1.0*($initvalue-$min)/($max-$min)}]
     if {$realvalue < 0.0} {set realvalue 0}
     if {$realvalue > 1.0} {set realvalue 1}
-    if {!$r} {set realvalue [expr {1.0-$realvalue}]}
-    set headsz [dict get $config -headsz]
-    set vr [expr {$h-$headsz}]
-    $c coords head$self $x [expr {$y+$vr*$realvalue}] \
-        [expr {$x+$w+1}] [expr {$y+$vr*$realvalue+$headsz}]
-    set lbl [dict get $config -label]
-    set lblpos [dict get $config -labelpos]
-    set lblcol [dict get $config -lblcolor]
+    if {$rev} {set realvalue [expr {1.0-$realvalue}]}
+    if {$orient == "vertical"} {set realvalue [expr {1.0-$realvalue}]}
+    switch $orient {
+        horizontal {
+            set hr [expr {$width-$headsz}]
+            $c coords head$self [expr {$x+$hr*$realvalue}] $y \
+                [expr {$x+$hr*$realvalue+$headsz}] [expr {$y+$height+1}]
+        }
+        vertical {
+            set vr [expr {$height-$headsz}]
+            $c coords head$self $x [expr {$y+$vr*$realvalue}] \
+                [expr {$x+$width+1}] [expr {$y+$vr*$realvalue+$headsz}]
+        }
+    }
     $c delete label$self
-    if {$lbl != {}} {
-        switch $lblpos {
-            top    {set lx [expr {$x+$w/2}]; set ly [expr {$y}]; set a "s"}
-            bottom {set lx [expr {$x+$w/2}]; set ly [expr {$y+$h+2}]; set a "n"}
-            left   {set lx [expr {$x}]; set ly [expr {$y+$h/2}]; set a "e"}
-            right  {set lx [expr {$x+$w+2}]; set ly [expr {$y+$h/2}]; set a "w"}
-        }
-        $c create text $lx $ly -anchor $a -text $lbl -fill $lblcol \
+    if {$label != {}} {
+        switch $labelpos {
+            top
+            {set lx [expr {$x+$width/2}]; set ly [expr {$y}]; set a "s"}
+            bottom
+            {set lx [expr {$x+$width/2}]; set ly [expr {$y+$height+2}]; set a "n"}
+            left
+            {set lx [expr {$x}]; set ly [expr {$y+$height/2}]; set a "e"}
+            right
+            {set lx [expr {$x+$width+2}]; set ly [expr {$y+$height/2}]; set a "w"}
+        }
+        $c create text $lx $ly -anchor $a -text $label -fill $lblcolor \
              -tags [list $self label$self]
     }
 }
 
-pd::guiclass vslider2 {
+pd::guiclass slider2 {
     constructor {
         pd::add_outlet $self float
         sys_gui "source {[file join $::script_path properties.tcl]}\n"
@@ -56,10 +68,10 @@ pd::guiclass vslider2 {
         set @config {
             -width 15 -height 130 -headsz 3 -rangebottom 0 -rangetop 127
             -init 0 -initvalue 0 -jumponclick 0 -label "" -labelpos "top"
-            -sendsymbol "" -receivesymbol ""
+            -orient "vertical" -sendsymbol "" -receivesymbol ""
             -fgcolor "#000000" -bgcolor "#ffffff" -lblcolor "#000000"
-            _min 0 _max 127 _rev 0
         }
+        set @state {_min 0 _max 127 _rev 0}
         # expanded ($n) send/recv symbols:
         set @send {}
         set @recv {}
@@ -77,13 +89,12 @@ pd::guiclass vslider2 {
     }
 
     0_config {
-        if {$args == {}} {return $@config}
         set newconf [list]
         set optlist [pd::strip_selectors $args]
         set optlist [pd::strip_empty $optlist]
         set int_opts {-width -height -cellsize}
         set bool_opts {-init -jumponclick}
-        set ui_opts {-fgcolor -bgcolor -lblcolor -width -height}
+        set ui_opts {-fgcolor -bgcolor -lblcolor -orient -width -height}
         set upd_opts {-rangebottom -rangetop -label -labelpos}
         set conn_opts {-sendsymbol -receivesymbol}
         set ui 0
@@ -119,50 +130,55 @@ pd::guiclass vslider2 {
                     [tclpd_get_glist $self] [gensym $new_send]]
             } else {set @send {}}
         }
+        # changing orient -> swap sizes
+        if {[dict exists $newconf -orient] && ![dict exists $newconf -width]
+            && ![dict exists $newconf -height]} {
+            dict set newconf -width [dict get $@config -height]
+            dict set newconf -height [dict get $@config -width]
+        }
         # no errors up to this point. we can safely merge options
         set @config [dict merge $@config $newconf]
         # adjust reverse range
         set a [dict get $@config -rangebottom]
         set b [dict get $@config -rangetop]
-        if {$a > $b} {
-            dict set @config _min $b
-            dict set @config _max $a
-            dict set @config _rev 1
-        } else {
-            dict set @config _min $a
-            dict set @config _max $b
-            dict set @config _rev 0
-        }
+        dict set @state _min [expr {$a>$b?$b:$a}]
+        dict set @state _max [expr {$a>$b?$a:$b}]
+        dict set @state _rev [expr {$a>$b}]
         # recompute pix2units conversion
-        set @pix2units [expr {1.0 * ( [dict get $@config -rangetop] - [dict get $@config -rangebottom]) / ( [dict get $@config -height] - [dict get $@config -headsz])}]
+        switch [dict get $@config -orient] {
+            horizontal {set dim [dict get $@config -width];  set mul  1}
+            vertical   {set dim [dict get $@config -height]; set mul -1}
+        }
+        set @pix2units [expr {(2.0 * [dict get $@state _rev] - 1.0) *
+            ( [dict get $@state _max] - [dict get $@state _min] ) *
+            $mul / ( $dim - [dict get $@config -headsz])}]
         # if ui changed, update it
         if {$ui && [info exists @c]} {
             sys_gui [list $@c delete $self]\n
-            sys_gui [list vslider2_draw_new $self $@c $@x $@y $@config]\n
+            sys_gui [list slider2_draw_new $self $@c $@x $@y $@config $@state]\n
         } elseif {$upd && [info exists @c]} {
-            sys_gui [list vslider2_update $self $@c $@x $@y $@config]\n
+            sys_gui [list slider2_update $self $@c $@x $@y $@config $@state]\n
         }
     }
     
     0_set {
+        foreach v {min max} {set $v [dict get $@state _$v]}
         set f [pd::arg 0 float]
-        set b [dict get $@config _min]
-        set t [dict get $@config _max]
-        if {$f < $b} {set f $b}
-        if {$f > $t} {set f $t}
+        if {$f < $min} {set f $min}
+        if {$f > $max} {set f $max}
         dict set @config -initvalue $f
         if {[info exists @c]} {
             # update ui:
-            sys_gui [list vslider2_update $self $@c $@x $@y $@config]\n
+            sys_gui [list slider2_update $self $@c $@x $@y $@config $@state]\n
         }
     }
 
     0_bang {
-        set f [dict get $@config -initvalue]
-        pd::outlet $self 0 float $f
+        foreach v {initvalue} {set $v [dict get $@config -$v]}
+        pd::outlet $self 0 float $initvalue
         if {$@send != {}} {
             set s_thing [$@send cget -s_thing]
-            if {$s_thing != {NULL}} {pd_float $s_thing $f}
+            if {$s_thing != {NULL}} {pd_float $s_thing $initvalue}
         }
     }
 
@@ -172,12 +188,12 @@ pd::guiclass vslider2 {
     }
 
     object_save {
-        return [list #X obj $@x $@y vslider2 {*}[pd::add_empty $@config] \;]
+        return [list #X obj $@x $@y slider2 {*}[pd::add_empty $@config] \;]
     }
 
     object_properties {
         gfxstub_new [tclpd_get_object_pd $self] [tclpd_get_instance $self] \
-            [list propertieswindow %s $@config "\[vslider2\] properties"]\n
+            [list propertieswindow %s $@config "\[slider2\] properties"]\n
     }
 
     widgetbehavior_getrect {
@@ -190,8 +206,7 @@ pd::guiclass vslider2 {
     widgetbehavior_displace {
         lassign $args dx dy
         if {$dx != 0 || $dy != 0} {
-            incr @x $dx
-            incr @y $dy
+            incr @x $dx; incr @y $dy
             sys_gui [list $@c move $self $dx $dy]\n
         }
         return [list $@x $@y]
@@ -199,14 +214,14 @@ pd::guiclass vslider2 {
 
     widgetbehavior_select {
         lassign $args sel
-        sys_gui [list $@c itemconfigure $self -outline [lindex \
+        sys_gui [list $@c itemconfigure $self&&!label$self -outline [lindex \
             [list [dict get $@config -fgcolor] {blue}] $sel]]\n
     }
 
     widgetbehavior_vis {
         lassign $args @c @x @y vis
         if {$vis} {
-            sys_gui [list vslider2_draw_new $self $@c $@x $@y $@config]\n
+            sys_gui [list slider2_draw_new $self $@c $@x $@y $@config $@state]\n
         } else {
             sys_gui [list $@c delete $self]\n
         }
@@ -218,8 +233,16 @@ pd::guiclass vslider2 {
         set ypix [expr {[lindex $args 1]-$@y-1}]
         if {$ypix < 0 || $ypix >= $h} {return}
         if {$doit} {
-            set @motion_start_y $y
-            set @motion_curr_y $y
+            switch [dict get $@config -orient] {
+                horizontal {
+                    set @motion_start_x $x
+                    set @motion_curr_x $x
+                }
+                vertical {
+                    set @motion_start_y $y
+                    set @motion_curr_y $y
+                }
+            }
             set @motion_start_v [dict get $@config -initvalue]
             tclpd_guiclass_grab [tclpd_get_instance $self] \
                 [tclpd_get_glist $self] $x $y
@@ -228,8 +251,16 @@ pd::guiclass vslider2 {
 
     widgetbehavior_motion {
         lassign $args dx dy
-        set @motion_curr_y [expr {$dy+$@motion_curr_y}]
-        set pixdelta [expr {-1*($@motion_curr_y-$@motion_start_y)}]
+        switch [dict get $@config -orient] {
+            horizontal {
+                set @motion_curr_x [expr {$dx+$@motion_curr_x}]
+                set pixdelta [expr {-1*($@motion_curr_x-$@motion_start_x)}]
+            }
+            vertical {
+                set @motion_curr_y [expr {$dy+$@motion_curr_y}]
+                set pixdelta [expr {-1*($@motion_curr_y-$@motion_start_y)}]
+            }
+        }
         set f [expr {$@motion_start_v+$pixdelta*$@pix2units}]
         $self 0 float {*}[pd::add_selectors [list $f]]
     }