add usage examples and help

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

5 files changed, 115 insertions, 27 deletions

diff --git a/dynroute-help.pd b/dynroute-help.pd
new file mode 100644
index 0000000..c337c2a
--- /dev/null
+++ b/dynroute-help.pd
@@ -0,0 +1,19 @@
+#N canvas 614 114 786 430 10;
+#X obj 102 189 dynroute 4;
+#X msg 73 63 apple red \, banana yellow \, pear green \, apple yellow
+\, strawberry red;
+#X obj 80 131 list prepend;
+#X obj 100 230 print 0;
+#X obj 160 230 print 1;
+#X obj 220 230 print 2;
+#X obj 280 230 print 3;
+#X msg 236 104 clear \, add apple 0 \, add banana 1 \, add pear 2;
+#X msg 242 138 remove pear 2 \, add pear 0 \, add strawberry 2;
+#X connect 0 0 3 0;
+#X connect 0 1 4 0;
+#X connect 0 2 5 0;
+#X connect 0 3 6 0;
+#X connect 1 0 2 0;
+#X connect 2 0 0 0;
+#X connect 7 0 0 1;
+#X connect 8 0 0 1;
diff --git a/dynroute.tcl b/dynroute.tcl
new file mode 100644
index 0000000..ef8553c
--- /dev/null
+++ b/dynroute.tcl
@@ -0,0 +1,56 @@
+source pdlib.tcl
+
+# dynroute: dynamically route messages based on first element
+# non-matching arguments are sent to last inlet
+# constructor: <float>   specify the number of outlets (default: 1)
+# send commands to the right inlet
+# available commands:
+# add <atom> <float>     route selector <atom> to output number <float>
+# remove <atom> <float>  remove previously created routing
+# clear
+
+pd::class dynroute {
+    constructor {
+        pd::add_inlet $self list
+
+        set @num_outlets [pd::arg 0 int]
+        if {$@num_outlets < 0} {set @num_outlets 2}
+
+        for {set i 0} {$i < $@num_outlets} {incr i} {
+            pd::add_outlet $self list
+        }
+
+        set @routing {}
+    }
+
+    0_list {
+        set sel [pd::arg 0 any]
+        set out [expr {$@num_outlets-1}]
+        catch {set out [dict get $@routing $sel]}
+        pd::outlet $self $out list $args
+    }
+
+    1_add {
+        set sel [pd::arg 0 any]
+        set out [pd::arg 1 int]
+        if {$out < 0 || $out >= $@num_outlets} {
+            pd::post "error: add: outlet number out of range"
+            return
+        }
+        dict set @routing $sel $out
+    }
+
+    1_remove {
+        set sel [pd::arg 0 any]
+        set out [pd::arg 1 int]
+        if {$out < 0 || $out >= $@num_outlets} {
+            pd::post "error: add: outlet number out of range"
+            return
+        }
+        catch {dict unset @routing $sel $out}
+    }
+
+    1_clear {
+        set @routing {}
+    }
+}
diff --git a/list_change-help.pd b/list_change-help.pd
new file mode 100644
index 0000000..430b23d
--- /dev/null
+++ b/list_change-help.pd
@@ -0,0 +1,21 @@
+#N canvas 617 384 635 406 10;
+#X obj 54 240 list_change;
+#X text 144 236 right inlet sets internal value without output anything
+;
+#X obj 71 271 bng 15 250 50 0 empty empty empty 17 7 0 10 -262144 -1
+-1;
+#X obj 54 309 print;
+#X text 33 21 Outputs its input (a list) only when it changes. You
+can set the current value using the right inlet \, or bang to force
+output;
+#X msg 117 201 list foo bar;
+#X msg 69 140 list foo bar;
+#X msg 77 163 list bar baz;
+#X msg 54 104 bang;
+#X text 98 103 output current value;
+#X connect 0 0 2 0;
+#X connect 0 0 3 0;
+#X connect 5 0 0 1;
+#X connect 6 0 0 0;
+#X connect 7 0 0 0;
+#X connect 8 0 0 0;
diff --git a/list_change.tcl b/list_change.tcl
index de13a20..8e0838d 100644
--- a/list_change.tcl
+++ b/list_change.tcl
@@ -1,7 +1,6 @@
 source pdlib.tcl
 
 pd::class list_change {
-
     constructor {
         # add second inlet (first created by default)
         pd::add_inlet $self list
diff --git a/pdlib.tcl b/pdlib.tcl
index 29fe8b3..c349dfd 100644
--- a/pdlib.tcl
+++ b/pdlib.tcl
@@ -129,38 +129,31 @@ namespace eval ::pd {
         poststring2 [concat {*}$args]
     }
 
-    proc assert= {a b} {
-        if {$a != $b} {
-            post "ASSERTION FAILED: \"$a\" == \"$b\""
-            return 0
-        }
-        return 1
-    }
-
     proc args {} {
         return [uplevel 1 "llength \$args"]
     }
 
-    proc arg_float {n} {
+    proc arg {n {assertion any}} {
         set v [uplevel 1 "lindex \$args $n"]
+        set i 0
         foreach {selector value} $v {break}
-        assert= $selector "float"
-        return $value
-    }
-
-    proc arg_int {n} {
-        set v [uplevel 1 "lindex \$args $n"]
-        foreach {selector value} $v {break}
-        assert= $selector "float"
-        return [expr {int($value)}]
-    }
-
-    proc arg_symbol {n} {
-        set v [uplevel 1 "lindex \$args $n"]
-        foreach {selector value} $v {break}
-        assert= $selector "symbol"
-        return $value
+        if {$assertion == {int}} {
+            set assertion {float}
+            set i 1
+        }
+        if {$assertion != {any}} {
+            if {$selector != $assertion} {
+                return -code error "arg #$n is $selector, must be $assertion"
+            }
+        }
+        if {$assertion == {float} && $i && $value != int($value)} {
+            return -code error "arg #$n is float, must be int"
+        }
+        if {$assertion == {float} && $i} {
+            return [expr {int($value)}]
+        } else {
+            return $value
+        }
     }
-
 }