Permalink
Browse files

fixed binbuf support

git-svn-id: https://pure-data.svn.sourceforge.net/svnroot/pure-data/trunk@15751 df7eb9d6-776f-4174-a42d-0ffd8d5d5b5d
  • Loading branch information...
1 parent 47d6424 commit 2e5bc8d47a04c4f573cb73f855e0997cc7ae81fa mescalinum committed Nov 15, 2011
@@ -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)
@@ -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
@@ -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;
}
@@ -1,30 +1,104 @@
#include "tclpd.h"
#include <string.h>
+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;
Tcl_Obj *obj[2];
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;
}
}
@@ -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);
@@ -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;
}
@@ -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 {}}
}
}

0 comments on commit 2e5bc8d

Please sign in to comment.