From 69118070c6c46b2c097b8b2e6fd0870c634b7114 Mon Sep 17 00:00:00 2001 From: mescalinum Date: Sun, 13 Sep 2009 15:50:31 +0000 Subject: added support for pd_bind/pd_unbind; added destructor call in tclpd_free svn path=/trunk/externals/tclpd/; revision=12330 --- ChangeLog | 2 ++ TODO | 3 +-- pdlib.tcl | 21 ++++++++++++++----- tcl.i | 20 +++++++++++++++++- tcl_class.cxx | 67 ++++++++++++++++++++++++++++++++++++++++++++++------------- tcl_extras.h | 5 +++++ 6 files changed, 95 insertions(+), 23 deletions(-) diff --git a/ChangeLog b/ChangeLog index d40cca6..3089a49 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,7 @@ Version 0.2.1: - Added support for properties function. + - Added support for pd_bind/unbind. + - Added destructor call in pd_free. Version 0.2: - Added support for GUI externals (widgetbehavior). diff --git a/TODO b/TODO index ebd69a4..e1cc55c 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,4 @@ TODO-list for tclpd (most important things first) ================================================= -- add support for send/receive symbols (pd_bind?) -- add support for properties function - add (or check) GOP +- signal externals? (really?) diff --git a/pdlib.tcl b/pdlib.tcl index a854e04..e2cd347 100644 --- a/pdlib.tcl +++ b/pdlib.tcl @@ -18,13 +18,17 @@ namespace eval ::pd { tclpd_add_proxyinlet [tclpd_get_instance $self] } - proc add_outlet {self sel} { + proc add_outlet {self {sel {}}} { if $::verbose {post [info level 0]} - if {[lsearch -exact {bang float list symbol} $sel] == -1} { + variable _ + if {$sel == {}} { + set o [outlet_new [tclpd_get_object $self] [null_symbol]] + } else { + if {[lsearch -exact {bang float list symbol} $sel] == -1} { return -code error [error_msg "unsupported selector: $sel"] + } + set o [outlet_new [tclpd_get_object $self] [gensym $sel]] } - variable _ - set o [outlet_new [tclpd_get_object $self] [gensym $sel]] lappend _($self:x_outlet) $o return $o } @@ -57,7 +61,14 @@ namespace eval ::pd { outlet_bang $outlet } default { - return -code error [error_msg "unknown selector: $sel"] + set v [lindex $args 0] + set sz [llength $v] + set aa [new_atom_array $sz] + for {set i 0} {$i < $sz} {incr i} { + set_atom_array $aa $i [lindex $v $i] + } + outlet_anything $outlet [gensym $sel] $sz $aa + delete_atom_array $aa $sz } } } diff --git a/tcl.i b/tcl.i index ba941a5..0c3d37a 100644 --- a/tcl.i +++ b/tcl.i @@ -38,9 +38,26 @@ %ignore post; %ignore class_new; +/* functions that we can't auto-wrap, because */ +%ignore glist_new; +%ignore canvas_zapallfortemplate; +%ignore canvas_fattenforscalars; +%ignore canvas_visforscalars; +%ignore canvas_clicksub; +%ignore text_xcoord; +%ignore text_ycoord; +%ignore canvas_getglistonsuper; +%ignore canvas_getfont; +%ignore canvas_setusedastemplate; +%ignore canvas_vistext; +%ignore rtext_remove; +%ignore canvas_recurapply; +%ignore gobj_properties; + /* end of ignore-list */ %include "m_pd.h" +%include "g_canvas.h" %include "tcl_extras.h" %{ @@ -54,8 +71,9 @@ %} /* this does the trick of solving - TypeError in method 'outlet_list', argument 4 of type 't_atom *' */ + TypeError in method 'xyz', 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); +%name(outlet_anything) EXTERN void outlet_anything(t_outlet *x, t_symbol *s, int argc, t_atom_array *argv); %pointer_class(t_float, t_float) %pointer_class(t_symbol, t_symbol) diff --git a/tcl_class.cxx b/tcl_class.cxx index 7525e77..81d5c98 100644 --- a/tcl_class.cxx +++ b/tcl_class.cxx @@ -70,22 +70,27 @@ 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 ??? */; + t_tcl* x = (t_tcl*)pd_new(qlass); + x->ninlets = 1 /* qlass->c_firstin ??? */; + + x->classname = Tcl_NewStringObj(name, -1); + Tcl_IncrRefCount(x->classname); char s[64]; snprintf(s, 64, "tclpd:%s:x%lx", name, objectSequentialId++); - self->self = Tcl_NewStringObj(s, -1); - Tcl_IncrRefCount(self->self); + x->self = Tcl_NewStringObj(s, -1); + Tcl_IncrRefCount(x->self); + + x->x_glist = (t_glist*)canvas_getcurrent(); // store in object table (for later lookup) - object_table[string(s)] = (t_pd*)self; + object_table[string(s)] = (t_pd*)x; // build constructor command Tcl_Obj *av[ac+2]; InitArray(av, ac+2, NULL); - av[0] = Tcl_NewStringObj(name, -1); + av[0] = x->classname; Tcl_IncrRefCount(av[0]); - av[1] = self->self; + av[1] = x->self; Tcl_IncrRefCount(av[1]); for(int i=0; iself); +void tclpd_free(t_tcl* x) { + // build destructor command + Tcl_Obj *sym = Tcl_NewStringObj(Tcl_GetStringFromObj(x->classname, NULL), -1); + Tcl_AppendToObj(sym, "_destructor", -1); + Tcl_Obj *av[2]; InitArray(av, 2, NULL); + av[0] = sym; + Tcl_IncrRefCount(av[0]); + av[1] = x->self; + Tcl_IncrRefCount(av[1]); + // call destructor + if(Tcl_EvalObjv(tcl_for_pd, 2, av, 0) != TCL_OK) { +#ifdef DEBUG + post("tclpd_free: failed"); +#endif + } + Tcl_DecrRefCount(av[0]); + Tcl_DecrRefCount(av[1]); + + Tcl_DecrRefCount(x->self); + Tcl_DecrRefCount(x->classname); #ifdef DEBUG post("tclpd_free called"); #endif } -void tclpd_anything(t_tcl* self, t_symbol* s, int ac, t_atom* at) { - tclpd_inlet_anything(self, 0, s, ac, at); +void tclpd_anything(t_tcl* x, t_symbol* s, int ac, t_atom* at) { + tclpd_inlet_anything(x, 0, s, ac, at); } -void tclpd_inlet_anything(t_tcl* self, int inlet, t_symbol* s, int ac, t_atom* at) { +void tclpd_inlet_anything(t_tcl* x, int inlet, t_symbol* s, int ac, t_atom* at) { // proxy method - format: ... Tcl_Obj* av[ac+3]; InitArray(av, ac+3, NULL); int result; - av[0] = self->self; + av[0] = x->self; Tcl_IncrRefCount(av[0]); av[1] = Tcl_NewIntObj(inlet); Tcl_IncrRefCount(av[1]); @@ -179,6 +203,10 @@ t_tcl* tclpd_get_instance(const char* objectSequentialId) { return (t_tcl*)object_table[objectSequentialId]; } +t_pd* tclpd_get_instance_pd(const char* objectSequentialId) { + return (t_pd*)object_table[objectSequentialId]; +} + t_object* tclpd_get_object(const char* objectSequentialId) { t_tcl* x = tclpd_get_instance(objectSequentialId); return &x->o; @@ -189,6 +217,15 @@ t_pd* tclpd_get_object_pd(const char* objectSequentialId) { return &o->ob_pd; } +t_glist* tclpd_get_glist(const char* objectSequentialId) { + t_tcl* x = tclpd_get_instance(objectSequentialId); + return x->x_glist; +} + +t_symbol* null_symbol() { + return (t_symbol*)0; +} + void poststring2 (const char *s) { post("%s", s); } diff --git a/tcl_extras.h b/tcl_extras.h index 9c38f58..ccbec4c 100644 --- a/tcl_extras.h +++ b/tcl_extras.h @@ -16,7 +16,9 @@ typedef struct _t_tcl { t_object o; + t_glist* x_glist; Tcl_Obj* self; + Tcl_Obj* classname; int ninlets; } t_tcl; @@ -60,8 +62,11 @@ void tclpd_anything(t_tcl* self, t_symbol* s, int ac, t_atom* at); 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_pd* tclpd_get_instance_pd(const char* objectSequentialId); t_object* tclpd_get_object(const char* objectSequentialId); t_pd* tclpd_get_object_pd(const char* objectSequentialId); +t_glist* tclpd_get_glist(const char* objectSequentialId); +t_symbol* null_symbol(); void poststring2(const char* s); extern "C" void text_save(t_gobj *z, t_binbuf *b); void tclpd_save(t_gobj* z, t_binbuf* b); -- cgit v1.2.1