From 9ea4e9fc1b4775a0e6b1c387a2a0965686c1c20e Mon Sep 17 00:00:00 2001
From: mescalinum <mescalinum@users.sourceforge.net>
Date: Fri, 14 Oct 2011 21:32:49 +0000
Subject: reorder tcl land into namespaces and streamline and standardize
 syntax

svn path=/trunk/externals/loaders/tclpd/; revision=15600
---
 examples/slider2.tcl | 366 +++++++++++++++++++++++++--------------------------
 1 file changed, 183 insertions(+), 183 deletions(-)

(limited to 'examples/slider2.tcl')

diff --git a/examples/slider2.tcl b/examples/slider2.tcl
index 23a2141..adc2e35 100644
--- a/examples/slider2.tcl
+++ b/examples/slider2.tcl
@@ -1,5 +1,5 @@
-package require Tclpd 0.2.2
-package require TclpdLib 0.17
+package require Tclpd 0.2.3
+package require TclpdLib 0.19
 
 set ::script_path [file dirname [info script]]
 
@@ -59,215 +59,215 @@ pd::guiproc slider2_update {self c x y config state} {
     }
 }
 
-pd::guiclass slider2 {
-    constructor {
-        pd::add_outlet $self float
-        sys_gui "source {[file join $::script_path properties.tcl]}\n"
-        # set defaults:
-        set @config {
-            -width 15 -height 130 -headsz 3 -rangebottom 0 -rangetop 127
-            -init 0 -initvalue 0 -jumponclick 0 -label "" -labelpos "top"
-            -orient "vertical" -sendsymbol "" -receivesymbol ""
-            -fgcolor "#000000" -bgcolor "#ffffff" -lblcolor "#000000"
-        }
-        set @state {_min 0 _max 127 _rev 0}
-        # expanded ($n) send/recv symbols:
-        set @send {}
-        set @recv {}
-        ::$self 0 config {*}$args
+proc+ slider2::constructor {self args} {
+    pd::add_outlet $self float
+    sys_gui "source {[file join $::script_path properties.tcl]}\n"
+    # set defaults:
+    set @config {
+        -width 15 -height 130 -headsz 3 -rangebottom 0 -rangetop 127
+        -init 0 -initvalue 0 -jumponclick 0 -label "" -labelpos "top"
+        -orient "vertical" -sendsymbol "" -receivesymbol ""
+        -fgcolor "#000000" -bgcolor "#ffffff" -lblcolor "#000000"
     }
+    set @state {_min 0 _max 127 _rev 0}
+    # expanded ($n) send/recv symbols:
+    set @send {}
+    set @recv {}
+    0_config $self {*}$args
+}
 
-    destructor {
-        if {[dict get $@config -receivesymbol] != {}} {
-            pd_unbind [tclpd_get_instance_pd $self] $@recv
-        }
+proc+ slider2::destructor {self} {
+    if {[dict get $@config -receivesymbol] != {}} {
+        pd_unbind [tclpd_get_instance_pd $self] $@recv
     }
+}
 
-    0_loadbang {
-        if {[dict get $@config -init]} {$self 0 bang}
-    }
+proc+ slider2::0_loadbang {self} {
+    if {[dict get $@config -init]} {0_bang $self}
+}
 
-    0_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 -orient -width -height}
-        set upd_opts {-rangebottom -rangetop -label -labelpos}
-        set conn_opts {-sendsymbol -receivesymbol}
-        set ui 0
-        set upd 0
-        foreach {k v} $optlist {
-            if {![dict exists $@config $k]} {
-                return -code error "unknown option '$k'"
-            }
-            if {[dict get $@config $k] == $v} {continue}
-            if {[lsearch -exact $int_opts $k] != -1} {set v [expr {int($v)}]}
-            if {[lsearch -exact $bool_opts $k] != -1} {set v [expr {int($v)!=0}]}
-            if {[lsearch -exact $ui_opts $k] != -1} {set ui 1}
-            if {[lsearch -exact $upd_opts $k] != -1} {set upd 1}
-            dict set newconf $k $v
-        }
-        # process -{send,receive}symbol
-        if {[dict exists $newconf -receivesymbol]} {
-            set new_recv [dict get $newconf -receivesymbol]
-            set selfpd [tclpd_get_instance_pd $self]
-            if {[dict get $@config -receivesymbol] != {}} {
-                pd_unbind $selfpd $@recv
-            }
-            if {$new_recv != {}} {
-                set @recv [canvas_realizedollar \
-                    [tclpd_get_glist $self] [gensym $new_recv]]
-                pd_bind $selfpd $@recv
-            } else {set @recv {}}
-        }
-        if {[dict exists $newconf -sendsymbol]} {
-            set new_send [dict get $newconf -sendsymbol]
-            if {$new_send != {}} {
-                set @send [canvas_realizedollar \
-                    [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]
-        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}]
-        set orient [dict get $@config -orient]
-        switch $orient {
-            horizontal {set dim [dict get $@config -width];  set mul  1}
-            vertical   {set dim [dict get $@config -height]; set mul -1}
-            default {return -code error "invalid value '$orient' for -orient"}
-        }
-        # recompute pix2units conversion
-        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 slider2_draw_new $self $@c $@x $@y $@config $@state]\n
-        } elseif {$upd && [info exists @c]} {
-            sys_gui [list slider2_update $self $@c $@x $@y $@config $@state]\n
-        }
-        if {[dict exists $newconf -width] || [dict exists $newconf -height]} {
-            canvas_fixlinesfor \
-                [tclpd_get_glist $self] [tclpd_get_instance_text $self]
+proc+ slider2::0_config {self args} {
+    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 -orient -width -height}
+    set upd_opts {-rangebottom -rangetop -label -labelpos}
+    set conn_opts {-sendsymbol -receivesymbol}
+    set ui 0
+    set upd 0
+    foreach {k v} $optlist {
+        if {![dict exists $@config $k]} {
+            return -code error "unknown option '$k'"
         }
+        if {[dict get $@config $k] == $v} {continue}
+        if {[lsearch -exact $int_opts $k] != -1} {set v [expr {int($v)}]}
+        if {[lsearch -exact $bool_opts $k] != -1} {set v [expr {int($v)!=0}]}
+        if {[lsearch -exact $ui_opts $k] != -1} {set ui 1}
+        if {[lsearch -exact $upd_opts $k] != -1} {set upd 1}
+        dict set newconf $k $v
     }
-    
-    0_set {
-        foreach v {min max} {set $v [dict get $@state _$v]}
-        set f [pd::arg 0 float]
-        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 slider2_update $self $@c $@x $@y $@config $@state]\n
+    # process -{send,receive}symbol
+    if {[dict exists $newconf -receivesymbol]} {
+        set new_recv [dict get $newconf -receivesymbol]
+        set selfpd [tclpd_get_instance_pd $self]
+        if {[dict get $@config -receivesymbol] != {}} {
+            pd_unbind $selfpd $@recv
         }
+        if {$new_recv != {}} {
+            set @recv [canvas_realizedollar \
+                [tclpd_get_glist $self] [gensym $new_recv]]
+            pd_bind $selfpd $@recv
+        } else {set @recv {}}
     }
-
-    0_bang {
-        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 $initvalue}
-        }
+    if {[dict exists $newconf -sendsymbol]} {
+        set new_send [dict get $newconf -sendsymbol]
+        if {$new_send != {}} {
+            set @send [canvas_realizedollar \
+                [tclpd_get_glist $self] [gensym $new_send]]
+        } else {set @send {}}
     }
-
-    0_float {
-        $self 0 set {*}$args
-        $self 0 bang
+    # 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]
     }
-
-    object_save {
-        return [list #X obj $@x $@y slider2 {*}[pd::add_empty $@config] \;]
+    # 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]
+    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}]
+    set orient [dict get $@config -orient]
+    switch $orient {
+        horizontal {set dim [dict get $@config -width];  set mul  1}
+        vertical   {set dim [dict get $@config -height]; set mul -1}
+        default {return -code error "invalid value '$orient' for -orient"}
     }
-
-    object_properties {
-        set c [string map {$ \\$} $@config]
-        gfxstub_new [tclpd_get_object_pd $self] [tclpd_get_instance $self] \
-            [list propertieswindow %s $c "\[slider2\] properties"]\n
+    # recompute pix2units conversion
+    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 slider2_draw_new $self $@c $@x $@y $@config $@state]\n
+    } elseif {$upd && [info exists @c]} {
+        sys_gui [list slider2_update $self $@c $@x $@y $@config $@state]\n
     }
-
-    widgetbehavior_getrect {
-        lassign $args x1 y1
-        set x2 [expr {1+$x1+[dict get $@config -width]}]
-        set y2 [expr {1+$y1+[dict get $@config -height]}]
-        return [list $x1 $y1 $x2 $y2]
+    if {[dict exists $newconf -width] || [dict exists $newconf -height]} {
+        canvas_fixlinesfor \
+            [tclpd_get_glist $self] [tclpd_get_instance_text $self]
     }
+}
 
-    widgetbehavior_displace {
-        lassign $args dx dy
-        if {$dx != 0 || $dy != 0} {
-            incr @x $dx; incr @y $dy
-            sys_gui [list $@c move $self $dx $dy]\n
-        }
-        return [list $@x $@y]
+proc+ slider2::0_set {self args} {
+    foreach v {min max} {set $v [dict get $@state _$v]}
+    set f [pd::arg 0 float]
+    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 slider2_update $self $@c $@x $@y $@config $@state]\n
     }
+}
 
-    widgetbehavior_select {
-        lassign $args sel
-        sys_gui [list $@c itemconfigure $self&&!label$self -outline [lindex \
-            [list [dict get $@config -fgcolor] {blue}] $sel]]\n
+proc+ slider2::0_bang {self} {
+    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 $initvalue}
     }
+}
 
-    widgetbehavior_vis {
-        lassign $args @c @x @y vis
-        if {$vis} {
-            sys_gui [list slider2_draw_new $self $@c $@x $@y $@config $@state]\n
-        } else {
-            sys_gui [list $@c delete $self]\n
-        }
+proc+ slider2::0_float {self args} {
+    0_set $self {*}$args
+    0_bang $self
+}
+
+proc+ slider2::save {self} {
+    return [list #X obj $@x $@y slider2 {*}[pd::add_empty $@config] \;]
+}
+
+proc+ slider2::properties {self} {
+    set c [string map {$ \\$} $@config]
+    gfxstub_new [tclpd_get_object_pd $self] [tclpd_get_instance $self] \
+        [list propertieswindow %s $c "\[slider2\] properties"]\n
+}
+
+proc+ slider2::widgetbehavior_getrect {self args} {
+    lassign $args x1 y1
+    set x2 [expr {1+$x1+[dict get $@config -width]}]
+    set y2 [expr {1+$y1+[dict get $@config -height]}]
+    return [list $x1 $y1 $x2 $y2]
+}
+
+proc+ slider2::widgetbehavior_displace {self args} {
+    lassign $args dx dy
+    if {$dx != 0 || $dy != 0} {
+        incr @x $dx; incr @y $dy
+        sys_gui [list $@c move $self $dx $dy]\n
     }
+    return [list $@x $@y]
+}
 
-    widgetbehavior_click {
-        lassign $args x y shift alt dbl doit
-        set h [dict get $@config -height]
-        set ypix [expr {[lindex $args 1]-$@y-1}]
-        if {$ypix < 0 || $ypix >= $h} {return}
-        if {$doit} {
-            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
-        }
+proc+ slider2::widgetbehavior_select {self args} {
+    lassign $args sel
+    sys_gui [list $@c itemconfigure $self&&!label$self -outline [lindex \
+        [list [dict get $@config -fgcolor] {blue}] $sel]]\n
+}
+
+proc+ slider2::widgetbehavior_vis {self args} {
+    lassign $args @c @x @y vis
+    if {$vis} {
+        sys_gui [list slider2_draw_new $self $@c $@x $@y $@config $@state]\n
+    } else {
+        sys_gui [list $@c delete $self]\n
     }
+}
 
-    widgetbehavior_motion {
-        lassign $args dx dy
+proc+ slider2::widgetbehavior_click {self args} {
+    lassign $args x y shift alt dbl doit
+    set h [dict get $@config -height]
+    set ypix [expr {[lindex $args 1]-$@y-1}]
+    if {$ypix < 0 || $ypix >= $h} {return}
+    if {$doit} {
         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)}]
+                set @motion_start_x $x
+                set @motion_curr_x $x
             }
             vertical {
-                set @motion_curr_y [expr {$dy+$@motion_curr_y}]
-                set pixdelta [expr {-1*($@motion_curr_y-$@motion_start_y)}]
+                set @motion_start_y $y
+                set @motion_curr_y $y
             }
         }
-        set f [expr {$@motion_start_v+$pixdelta*$@pix2units}]
-        $self 0 float {*}[pd::add_selectors [list $f]]
+        set @motion_start_v [dict get $@config -initvalue]
+        tclpd_guiclass_grab [tclpd_get_instance $self] \
+            [tclpd_get_glist $self] $x $y
+    }
+}
+
+proc+ slider2::widgetbehavior_motion {self args} {
+    lassign $args dx dy
+    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}]
+    0_float $self {*}[pd::add_selectors [list $f]]
 }
+
+pd::guiclass slider2
-- 
cgit v1.2.1