From aa048d93e8fdae5b8152b3c963da02b3cd244274 Mon Sep 17 00:00:00 2001 From: mescalinum Date: Mon, 31 Aug 2009 01:13:12 +0000 Subject: proxyinlet support working and generally everything working fine (in the list_change use case) svn path=/trunk/externals/tclpd/; revision=12153 --- Makefile | 2 +- list_change.tcl | 22 ++++++------ pdlib.tcl | 101 +++++------------------------------------------------ tcl.i | 2 ++ tcl_class.cxx | 13 ++++--- tcl_extras.h | 6 ++-- tcl_proxyinlet.cxx | 13 ++++--- 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 - 2007 +# by Federico Ferri - (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 _) 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; itarget = 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); } } -- cgit v1.2.1