proxyinlet support working and generally everything working fine (in the list_change use case)

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

7 files changed, 41 insertions, 118 deletions

diff --git a/Makefile b/Makefile
index a32339d..8392fef 100644
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
 #!/usr/bin/make
 
-DEBUG=1
+DEBUG=0
 OS = linux
 
 ifeq ($(DEBUG),1)
diff --git a/list_change.tcl b/list_change.tcl
index de2cfee..de13a20 100644
--- a/list_change.tcl
+++ b/list_change.tcl
@@ -13,21 +13,19 @@ pd::class list_change {
     }
 
     0_list {
-        puts stderr "**** called [info level 0]"
-        puts stderr ">> inlet 0 is [pd::inlet $self 0]"
-        puts stderr ">> inlet 1 is [pd::inlet $self 1]"
-        #if {$args != $@curlist} {
-        #    set @curlist $args
-        #    pd::outlet $self 0 list $@curlist
-            #0_bang
-        #}
+        # HOT inlet
+        if {$args != $@curlist} {
+            set @curlist $args
+            pd::outlet $self 0 list $@curlist
+        }
     }
 
     0_bang {
-        puts stderr "**** called [info level 0]"
-        puts stderr ">> inlet 0 is [pd::inlet $self 0]"
-        puts stderr ">> inlet 1 is [pd::inlet $self 1]"
-        #pd::outlet $self 0 list $@curlist
+        pd::outlet $self 0 list $@curlist
     }
 
+    1_list {
+        # COLD inlet
+        set @curlist $args
+    }
 }
diff --git a/pdlib.tcl b/pdlib.tcl
index 27347c9..29fe8b3 100644
--- a/pdlib.tcl
+++ b/pdlib.tcl
@@ -1,93 +1,32 @@
 # TCL objectized library for PD api
-# by Federico Ferri <mescalinum@gmail.com> - 2007
+# by Federico Ferri <mescalinum@gmail.com> - (C) 2007-2009
 
 package provide pdlib 0.1
 
 package require Tcl 8.5
 
-set verbose 1
+set verbose 0
 
 namespace eval ::pd {
     proc error_msg {m} {
         return "pdlib: [uplevel {lindex [info level 0] 0}]: error: $m"
     }
 
-    # create additional inlets with this
     proc add_inlet {self sel} {
         if $::verbose {post [info level 0]}
         variable _
-        switch -- $sel {
-            float {
-                set ptr [new_t_float]
-                lappend _($self:p_inlet) $ptr
-                lappend _($self:t_inlet) "float"
-                #lappend _($self:x_inlet) [floatinlet_new [tclpd_get_object $self] $ptr]
-            }
-            symbol {
-                set ptr [new_t_symbol]
-                lappend _($self:p_inlet) $ptr
-                lappend _($self:t_inlet) "symbol"
-                #lappend _($self:x_inlet) [symbolinlet_new [tclpd_get_object $self] $ptr]
-            }
-            list {
-                # none selector means cold inlet
-                set ptr [tclpd_add_proxyinlet [tclpd_get_instance $self] [gensym none]]
-                lappend _($self:p_inlet) $ptr
-                lappend _($self:t_inlet) "list"
-            }
-            DISABLED__pointer {
-            ## need to think more about this
-            #    set ptr [new_t_pointer]
-            #    lappend _($self:p_inlet) $ptr
-            ##    lappend _($self:x_inlet) [pointerinlet_new [tclpd_get_object $self] $ptr]
-            }
-            default {
-                return -code error [error_msg "unsupported selector: $sel"]
-            }
-        }
-        #return [lindex $_($self:x_inlet) end]
+        tclpd_add_proxyinlet [tclpd_get_instance $self]
     }
 
-    # get the value of a given inlet
-    proc inlet {self n} {
-        if {$::verbose} {post [info level 0]}
-        if {$n <= 0} {return {}}
-        variable _
-        if {$::verbose} {post "llength of _(self:p_inlet) is [llength $_($self:p_inlet)]"}
-        if {![info exists _($self:p_inlet)] ||
-            $n > [llength $_($self:p_inlet)]} {
-            return -code error [error_msg "no such inlet: $n"]
-        }
-        set p_inlet [lindex $_($self:p_inlet) [expr $n-1]]
-        if {$_($self:t_inlet) == {list}} {
-            return [proxyinlet_get_atoms $p_inlet]
-        } else {
-            return [$p_inlet value]
-        }
-    }
-
-    # used in object constructor for adding inlets
     proc add_outlet {self sel} {
         if $::verbose {post [info level 0]}
-        variable _
-        switch -- $sel {
-            float {
-                lappend _($self:x_outlet) \
-                    [outlet_new [tclpd_get_object $self] [gensym "float"]]
-            }
-            symbol {
-                lappend _($self:x_outlet) \
-                    [outlet_new [tclpd_get_object $self] [gensym "symbol"]]
-            }
-            list {
-                lappend _($self:x_outlet) \
-                    [outlet_new [tclpd_get_object $self] [gensym "list"]]
-            }
-            default {
+        if {[lsearch -exact {bang float list symbol} $sel] == -1} {
                 return -code error [error_msg "unsupported selector: $sel"]
-            }
         }
-        return [lindex $_($self:x_outlet) end]
+        variable _
+        set o [outlet_new [tclpd_get_object $self] [gensym $sel]]
+        lappend _($self:x_outlet) $o
+        return $o
     }
 
     # used inside class for outputting some value
@@ -123,23 +62,6 @@ namespace eval ::pd {
         }
     }
 
-    # used in object constructor to create inlets (internal method)
-    proc create_iolets {cn self} {
-        if $::verbose {post [info level 0]}
-        variable class_db
-        variable _
-        set _($self:p_inlet) {}
-        #set _($self:x_inlet) {}
-        set _($self:t_inlet) {}
-        set _($self:x_outlet) {}
-        for {set i 0} {$i < [llength $class_db($cn:d_inlet)]} {incr i} {
-            add_inlet $self [lindex $class_db($cn:d_inlet) $i]
-        }
-        for {set i 0} {$i < [llength $class_db($cn:d_outlet)]} {incr i} {
-            add_outlet $self [lindex $class_db($cn:d_outlet) $i]
-        }
-    }
-
     # add a class method (that is: a proc named <class>_<sel>)
     proc call_classmethod {classname self sel args} {
         if $::verbose {post [info level 0]}
@@ -162,12 +84,6 @@ namespace eval ::pd {
         set noinlet_flag 0
         foreach {id arg} $def2 {
             switch -- $id {
-                NOinlet {
-                    lappend class_db($classname:d_inlet) $arg
-                }
-                NOoutlet {
-                    lappend class_db($classname:d_outlet) $arg
-                }
                 patchable {
                     if {$arg != 0 && $arg != 1} {
                         return -code error [error_msg "patchable must be 0/1"]
@@ -189,7 +105,6 @@ namespace eval ::pd {
         # class level dispatcher (sort of class constructor)
         proc ::$classname {self args} "
             if \$::verbose {::pd::post \[info level 0\]}
-            ::pd::create_iolets $classname \$self
             ::pd::call_classmethod $classname \$self constructor {*}\$args
             # object dispatcher
             proc ::\$self {selector args} \"
diff --git a/tcl.i b/tcl.i
index e3015ad..ba941a5 100644
--- a/tcl.i
+++ b/tcl.i
@@ -53,6 +53,8 @@
     /* extern "C" { void tcl_setup() {tclpd_setup(void);} } */
 %}
 
+/* this does the trick of solving
+ TypeError in method 'outlet_list', argument 4 of type 't_atom *' */
 %name(outlet_list) EXTERN void outlet_list(t_outlet *x, t_symbol *s, int argc, t_atom_array *argv);
 
 %pointer_class(t_float, t_float)
diff --git a/tcl_class.cxx b/tcl_class.cxx
index 8349f58..d468d04 100644
--- a/tcl_class.cxx
+++ b/tcl_class.cxx
@@ -22,6 +22,7 @@ t_tcl* tclpd_new(t_symbol *classsym, int ac, t_atom *at) {
     const char* name = classsym->s_name;
     t_class* qlass = class_table[string(name)];
     t_tcl* self = (t_tcl*)pd_new(qlass);
+    self->ninlets = 1 /* qlass->c_firstin ??? */;
     char s[32];
     sprintf(s, "pd%06lx", objectSequentialId++);
     self->self = Tcl_NewStringObj(s, -1);
@@ -55,16 +56,19 @@ void tclpd_free(t_tcl *self) {
 }
 
 void tclpd_anything(t_tcl *self, t_symbol *s, int ac, t_atom *at) {
+    tclpd_inlet_anything(self, 0, s, ac, at);
+}
+
+void tclpd_inlet_anything(t_tcl *self, int inlet, t_symbol *s, int ac, t_atom *at) {
 /* proxy method */
     Tcl_Obj *av[ac+2];
     av[0] = self->self;
-    av[1] = Tcl_NewIntObj(0); // TODO: 0 -> outlet_number
+    av[1] = Tcl_NewIntObj(inlet);
     Tcl_AppendToObj(av[1],"_",1);
     Tcl_AppendToObj(av[1],s->s_name,strlen(s->s_name)); // selector
     Tcl_IncrRefCount(av[1]);
     for(int i=0; i<ac; i++) {
         if(pd_to_tcl(&at[i], &av[2+i]) == TCL_ERROR) {
-            //post("Tcl error: %s\n", Tcl_GetStringResult(tcl_for_pd));
             tclpd_interp_error(TCL_ERROR);
             return;
         }
@@ -72,18 +76,17 @@ void tclpd_anything(t_tcl *self, t_symbol *s, int ac, t_atom *at) {
     int result = Tcl_EvalObjv(tcl_for_pd,ac+2,av,0);
     Tcl_DecrRefCount(av[1]);
     if (result != TCL_OK) {
-        //post("Tcl error: %s\n", Tcl_GetStringResult(tcl_for_pd));
         tclpd_interp_error(TCL_ERROR);
     }
 }
 
 /* Tcl glue: */
 
-t_proxyinlet* tclpd_add_proxyinlet(t_tcl* x, t_symbol* s) {
+t_proxyinlet* tclpd_add_proxyinlet(t_tcl* x) {
     t_proxyinlet* proxy = (t_proxyinlet*)pd_new(proxyinlet_class);
     proxyinlet_init(proxy);
     proxy->target = x;
-    proxy->sel = s;
+    proxy->ninlet = x->ninlets++;
     inlet_new(&x->o, &proxy->obj.ob_pd, 0, 0);
     return proxy;
 }
diff --git a/tcl_extras.h b/tcl_extras.h
index 8d61af8..370145d 100644
--- a/tcl_extras.h
+++ b/tcl_extras.h
@@ -9,11 +9,13 @@
 typedef struct _t_tcl {
     t_object o;
     Tcl_Obj* self;
+    int ninlets;
 } t_tcl;
 
 typedef struct _t_proxyinlet {
     t_object obj;
     t_tcl* target;
+    int ninlet;
     t_symbol* sel;
     int argc;
     t_atom* argv;
@@ -23,7 +25,6 @@ typedef struct _t_proxyinlet {
 extern t_class* proxyinlet_class;
 void proxyinlet_init(t_proxyinlet* x);
 void proxyinlet_clear(t_proxyinlet* x);
-void proxyinlet_list(t_proxyinlet* x, t_symbol* s, int argc, t_atom* argv);
 void proxyinlet_anything(t_proxyinlet* x, t_symbol* s, int argc, t_atom* argv);
 void proxyinlet_trigger(t_proxyinlet* x);
 t_atom* proxyinlet_get_atoms(t_proxyinlet* x);
@@ -47,7 +48,8 @@ t_class* tclpd_class_new(char* name, int flags);
 t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at);
 void tclpd_free (t_tcl* self);
 void tclpd_anything(t_tcl* self, t_symbol* s, int ac, t_atom* at);
-t_proxyinlet* tclpd_add_proxyinlet(t_tcl* x, t_symbol* s);
+void tclpd_inlet_anything(t_tcl *self, int inlet, t_symbol *s, int ac, t_atom *at);
+t_proxyinlet* tclpd_add_proxyinlet(t_tcl* x);
 t_tcl* tclpd_get_instance(const char* objectSequentialId);
 t_object* tclpd_get_object(const char* objectSequentialId);
 t_pd* tclpd_get_object_pd(const char* objectSequentialId);
diff --git a/tcl_proxyinlet.cxx b/tcl_proxyinlet.cxx
index c7504c5..e1cdb48 100644
--- a/tcl_proxyinlet.cxx
+++ b/tcl_proxyinlet.cxx
@@ -16,21 +16,24 @@ void proxyinlet_clear(t_proxyinlet* x) {
     }
 }
 
+#define PROXYINLET_SEL_TO_LIST 0 // 0 or 1
+
 void proxyinlet_anything(t_proxyinlet* x, t_symbol* s, int argc, t_atom* argv) {
     proxyinlet_clear(x);
 
-    if(!(x->argv = (t_atom*)getbytes((argc+1) * sizeof(*x->argv)))) {
+    if(!(x->argv = (t_atom*)getbytes((argc+PROXYINLET_SEL_TO_LIST) * sizeof(*x->argv)))) {
         x->argc = 0;
         error("proxyinlet: getbytes: out of memory");
         return;
     }
 
-    x->argc = argc + 1;
-    SETSYMBOL(&x->argv[0], s);
+    x->argc = argc + PROXYINLET_SEL_TO_LIST;
+    if(PROXYINLET_SEL_TO_LIST == 1) SETSYMBOL(&x->argv[0], s);
+    else x->sel = s;
 
     int i;
     for(i = 0; i < argc; i++) {
-        x->argv[i+1] = argv[i];
+        x->argv[i+PROXYINLET_SEL_TO_LIST] = argv[i];
     }
 
     proxyinlet_trigger(x);
@@ -38,7 +41,7 @@ void proxyinlet_anything(t_proxyinlet* x, t_symbol* s, int argc, t_atom* argv) {
 
 void proxyinlet_trigger(t_proxyinlet* x) {
     if(x->target != NULL && x->sel != gensym("none")) {
-        tclpd_anything(x->target, x->sel, x->argc, x->argv);
+        tclpd_inlet_anything(x->target, x->ninlet, x->sel, x->argc, x->argv);
     }
 }