reorder tcl land into namespaces and streamline and standardize syntax

svn path=/trunk/externals/loaders/tclpd/; revision=15600

1 files changed, 273 insertions, 273 deletions

diff --git a/examples/bitmap.tcl b/examples/bitmap.tcl
index 43241d2..97b9491 100644
--- a/examples/bitmap.tcl
+++ b/examples/bitmap.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]]
 
@@ -27,320 +27,320 @@ pd::guiproc bitmap_draw_new {self c x y config data} {
         -outline $fgcolor -tags [list $self border$self]
 }
 
-pd::guiclass bitmap {
-    constructor {
-        set s [file join $::script_path properties.tcl]
-        sys_gui "source {$s}\n"
+proc+ bitmap::constructor {self args} {
+    set s [file join $::script_path properties.tcl]
+    sys_gui "source {$s}\n"
 
-        pd::add_outlet $self float
+    pd::add_outlet $self float
 
-        # set defaults:
-        set @config [list]
-        lappend @config -uwidth 8
-        lappend @config -uheight 8
-        lappend @config -cellsize 16
-        lappend @config -label ""
-        lappend @config -labelpos "top"
-        lappend @config -sendsymbol ""
-        lappend @config -receivesymbol ""
-        lappend @config -fgcolor "#000000"
-        lappend @config -bgcolor "#ffffff"
-        lappend @config -lblcolor "#000000"
-        set @data {
-            0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
-            0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
-            0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
-            0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
-        }
-        # expanded ($n) send/recv symbols:
-        set @send {}
-        set @recv {}
+    # set defaults:
+    set @config [list]
+    lappend @config -uwidth 8
+    lappend @config -uheight 8
+    lappend @config -cellsize 16
+    lappend @config -label ""
+    lappend @config -labelpos "top"
+    lappend @config -sendsymbol ""
+    lappend @config -receivesymbol ""
+    lappend @config -fgcolor "#000000"
+    lappend @config -bgcolor "#ffffff"
+    lappend @config -lblcolor "#000000"
+    set @data {
+        0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+        0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+        0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+        0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+    }
+    # expanded ($n) send/recv symbols:
+    set @send {}
+    set @recv {}
 
-        ::$self 0 config {*}$args
+    0_config $self {*}$args
 
-        set @rcvLoadData {#bitmap}
-        pd_bind [tclpd_get_instance_pd $self] [gensym $@rcvLoadData]
-    }
+    set @rcvLoadData {#bitmap}
+    pd_bind [tclpd_get_instance_pd $self] [gensym $@rcvLoadData]
+}
 
-    destructor {
-        set pdself [tclpd_get_instance_pd $self]
-        if {$@rcvLoadData != {}} {
-            #should not happen!
-            pd_unbind $pdself [gensym $@rcvLoadData]
-        }
-        if {[dict get $@config -receivesymbol] != {}} {
-            pd_unbind $pdself $@recv
-        }
+proc+ bitmap::destructor {self} {
+    set pdself [tclpd_get_instance_pd $self]
+    if {$@rcvLoadData != {}} {
+        #should not happen!
+        pd_unbind $pdself [gensym $@rcvLoadData]
+    }
+    if {[dict get $@config -receivesymbol] != {}} {
+        pd_unbind $pdself $@recv
     }
+}
 
-    0_config {
-        if {$args == {}} {
-            return $@config
-        } else {
-            set newconf [list]
-            set optlist [pd::strip_selectors $args]
-            set optlist [pd::strip_empty $optlist]
-            for {set i 0} {$i < [llength $optlist]} {} {
-                set k [lindex $optlist $i]
-                if {![dict exists $@config $k]} {
-                    return -code error "unknown option '$k'"
-                }
-                incr i
-                set v [lindex $optlist $i]
-                if {[lsearch -exact {-uwidth -uheight -cellsize} $k] != -1} {
-                    set v [expr {int($v)}]
-                }
-                dict set newconf $k $v
-                incr i
+proc+ bitmap::0_config {self args} {
+    if {$args == {}} {
+        return $@config
+    } else {
+        set newconf [list]
+        set optlist [pd::strip_selectors $args]
+        set optlist [pd::strip_empty $optlist]
+        for {set i 0} {$i < [llength $optlist]} {} {
+            set k [lindex $optlist $i]
+            if {![dict exists $@config $k]} {
+                return -code error "unknown option '$k'"
             }
-            if {[dict get $@config -uwidth] != [dict get $newconf -uwidth] ||
-                [dict get $@config -uheight] != [dict get $newconf -uheight]} {
-                $self 0 resize {*}[pd::add_selectors [list \
-                    [dict get $newconf -uwidth] \
-                    [dict get $newconf -uheight] \
-                    ]]
+            incr i
+            set v [lindex $optlist $i]
+            if {[lsearch -exact {-uwidth -uheight -cellsize} $k] != -1} {
+                set v [expr {int($v)}]
             }
-            set ui 0
-            foreach opt {label labelpos cellsize fgcolor bgcolor lblcolor} {
-                set old [dict get $@config -$opt]
-                if {[dict exists $newconf -$opt]} {
-                    set new [dict get $newconf -$opt]
-                    if {$old != $new} {
-                        dict set @config -$opt $new
-                        set ui 1
-                    }
+            dict set newconf $k $v
+            incr i
+        }
+        if {[dict get $@config -uwidth] != [dict get $newconf -uwidth] ||
+            [dict get $@config -uheight] != [dict get $newconf -uheight]} {
+            0_resize $self {*}[pd::add_selectors [list \
+                [dict get $newconf -uwidth] \
+                [dict get $newconf -uheight] \
+                ]]
+        }
+        set ui 0
+        foreach opt {label labelpos cellsize fgcolor bgcolor lblcolor} {
+            set old [dict get $@config -$opt]
+            if {[dict exists $newconf -$opt]} {
+                set new [dict get $newconf -$opt]
+                if {$old != $new} {
+                    dict set @config -$opt $new
+                    set ui 1
                 }
             }
-            foreach opt {sendsymbol receivesymbol} {
-                set old [dict get $@config -$opt]
-                if {[dict exists $newconf -$opt]} {
-                    set new [dict get $newconf -$opt]
-                    if {$old != $new} {
-                        if {$opt == "receivesymbol"} {
-                            set selfpd [tclpd_get_instance_pd $self]
-                            if {$old != {}} {
-                                pd_unbind $selfpd $@recv
-                            }
-                            if {$new != {}} {
-                                set @recv [canvas_realizedollar \
-                                    [tclpd_get_glist $self] [gensym $new]]
-                                pd_bind $selfpd $@recv
-                            } else {
-                                set @recv {}
-                            }
+        }
+        foreach opt {sendsymbol receivesymbol} {
+            set old [dict get $@config -$opt]
+            if {[dict exists $newconf -$opt]} {
+                set new [dict get $newconf -$opt]
+                if {$old != $new} {
+                    if {$opt == "receivesymbol"} {
+                        set selfpd [tclpd_get_instance_pd $self]
+                        if {$old != {}} {
+                            pd_unbind $selfpd $@recv
+                        }
+                        if {$new != {}} {
+                            set @recv [canvas_realizedollar \
+                                [tclpd_get_glist $self] [gensym $new]]
+                            pd_bind $selfpd $@recv
+                        } else {
+                            set @recv {}
                         }
-                        dict set @config -$opt $new
                     }
+                    dict set @config -$opt $new
                 }
             }
-            if {$ui && [info exists @c]} {
-                sys_gui [list $@c delete $self]\n
-                sys_gui [list bitmap_draw_new $self \
-                    $@c $@x $@y $@config $@data]\n
-            }
         }
-    }
-    
-    0_resize {
-        set w [pd::arg 0 int]
-        set h [pd::arg 1 int]
-        set oldw [dict get $@config -uwidth]
-        set oldh [dict get $@config -uheight]
-        set newd {}
-        for {set y 0} {$y < $h} {incr y} {
-            for {set x 0} {$x < $w} {incr x} {
-                if {$x < $oldw && $y < $oldh} {
-                    lappend newd [lindex $@data [expr {$y*$oldw+$x}]]
-                } else {
-                    lappend newd 0
-                }
-            }
+        if {$ui && [info exists @c]} {
+            sys_gui [list $@c delete $self]\n
+            sys_gui [list bitmap_draw_new $self \
+                $@c $@x $@y $@config $@data]\n
         }
-        dict set @config -uwidth $w
-        dict set @config -uheight $h
-        set @data $newd
     }
+}
 
-    0_getrow {
-        set r [list]
-        set n [pd::arg 0 int]
-        set w [dict get $@config -uwidth]
-        for {set i [expr {$n*$w}]} {$i < [expr {($n+1)*$w}]} {incr i} {
-            lappend r [list float [lindex $@data $i]]
+proc+ bitmap::0_resize {self args} {
+    set w [pd::arg 0 int]
+    set h [pd::arg 1 int]
+    set oldw [dict get $@config -uwidth]
+    set oldh [dict get $@config -uheight]
+    set newd {}
+    for {set y 0} {$y < $h} {incr y} {
+        for {set x 0} {$x < $w} {incr x} {
+            if {$x < $oldw && $y < $oldh} {
+                lappend newd [lindex $@data [expr {$y*$oldw+$x}]]
+            } else {
+                lappend newd 0
+            }
         }
-        pd::outlet $self 0 list $r
     }
+    dict set @config -uwidth $w
+    dict set @config -uheight $h
+    set @data $newd
+}
 
-    0_getcol {
-        set r [list]
-        set n [pd::arg 0 int]
-        set w [dict get $@config -uwidth]
-        set h [dict get $@config -uheight]
-        for {set i [expr {$n}]} {$i < [expr {$w*$h}]} {incr i $w} {
-            lappend r [list float [lindex $@data $i]]
-        }
-        pd::outlet $self 0 list $r
+proc+ bitmap::0_getrow {self args} {
+    set r [list]
+    set n [pd::arg 0 int]
+    set w [dict get $@config -uwidth]
+    for {set i [expr {$n*$w}]} {$i < [expr {($n+1)*$w}]} {incr i} {
+        lappend r [list float [lindex $@data $i]]
     }
+    pd::outlet $self 0 list $r
+}
 
-    0_getcell {
-        set r [pd::arg 0 int]
-        set c [pd::arg 1 int]
-        set w [dict get $@config -uwidth]
-        pd::outlet $self 0 float [lindex $@data [expr {$r*$w+$c}]]
+proc+ bitmap::0_getcol {self args} {
+    set r [list]
+    set n [pd::arg 0 int]
+    set w [dict get $@config -uwidth]
+    set h [dict get $@config -uheight]
+    for {set i [expr {$n}]} {$i < [expr {$w*$h}]} {incr i $w} {
+        lappend r [list float [lindex $@data $i]]
     }
+    pd::outlet $self 0 list $r
+}
 
-    0_setrow {
-        set row [pd::arg 0 int]
-        set z 1
-        set col 0
-        set w [dict get $@config -uwidth]
-        set fgcolor [dict get $@config -fgcolor]
-        set bgcolor [dict get $@config -bgcolor]
-        set colors [list $bgcolor $fgcolor]
-        for {set idx [expr {$row*$w}]} {$idx < [expr {($row+1)*$w}]} {incr idx} {
-            set d [expr {0!=[pd::arg $z int]}]
-            lset @data $idx $d
-            sys_gui [list $@c itemconfigure cell_${col}_${row}_$self \
-                -fill [lindex $colors $d]]\n
-            incr z
-            incr col
-        }
-    }
+proc+ bitmap::0_getcell {self args} {
+    set r [pd::arg 0 int]
+    set c [pd::arg 1 int]
+    set w [dict get $@config -uwidth]
+    pd::outlet $self 0 float [lindex $@data [expr {$r*$w+$c}]]
+}
 
-    0_setcol {
-        set col [pd::arg 0 int]
-        set z 1
-        set row 0
-        set w [dict get $@config -uwidth]
-        set h [dict get $@config -uheight]
-        set fgcolor [dict get $@config -fgcolor]
-        set bgcolor [dict get $@config -bgcolor]
-        set colors [list $bgcolor $fgcolor]
-        for {set idx [expr {$col}]} {$idx < [expr {$w*$h}]} {incr idx $w} {
-            set d [expr {0!=[pd::arg $z int]}]
-            lset @data $idx $d
-            sys_gui [list $@c itemconfigure cell_${col}_${row}_$self \
-                -fill [lindex $colors $d]]\n
-            incr z
-            incr row
-        }
+proc+ bitmap::0_setrow {self args} {
+    set row [pd::arg 0 int]
+    set z 1
+    set col 0
+    set w [dict get $@config -uwidth]
+    set fgcolor [dict get $@config -fgcolor]
+    set bgcolor [dict get $@config -bgcolor]
+    set colors [list $bgcolor $fgcolor]
+    for {set idx [expr {$row*$w}]} {$idx < [expr {($row+1)*$w}]} {incr idx} {
+        set d [expr {0!=[pd::arg $z int]}]
+        lset @data $idx $d
+        sys_gui [list $@c itemconfigure cell_${col}_${row}_$self \
+            -fill [lindex $colors $d]]\n
+        incr z
+        incr col
     }
+}
 
-    0_setcell {
-        set r [pd::arg 0 int]
-        set c [pd::arg 1 int]
-        set d [expr {0!=[pd::arg 2 int]}]
-        set w [dict get $@config -uwidth]
-        set fgcolor [dict get $@config -fgcolor]
-        set bgcolor [dict get $@config -bgcolor]
-        set colors [list $bgcolor $fgcolor]
-        set idx [expr {$r*$w+$c}]
+proc+ bitmap::0_setcol {self args} {
+    set col [pd::arg 0 int]
+    set z 1
+    set row 0
+    set w [dict get $@config -uwidth]
+    set h [dict get $@config -uheight]
+    set fgcolor [dict get $@config -fgcolor]
+    set bgcolor [dict get $@config -bgcolor]
+    set colors [list $bgcolor $fgcolor]
+    for {set idx [expr {$col}]} {$idx < [expr {$w*$h}]} {incr idx $w} {
+        set d [expr {0!=[pd::arg $z int]}]
         lset @data $idx $d
-        sys_gui [list $@c itemconfigure cell_${r}_${c}_$self \
+        sys_gui [list $@c itemconfigure cell_${col}_${row}_$self \
             -fill [lindex $colors $d]]\n
+        incr z
+        incr row
     }
+}
 
-    0_setdata {
-        set d [pd::strip_selectors $args]
-        set l [llength $d]
-        set w [dict get $@config -uwidth]
-        set h [dict get $@config -uheight]
-        if {$l != $w*$h} {
-            return -code error "bad data size"
-        }
-        set @data [list]
-        foreach i $d {lappend @data [expr {int($i)}]}
-        if {$@rcvLoadData != {}} {
-            pd_unbind [tclpd_get_instance_pd $self] [gensym $@rcvLoadData]
-            set @rcvLoadData {}
-        }
-    }
+proc+ bitmap::0_setcell {self args} {
+    set r [pd::arg 0 int]
+    set c [pd::arg 1 int]
+    set d [expr {0!=[pd::arg 2 int]}]
+    set w [dict get $@config -uwidth]
+    set fgcolor [dict get $@config -fgcolor]
+    set bgcolor [dict get $@config -bgcolor]
+    set colors [list $bgcolor $fgcolor]
+    set idx [expr {$r*$w+$c}]
+    lset @data $idx $d
+    sys_gui [list $@c itemconfigure cell_${r}_${c}_$self \
+        -fill [lindex $colors $d]]\n
+}
 
-    object_save {
-        return [list #X obj $@x $@y bitmap {*}[pd::add_empty $@config] \; \
-            \#bitmap setdata {*}$@data \; ]
+proc+ bitmap::0_setdata {self args} {
+    set d [pd::strip_selectors $args]
+    set l [llength $d]
+    set w [dict get $@config -uwidth]
+    set h [dict get $@config -uheight]
+    if {$l != $w*$h} {
+        return -code error "bad data size"
     }
-
-    object_properties {
-        set title "\[bitmap\] properties"
-        set x_xobj_obpd [tclpd_get_object_pd $self]
-        set x [tclpd_get_instance $self]
-        set buf [list propertieswindow %s $@config $title]\n
-        gfxstub_new $x_xobj_obpd $x $buf
+    set @data [list]
+    foreach i $d {lappend @data [expr {int($i)}]}
+    if {$@rcvLoadData != {}} {
+        pd_unbind [tclpd_get_instance_pd $self] [gensym $@rcvLoadData]
+        set @rcvLoadData {}
     }
+}
 
-    widgetbehavior_getrect {
-        lassign $args x1 y1
-        set w [dict get $@config -uwidth]
-        set h [dict get $@config -uheight]
-        set sz [dict get $@config -cellsize]
-        set x2 [expr {1+$x1+$w*$sz}]
-        set y2 [expr {1+$y1+$h*$sz}]
-        return [list $x1 $y1 $x2 $y2]
-    }
+proc+ bitmap::save {self args} {
+    return [list #X obj $@x $@y bitmap {*}[pd::add_empty $@config] \; \
+        \#bitmap setdata {*}$@data \; ]
+}
 
-    widgetbehavior_displace {
-        set dx [lindex $args 0]
-        set dy [lindex $args 1]
-        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+ bitmap::properties {self args} {
+    set title "\[bitmap\] properties"
+    set x_xobj_obpd [tclpd_get_object_pd $self]
+    set x [tclpd_get_instance $self]
+    set buf [list propertieswindow %s $@config $title]\n
+    gfxstub_new $x_xobj_obpd $x $buf
+}
 
-    widgetbehavior_select {
-        set sel [lindex $args 0]
-        set fgcolor [dict get $@config -fgcolor]
-        set bgcolor [dict get $@config -bgcolor]
-        set selcolor "blue"
-        set colors [list $selcolor $fgcolor]
-        sys_gui [list $@c itemconfigure $self \
-            -outline [lindex $colors $sel]]\n
-    }
+proc+ bitmap::widgetbehavior_getrect {self args} {
+    lassign $args x1 y1
+    set w [dict get $@config -uwidth]
+    set h [dict get $@config -uheight]
+    set sz [dict get $@config -cellsize]
+    set x2 [expr {1+$x1+$w*$sz}]
+    set y2 [expr {1+$y1+$h*$sz}]
+    return [list $x1 $y1 $x2 $y2]
+}
 
-    widgetbehavior_activate {
+proc+ bitmap::widgetbehavior_displace {self args} {
+    set dx [lindex $args 0]
+    set dy [lindex $args 1]
+    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_vis {
-        set @c [lindex $args 0]
-        set @x [lindex $args 1]
-        set @y [lindex $args 2]
-        set vis [lindex $args 3]
-        set w [dict get $@config -uwidth]
-        set h [dict get $@config -uheight]
-        set sz [dict get $@config -cellsize]
-        if {$vis} {
-            sys_gui [list bitmap_draw_new $self $@c $@x $@y $@config $@data]\n
-        } else {
-            sys_gui [list $@c delete $self]\n
-        }
+proc+ bitmap::widgetbehavior_select {self args} {
+    set sel [lindex $args 0]
+    set fgcolor [dict get $@config -fgcolor]
+    set bgcolor [dict get $@config -bgcolor]
+    set selcolor "blue"
+    set colors [list $selcolor $fgcolor]
+    sys_gui [list $@c itemconfigure $self \
+        -outline [lindex $colors $sel]]\n
+}
+
+proc+ bitmap::widgetbehavior_activate {self args} {
+}
+
+proc+ bitmap::widgetbehavior_vis {self args} {
+    set @c [lindex $args 0]
+    set @x [lindex $args 1]
+    set @y [lindex $args 2]
+    set vis [lindex $args 3]
+    set w [dict get $@config -uwidth]
+    set h [dict get $@config -uheight]
+    set sz [dict get $@config -cellsize]
+    if {$vis} {
+        sys_gui [list bitmap_draw_new $self $@c $@x $@y $@config $@data]\n
+    } else {
+        sys_gui [list $@c delete $self]\n
     }
+}
 
-    widgetbehavior_click {
-        set w [dict get $@config -uwidth]
-        set h [dict get $@config -uheight]
-        set sz [dict get $@config -cellsize]
-        set fgcolor [dict get $@config -fgcolor]
-        set bgcolor [dict get $@config -bgcolor]
-        set colors [list $bgcolor $fgcolor]
-        set xpix [expr {[lindex $args 0]-$@x-1}]
-        set ypix [expr {[lindex $args 1]-$@y-1}]
-        if {$xpix < 0 || $xpix >= $w*$sz} {return}
-        if {$ypix < 0 || $ypix >= $h*$sz} {return}
-        set shift [lindex $args 2]
-        set alt [lindex $args 3]
-        set dbl [lindex $args 4]
-        set doit [lindex $args 5]
-        if {$doit} {
-            set j [expr {$xpix/$sz}]
-            set i [expr {$ypix/$sz}]
-            set idx [expr {$w*${i}+${j}}]
-            set d [expr {[lindex $@data $idx]==0}]
-            lset @data $idx $d
-            sys_gui [list $@c itemconfigure cell_${j}_${i}_$self \
-                -fill [lindex $colors $d]]\n
-        }
+proc+ bitmap::widgetbehavior_click {self args} {
+    set w [dict get $@config -uwidth]
+    set h [dict get $@config -uheight]
+    set sz [dict get $@config -cellsize]
+    set fgcolor [dict get $@config -fgcolor]
+    set bgcolor [dict get $@config -bgcolor]
+    set colors [list $bgcolor $fgcolor]
+    set xpix [expr {[lindex $args 0]-$@x-1}]
+    set ypix [expr {[lindex $args 1]-$@y-1}]
+    if {$xpix < 0 || $xpix >= $w*$sz} {return}
+    if {$ypix < 0 || $ypix >= $h*$sz} {return}
+    set shift [lindex $args 2]
+    set alt [lindex $args 3]
+    set dbl [lindex $args 4]
+    set doit [lindex $args 5]
+    if {$doit} {
+        set j [expr {$xpix/$sz}]
+        set i [expr {$ypix/$sz}]
+        set idx [expr {$w*${i}+${j}}]
+        set d [expr {[lindex $@data $idx]==0}]
+        lset @data $idx $d
+        sys_gui [list $@c itemconfigure cell_${j}_${i}_$self \
+            -fill [lindex $colors $d]]\n
     }
 }
+
+pd::guiclass bitmap