add of proxyinlet

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

5 files changed, 147 insertions, 48 deletions

diff --git a/list_change.tcl b/list_change.tcl
index 13d2875..de2cfee 100644
--- a/list_change.tcl
+++ b/list_change.tcl
@@ -1,28 +1,33 @@
 source pdlib.tcl
 
 pd::class list_change {
-    # first 'hot' inlet is created by default
-
-    # add 'cold' inlet:
-    inlet list
-
-    outlet list
 
     constructor {
-        #pd::add_inlet $self float
+        # add second inlet (first created by default)
+        pd::add_inlet $self list
+
+        # add outlet
+        pd::add_outlet $self list
 
         set @curlist {}
     }
 
     0_list {
-        if {$args != $@curlist} {
-            set @curlist $args
-            pd::outlet $self 0 list $@curlist
+        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
-        }
+        #}
     }
 
     0_bang {
-        pd::outlet $self 0 list $@curlist
+        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
     }
+
 }
diff --git a/pdlib.tcl b/pdlib.tcl
index 2a5747e..27347c9 100644
--- a/pdlib.tcl
+++ b/pdlib.tcl
@@ -30,14 +30,8 @@ namespace eval ::pd {
                 #lappend _($self:x_inlet) [symbolinlet_new [tclpd_get_object $self] $ptr]
             }
             list {
-                set ptr [new_t_proxyinlet]
-                proxyinlet_init $ptr
-                #proxyinlet_list $ptr [gensym list] 2 {{symbol foo} {symbol bar}}
-                #puts "(t_proxyinlet) $ptr cget -pd = "
-                #puts "                               [$ptr cget -pd]"
-                #inlet_new [tclpd_get_object $self] [$ptr cget -pd] 0 {}
-                # I HATE SWIG
-                tclpd_add_proxyinlet [tclpd_get_object $self] $ptr
+                # 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"
             }
@@ -54,18 +48,19 @@ namespace eval ::pd {
         #return [lindex $_($self:x_inlet) end]
     }
 
-    # get the value of a given inlet (inlets numbered starting from 1)
+    # 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)]} {
+            $n > [llength $_($self:p_inlet)]} {
             return -code error [error_msg "no such inlet: $n"]
         }
-        variable _
         set p_inlet [lindex $_($self:p_inlet) [expr $n-1]]
         if {$_($self:t_inlet) == {list}} {
-            return [$p_inlet argv]
+            return [proxyinlet_get_atoms $p_inlet]
         } else {
             return [$p_inlet value]
         }
@@ -167,10 +162,10 @@ namespace eval ::pd {
         set noinlet_flag 0
         foreach {id arg} $def2 {
             switch -- $id {
-                inlet {
+                NOinlet {
                     lappend class_db($classname:d_inlet) $arg
                 }
-                outlet {
+                NOoutlet {
                     lappend class_db($classname:d_outlet) $arg
                 }
                 patchable {
diff --git a/tcl_class.cxx b/tcl_class.cxx
index 1c57b3e..8349f58 100644
--- a/tcl_class.cxx
+++ b/tcl_class.cxx
@@ -79,16 +79,21 @@ void tclpd_anything(t_tcl *self, t_symbol *s, int ac, t_atom *at) {
 
 /* Tcl glue: */
 
-void tclpd_add_proxyinlet(t_object* o, t_proxyinlet* i) {
-    inlet_new(o, &i->pd, 0, 0);
+t_proxyinlet* tclpd_add_proxyinlet(t_tcl* x, t_symbol* s) {
+    t_proxyinlet* proxy = (t_proxyinlet*)pd_new(proxyinlet_class);
+    proxyinlet_init(proxy);
+    proxy->target = x;
+    proxy->sel = s;
+    inlet_new(&x->o, &proxy->obj.ob_pd, 0, 0);
+    return proxy;
 }
 
-t_pd* tclpd_get_instance(const char* objectSequentialId) {
-    return object_table[objectSequentialId];
+t_tcl* tclpd_get_instance(const char* objectSequentialId) {
+    return (t_tcl*)object_table[objectSequentialId];
 }
 
 t_object* tclpd_get_object(const char* objectSequentialId) {
-    t_tcl* x = (t_tcl*)tclpd_get_instance(objectSequentialId);
+    t_tcl* x = tclpd_get_instance(objectSequentialId);
     return &x->o;
 }
 
diff --git a/tcl_extras.h b/tcl_extras.h
index 4ddb56e..8d61af8 100644
--- a/tcl_extras.h
+++ b/tcl_extras.h
@@ -8,20 +8,25 @@
 
 typedef struct _t_tcl {
     t_object o;
-    Tcl_Obj *self;
+    Tcl_Obj* self;
 } t_tcl;
 
 typedef struct _t_proxyinlet {
-    t_pd pd;
+    t_object obj;
+    t_tcl* target;
+    t_symbol* sel;
     int argc;
     t_atom* argv;
 } t_proxyinlet;
 
 /* tcl_proxyinlet.cxx */
+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);
 void proxyinlet_clone(t_proxyinlet* x, t_proxyinlet* y);
 void proxyinlet_setup(void);
 
@@ -29,30 +34,30 @@ void proxyinlet_setup(void);
 extern "C" int Tclpd_SafeInit(Tcl_Interp *interp);
 
 /* tcl_typemap.cxx */
-int          pd_to_tcl            (t_atom* input, Tcl_Obj** output);
-int          tcl_to_pd            (Tcl_Obj* input, t_atom* output);
+int pd_to_tcl(t_atom* input, Tcl_Obj** output);
+int tcl_to_pd(Tcl_Obj* input, t_atom* output);
 
 /* tcl_setup.cxx */
-extern Tcl_Interp *tcl_for_pd;
+extern Tcl_Interp* tcl_for_pd;
 extern "C" void tclpd_setup(void);
 void tclpd_interp_error(int result);
 
 /* tcl_class.cxx */
-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);
-void tclpd_add_proxyinlet(t_object* o, t_proxyinlet* i);
-t_pd* tclpd_get_instance(const char* objectSequentialId);
+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);
+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);
-void poststring2 (const char *s);
+void poststring2(const char* s);
 
 /* tcl_loader.cxx */
-extern "C" int tclpd_do_load_lib (t_canvas *canvas, char *objectname);
+extern "C" int tclpd_do_load_lib(t_canvas* canvas, char* objectname);
 /* pd loader private stuff: */
-typedef int (*loader_t)(t_canvas *canvas, char *classname);
+typedef int (*loader_t)(t_canvas *canvas, char* classname);
 extern "C" void sys_register_loader(loader_t loader);
-extern "C" int sys_onloadlist(char *classname);
-extern "C" void sys_putonloadlist(char *classname);
-extern "C" void class_set_extern_dir(t_symbol *s);
+extern "C" int sys_onloadlist(char* classname);
+extern "C" void sys_putonloadlist(char* classname);
+extern "C" void class_set_extern_dir(t_symbol* s);
diff --git a/tcl_proxyinlet.cxx b/tcl_proxyinlet.cxx
new file mode 100644
index 0000000..de97ec0
--- /dev/null
+++ b/tcl_proxyinlet.cxx
@@ -0,0 +1,89 @@
+#include "tcl_extras.h"
+
+t_class* proxyinlet_class;
+
+void proxyinlet_init(t_proxyinlet* x) {
+    //x->pd = proxyinlet_class;
+    x->target = NULL;
+    x->sel = gensym("none");
+    x->argc = 0;
+    x->argv = NULL;
+}
+
+void proxyinlet_clear(t_proxyinlet* x) {
+    if(x->argv) {
+        freebytes(x->argv, x->argc * sizeof(*x->argv));
+    }
+}
+
+void proxyinlet_list(t_proxyinlet* x, t_symbol* s, int argc, t_atom* argv) {
+    proxyinlet_clear(x);
+
+    if(!(x->argv = (t_atom*)getbytes(argc * sizeof(*x->argv)))) {
+        x->argc = 0;
+        error("proxyinlet: getbytes: out of memory");
+        return;
+    }
+
+    x->argc = argc;
+    int i;
+    for(i = 0; i < argc; i++) {
+        x->argv[i] = argv[i];
+    }
+
+    proxyinlet_trigger(x);
+}
+
+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)))) {
+        x->argc = 0;
+        error("proxyinlet: getbytes: out of memory");
+        return;
+    }
+
+    x->argc = argc + 1;
+    SETSYMBOL(&x->argv[0], s);
+
+    int i;
+    for(i = 0; i < argc; i++) {
+        x->argv[i+1] = argv[i];
+    }
+
+    proxyinlet_trigger(x);
+}
+
+void proxyinlet_trigger(t_proxyinlet* x) {
+    if(x->target != NULL && x->sel != gensym("none")) {
+        tclpd_anything(x->target, x->sel, x->argc, x->argv);
+    }
+}
+
+t_atom* proxyinlet_get_atoms(t_proxyinlet* x) {
+    return x->argv;
+}
+
+void proxyinlet_clone(t_proxyinlet* x, t_proxyinlet* y) {
+    y->target = x->target;
+    y->sel = x->sel;
+
+    y->argc = x->argc;
+    if(!(y->argv = (t_atom*)getbytes(y->argc * sizeof(*y->argv)))) {
+        y->argc = 0;
+        error("proxyinlet: getbytes: out of memory");
+        return;
+    }
+
+    int i;
+    for(i = 0; i < x->argc; i++) {
+        y->argv[i] = x->argv[i];
+    }
+}
+
+void proxyinlet_setup(void) {
+    proxyinlet_class = class_new(gensym("tclpd proxyinlet"),
+        0, 0, sizeof(t_proxyinlet), 0, A_NULL);
+    class_addlist(proxyinlet_class, proxyinlet_list);
+    class_addanything(proxyinlet_class, proxyinlet_anything);
+}