From 519a19844437310ecce7a9295df7f1bcfe534282 Mon Sep 17 00:00:00 2001 From: mescalinum Date: Tue, 15 Nov 2011 14:17:58 +0000 Subject: fixed binbuf support svn path=/trunk/externals/loaders/tclpd/; revision=15751 --- ChangeLog.txt | 1 + TODO.txt | 2 - tcl_class.c | 6 +++ tcl_typemap.c | 162 ++++++++++++++++++++++++++++++++++++++-------------------- tclpd.h | 4 +- tclpd.i | 23 +++++---- tclpd.tcl | 14 +---- 7 files changed, 131 insertions(+), 81 deletions(-) diff --git a/ChangeLog.txt b/ChangeLog.txt index 917e22b..ee576cc 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -1,5 +1,6 @@ Version 0.3.0: - Big rewrite, fixing typemaps + - Support for most binbuf atoms (COMMA, SEMI, DOLLAR, DOLLSYM, ...) Version 0.2.3: - Big rewrite, using tcl namespaces (more tidy, more efficient) diff --git a/TODO.txt b/TODO.txt index c5371b3..04aa87e 100644 --- a/TODO.txt +++ b/TODO.txt @@ -1,7 +1,5 @@ TODO-list for tclpd (most important things first) ================================================= -- binbuf support broken -- unable to patch classes with dir prefixes (e.g. [dir/class]) (crashes pd) - bitmap's help make pd crash only when opened via context menu Help -> investigate - slider2.tcl is broken - add (or check) GOP diff --git a/tcl_class.c b/tcl_class.c index fc4136d..46aec27 100644 --- a/tcl_class.c +++ b/tcl_class.c @@ -324,6 +324,12 @@ t_atom * tclpd_binbuf_get_atom(t_binbuf *b, int n) { } */ +/* helper function for accessing binbuf's atoms + cause, accessing C arrays and doing typemaps is not that easy */ +t_atom * binbuf_getatom(t_binbuf *x, int index) { + return binbuf_getvec(x) + index; +} + t_object * CAST_t_object(t_object *o) { return o; } diff --git a/tcl_typemap.c b/tcl_typemap.c index 0f4b5d0..e1d770f 100644 --- a/tcl_typemap.c +++ b/tcl_typemap.c @@ -1,12 +1,41 @@ #include "tclpd.h" #include +static const char *atomtype_map[] = { + /* A_NULL */ "null", + /* A_FLOAT */ "float", + /* A_SYMBOL */ "symbol", + /* A_POINTER */ "pointer", + /* A_SEMI */ "semi", + /* A_COMMA */ "comma", + /* A_DEFFLOAT */ "deffloat", + /* A_DEFSYM */ "defsym", + /* A_DOLLAR */ "dollar", + /* A_DOLLSYM */ "dollsym", + /* A_GIMME */ "gimme", + /* A_CANT */ "cant", + /* A_BLOB */ "blob" +}; + +#define atomtype_map_size (sizeof(atomtype_map)/sizeof(atomtype_map[0])) + +static const char * fwd_atomtype_map(t_atomtype t) { + if(t >= atomtype_map_size) return atomtype_map[A_NULL]; + return atomtype_map[t]; +} + +static t_atomtype rev_atomtype_map(const char *s) { + for(t_atomtype i = 0; i < atomtype_map_size; i++) { + if(strcmp(s, atomtype_map[i]) == 0) return i; + } + return A_NULL; +} + int tcl_to_pdatom(Tcl_Obj *input, t_atom *output) { int llength; if(Tcl_ListObjLength(tclpd_interp, input, &llength) == TCL_ERROR) return TCL_ERROR; if(llength != 2) - /*SWIG_exception(SWIG_ValueError, "Bad t_atom: expeting a 2-elements list.");*/ return TCL_ERROR; int i; @@ -14,17 +43,62 @@ int tcl_to_pdatom(Tcl_Obj *input, t_atom *output) { for(i = 0; i < 2; i++) Tcl_ListObjIndex(tclpd_interp, input, i, &obj[i]); char *argv0 = Tcl_GetStringFromObj(obj[0], 0); - if(strcmp(argv0, "float") == 0) { - double dbl; - if(Tcl_GetDoubleFromObj(tclpd_interp, obj[1], &dbl) == TCL_ERROR) + t_atomtype a_type = rev_atomtype_map(argv0); + + switch(a_type) { + case A_FLOAT: + case A_DEFFLOAT: + { + double dbl; + if(Tcl_GetDoubleFromObj(tclpd_interp, obj[1], &dbl) == TCL_ERROR) + return TCL_ERROR; + SETFLOAT(output, dbl); + break; + } + case A_SYMBOL: + case A_DEFSYM: + { + SETSYMBOL(output, gensym(Tcl_GetStringFromObj(obj[1], 0))); + break; + } + case A_POINTER: + { + SETPOINTER(output, NULL); + break; + } + case A_SEMI: + { + SETSEMI(output); + break; + } + case A_COMMA: + { + SETCOMMA(output); + break; + } + case A_DOLLAR: + { + int ii; + if(Tcl_GetIntFromObj(tclpd_interp, obj[1], &ii) == TCL_ERROR) + return TCL_ERROR; + SETDOLLAR(output, ii); + break; + } + case A_DOLLSYM: + { + SETSYMBOL(output, gensym(Tcl_GetStringFromObj(obj[1], 0))); + break; + } + case A_GIMME: + case A_CANT: + case A_BLOB: + case A_NULL: + { + // TODO: set error result return TCL_ERROR; - SETFLOAT(output, dbl); - } else if(strcmp(argv0, "symbol") == 0) { - SETSYMBOL(output, gensym(Tcl_GetStringFromObj(obj[1], 0))); - } else if(strcmp(argv0, "pointer") == 0) { - // TODO: - return TCL_ERROR; + } } + return TCL_OK; } @@ -34,62 +108,42 @@ int tcl_to_pdsymbol(Tcl_Obj *input, t_symbol **output) { return TCL_OK; } -const char * pdatom_type_string(t_atom *a) { - switch(a->a_type) { - case A_FLOAT: - case A_DEFFLOAT: - return "float"; - case A_SYMBOL: - case A_DEFSYM: - case A_DOLLAR: - case A_DOLLSYM: - case A_SEMI: - case A_COMMA: - return "symbol"; - case A_POINTER: - return "pointer"; - default: - error("atom_type_string: unsupported/unknown selector: %d", a->a_type); - return "???"; - } -} - -const char * pdatom_symbol_value(t_atom *a) { - if(a->a_type == A_DOLLAR) { - char buf[6]; - snprintf(buf, 6, "$%d", a->a_w.w_index); - t_symbol *s = gensym(buf); - return s->s_name; - } - return a->a_w.w_symbol->s_name; -} - -float pdatom_float_value(t_atom *a) { - return a->a_w.w_float; -} - int pdatom_to_tcl(t_atom *input, Tcl_Obj **output) { Tcl_Obj *tcl_t_atom[2]; + tcl_t_atom[0] = Tcl_NewStringObj(fwd_atomtype_map(input->a_type), -1); switch (input->a_type) { - case A_FLOAT: { - tcl_t_atom[0] = Tcl_NewStringObj("float", -1); + case A_FLOAT: + case A_DEFFLOAT: + { tcl_t_atom[1] = Tcl_NewDoubleObj(input->a_w.w_float); break; } - case A_SYMBOL: { - tcl_t_atom[0] = Tcl_NewStringObj("symbol", -1); + case A_SYMBOL: + case A_DEFSYM: + case A_DOLLSYM: + { tcl_t_atom[1] = Tcl_NewStringObj(input->a_w.w_symbol->s_name, strlen(input->a_w.w_symbol->s_name)); break; } - case A_POINTER: { - return TCL_ERROR; - tcl_t_atom[0] = Tcl_NewStringObj("pointer", -1); + case A_POINTER: + { tcl_t_atom[1] = Tcl_NewDoubleObj((long)input->a_w.w_gpointer); break; } - default: { - tcl_t_atom[0] = Tcl_NewStringObj("?", -1); - tcl_t_atom[1] = Tcl_NewStringObj("", 0); + case A_DOLLAR: + { + tcl_t_atom[1] = Tcl_NewIntObj((int)input->a_w.w_index); + break; + } + case A_SEMI: + case A_COMMA: + case A_GIMME: + case A_CANT: + case A_BLOB: + case A_NULL: + default: + { + tcl_t_atom[1] = Tcl_NewStringObj("--", 2); break; } } diff --git a/tclpd.h b/tclpd.h index 20afc83..ff25106 100644 --- a/tclpd.h +++ b/tclpd.h @@ -51,9 +51,6 @@ extern int Tclpd_SafeInit(Tcl_Interp *interp); /* tcl_typemap.c */ int tcl_to_pdatom(Tcl_Obj *input, t_atom *output); int tcl_to_pdsymbol(Tcl_Obj *input, t_symbol **output); -const char * pdatom_type_string(t_atom *a); -const char * pdatom_symbol_value(t_atom *a); -float pdatom_float_value(t_atom *a); int pdatom_to_tcl(t_atom *input, Tcl_Obj **output); int pdsymbol_to_tcl(t_symbol *input, Tcl_Obj **output); @@ -88,6 +85,7 @@ t_binbuf * tclpd_get_object_binbuf(const char *objectSequentialId); t_glist * tclpd_get_glist(const char *objectSequentialId); t_atom * tclpd_binbuf_get_atom(t_binbuf *b, int n); */ +t_atom * binbuf_getatom(t_binbuf *x, int index); t_object * CAST_t_object(t_object *o); t_pd * CAST_t_pd(t_pd *o); t_text * CAST_t_text(t_text *o); diff --git a/tclpd.i b/tclpd.i index 8e15d55..442787f 100644 --- a/tclpd.i +++ b/tclpd.i @@ -11,11 +11,11 @@ %include carrays.i %include typemaps.i -%pointer_functions(t_atom, atom) -%pointer_functions(t_symbol, symbol) +%pointer_functions(t_atom, atom); +%pointer_functions(t_symbol, symbol); -%array_functions(t_atom, atom_array) /* +%array_functions(t_atom_array, atom_array); Creates four functions. type *new_name(int nelements) @@ -81,26 +81,29 @@ void name_setitem(type *ary, int index, type value) %typemap(in) t_tcl * { const char *str = Tcl_GetStringFromObj($input, NULL); $1 = object_table_get(str); - SWIG_contract_assert($1, "not a t_tcl * instance"); + SWIG_contract_assert($1, "not a t_tcl * instance") {}; } %typemap(in) t_pd * { const char *str = Tcl_GetStringFromObj($input, NULL); $1 = object_table_get(str); - SWIG_contract_assert($1, "not a t_pd * instance"); + SWIG_contract_assert($1, "not a t_pd * instance") {}; } %typemap(in) t_text * { - const char *str = Tcl_GetStringFromObj($input, NULL); - t_tcl *x = object_table_get(str); - SWIG_contract_assert(x, "not a t_text * instance"); - $1 = &x->o; + int res = SWIG_ConvertPtr($input, &$1, SWIGTYPE_p__text, 0 | 0 ); + if(!SWIG_IsOK(res)) { + const char *str = Tcl_GetStringFromObj($input, NULL); + t_tcl *x = object_table_get(str); + SWIG_contract_assert(x, "not a t_text * instance") {}; + $1 = &x->o; + } } %typemap(in) t_object * { const char *str = Tcl_GetStringFromObj($input, NULL); t_tcl *x = object_table_get(str); - SWIG_contract_assert(x, "not a t_object * instance"); + SWIG_contract_assert(x, "not a t_object * instance") {}; $1 = &x->o; } diff --git a/tclpd.tcl b/tclpd.tcl index fe358ac..a93fc84 100644 --- a/tclpd.tcl +++ b/tclpd.tcl @@ -261,24 +261,14 @@ namespace eval ::pd { proc get_binbuf {self} { set ob [CAST_t_object $self] - post "get_binbuf: ob = $ob" - if 0 { set binbuf [$ob cget -te_binbuf] set len [binbuf_getnatom $binbuf] set result {} for {set i 0} {$i < $len} {incr i} { - set atom [tclpd_binbuf_get_atom $binbuf $i] - set selector [atom_type_string $atom] - set value {?} - if {$selector eq "float"} { - set value [atom_float_value $atom] - } elseif {$selector eq "symbol"} { - set value [atom_symbol_value $atom] - } - lappend result [list $selector $value] + set atom [binbuf_getatom $binbuf $i] + lappend result $atom } return $result - } else {return {}} } } -- cgit v1.2.1