diff options
| -rw-r--r-- | slider2.tcl (renamed from vslider2.tcl) | 167 |
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]] } |