From c80ad601728139c16c4903f5ed08680f7e5f203c Mon Sep 17 00:00:00 2001 From: mescalinum Date: Sun, 13 Nov 2011 22:52:33 +0000 Subject: 0.3.0 - typemaps support complete svn path=/trunk/externals/loaders/tclpd/; revision=15738 --- ChangeLog.txt | 3 + Makefile | 10 +-- examples/binbuf-test.tcl | 4 +- examples/bitmap.tcl | 27 +++---- examples/dynreceive.tcl | 14 ++-- examples/dynroute.tcl | 4 +- examples/list_change.tcl | 4 +- examples/properties.tcl | 8 +- examples/slider2.tcl | 36 ++++----- examples/tclpd-console.tcl | 9 ++- hashtable.c | 24 +++--- hashtable.h | 32 ++++---- tcl.i | 124 ------------------------------ tcl_class.c | 178 +++++++++++++++++++++++++------------------ tcl_extras.h | 109 --------------------------- tcl_loader.c | 43 ++++++----- tcl_proxyinlet.c | 20 ++--- tcl_typemap.c | 42 +++++------ tcl_widgetbehavior.c | 98 ++++++++++++------------ tclpd-meta.pd | 2 +- tclpd.c | 51 ++++++++----- tclpd.h | 121 ++++++++++++++++++++++++++++++ tclpd.i | 183 +++++++++++++++++++++++++++++++++++++++++++++ tclpd.tcl | 42 +++++------ 24 files changed, 648 insertions(+), 540 deletions(-) delete mode 100644 tcl.i delete mode 100644 tcl_extras.h create mode 100644 tclpd.h create mode 100644 tclpd.i diff --git a/ChangeLog.txt b/ChangeLog.txt index 5c8a950..917e22b 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -1,3 +1,6 @@ +Version 0.3.0: + - Big rewrite, fixing typemaps + Version 0.2.3: - Big rewrite, using tcl namespaces (more tidy, more efficient) diff --git a/Makefile b/Makefile index f9a1893..fa0851a 100644 --- a/Makefile +++ b/Makefile @@ -25,7 +25,7 @@ TCLPD_SOURCES = hashtable.c tcl_class.c tcl_loader.c tcl_proxyinlet.c tcl_typema # list them here. This can be anything from header files, test patches, # documentation, etc. README.txt and LICENSE.txt are required and therefore # automatically included -EXTRA_DIST = tcl.i tcl_extras.h tclpd.tcl $(TCLPD_SOURCES) ChangeLog.txt AUTHORS.txt TODO.txt +EXTRA_DIST = tclpd.i tclpd.h tclpd.tcl $(TCLPD_SOURCES) ChangeLog.txt AUTHORS.txt TODO.txt @@ -54,7 +54,7 @@ LIBS_windows = -ltcl85 "$(LIBRARY_NAME).def" #------------------------------------------------------------------------------# # these can be set from outside without (usually) breaking the build -DEBUG = 0 +DEBUG ?= 0 CFLAGS = -fno-tree-vectorize -fno-strict-aliasing -Wno-strict-aliasing LDFLAGS = LIBS = @@ -247,7 +247,7 @@ endif HELPPATCHES ?= $(SOURCES:.c=-help.pd) $(PDOBJECTS:.pd=-help.pd) ifeq ($(DEBUG),1) - ALL_CFLAGS += -O0 -g -ggdb + ALL_CFLAGS += -O0 -g -ggdb -DDEBUG STRIP = echo else ALL_CFLAGS += $(OPT_CFLAGS) @@ -273,8 +273,8 @@ all: $(LIBRARY_NAME) $(CC) $(ALL_LDFLAGS) -o "$*.$(EXTENSION)" "$*.o" $(ALL_LIBS) $(SHARED_LIB) chmod a-x "$*.$(EXTENSION)" -tcl_wrap.c: tcl.i tcl_extras.h Makefile - swig -v -tcl -o tcl_wrap.c $(PD_INCLUDES) tcl.i +tcl_wrap.c: tclpd.i tclpd.h Makefile + swig -v -tcl -o tcl_wrap.c $(PD_INCLUDES) tclpd.i # this links everything into a single binary file $(LIBRARY_NAME): $(SOURCES:.c=.o) $(LIBRARY_NAME).o tcl_wrap.o $(TCLPD_SOURCES:.c=.o) diff --git a/examples/binbuf-test.tcl b/examples/binbuf-test.tcl index 62fc8c1..f31c198 100644 --- a/examples/binbuf-test.tcl +++ b/examples/binbuf-test.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 proc binbuf-test::constructor {self args} { pd::add_outlet $self list diff --git a/examples/bitmap.tcl b/examples/bitmap.tcl index 97b9491..64d2b92 100644 --- a/examples/bitmap.tcl +++ b/examples/bitmap.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 set ::script_path [file dirname [info script]] @@ -28,6 +28,8 @@ pd::guiproc bitmap_draw_new {self c x y config data} { } proc+ bitmap::constructor {self args} { + set @canvas [canvas_getcurrent] + set s [file join $::script_path properties.tcl] sys_gui "source {$s}\n" @@ -58,17 +60,16 @@ proc+ bitmap::constructor {self args} { 0_config $self {*}$args set @rcvLoadData {#bitmap} - pd_bind [tclpd_get_instance_pd $self] [gensym $@rcvLoadData] + pd_bind $self $@rcvLoadData } proc+ bitmap::destructor {self} { - set pdself [tclpd_get_instance_pd $self] if {$@rcvLoadData != {}} { #should not happen! - pd_unbind $pdself [gensym $@rcvLoadData] + pd_unbind $self $@rcvLoadData } if {[dict get $@config -receivesymbol] != {}} { - pd_unbind $pdself $@recv + pd_unbind $self $@recv } } @@ -116,14 +117,12 @@ proc+ bitmap::0_config {self args} { set new [dict get $newconf -$opt] if {$old != $new} { if {$opt == "receivesymbol"} { - set selfpd [tclpd_get_instance_pd $self] if {$old != {}} { - pd_unbind $selfpd $@recv + pd_unbind $self $@recv } if {$new != {}} { - set @recv [canvas_realizedollar \ - [tclpd_get_glist $self] [gensym $new]] - pd_bind $selfpd $@recv + set @recv [canvas_realizedollar $@canvas $new] + pd_bind $self $@recv } else { set @recv {} } @@ -250,7 +249,7 @@ proc+ bitmap::0_setdata {self args} { set @data [list] foreach i $d {lappend @data [expr {int($i)}]} if {$@rcvLoadData != {}} { - pd_unbind [tclpd_get_instance_pd $self] [gensym $@rcvLoadData] + pd_unbind $self $@rcvLoadData set @rcvLoadData {} } } @@ -262,10 +261,8 @@ proc+ bitmap::save {self args} { proc+ bitmap::properties {self args} { set title "\[bitmap\] properties" - set x_xobj_obpd [tclpd_get_object_pd $self] - set x [tclpd_get_instance $self] set buf [list propertieswindow %s $@config $title]\n - gfxstub_new $x_xobj_obpd $x $buf + gfxstub_new $self $self $buf } proc+ bitmap::widgetbehavior_getrect {self args} { diff --git a/examples/dynreceive.tcl b/examples/dynreceive.tcl index 6903da9..ceef7a8 100644 --- a/examples/dynreceive.tcl +++ b/examples/dynreceive.tcl @@ -1,11 +1,11 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 proc+ dynreceive::constructor {self args} { set @sym {} if {[pd::args] > 0} { set @sym [pd::arg 0 symbol] - pd_bind [tclpd_get_instance_pd $self] [gensym $@sym] + pd_bind $self $@sym } pd::add_outlet $self } @@ -14,7 +14,7 @@ proc+ dynreceive::destructor {self} { # don't forget to call pd_unbind, or sending things to a symbol # bound to dead object will crash pd! if {$@sym != {}} { - pd_unbind [tclpd_get_instance_pd $self] [gensym $@sym] + pd_unbind $self $@sym } } @@ -22,13 +22,13 @@ proc+ dynreceive::0_set {self args} { # send [set empty( to clear the receive symbol set s [pd::arg 0 symbol] if {$@sym != {}} { - pd_unbind [tclpd_get_instance_pd $self] [gensym $@sym] + pd_unbind $self $@sym } if {$s == {empty}} { set @sym {} } else { set @sym $s - pd_bind [tclpd_get_instance_pd $self] [gensym $@sym] + pd_bind $self $@sym } } @@ -41,7 +41,7 @@ proc+ dynreceive::0_float {self args} { } proc+ dynreceive::0_symbol {self args} { - pd::outlet $self 0 symbol [gensym [pd::arg 0 symbol]] + pd::outlet $self 0 symbol [pd::arg 0 symbol] } proc+ dynreceive::0_anything {self args} { diff --git a/examples/dynroute.tcl b/examples/dynroute.tcl index 04cb3c9..286087c 100644 --- a/examples/dynroute.tcl +++ b/examples/dynroute.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 # dynroute: dynamically route messages based on first element # non-matching arguments are sent to last inlet diff --git a/examples/list_change.tcl b/examples/list_change.tcl index 26190e4..82c751d 100644 --- a/examples/list_change.tcl +++ b/examples/list_change.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 proc+ list_change::constructor {self args} { # add second inlet (first created by default) diff --git a/examples/properties.tcl b/examples/properties.tcl index dc199de..cdbfc1d 100644 --- a/examples/properties.tcl +++ b/examples/properties.tcl @@ -8,9 +8,10 @@ proc propertieswindow {gfxstub_id {options {}} {title {}}} { set win $gfxstub_id set ::id($win.p) $gfxstub_id set ::optkeys($win.p) [list] + set options [string map {@ $} $options] foreach {k v} $options { if {$v eq "empty"} {set v {}} - set v [string map {\\$ $} $v] + #set v [string map {\\$ $} $v] set ::config($win.p:$k) $v lappend ::optkeys($win.p) $k } @@ -416,8 +417,9 @@ proc propertiespanel_apply {w} { if {$v == ""} {set v "empty"} lappend newconf $key $v } - set newconf [string map {$ \\$} $newconf] - pdsend "$::id($w) config $newconf" + #set newconf [string map {$ \\$} $newconf] + set newconf [string map {$ @} $newconf] + pdsend "$::id($w) config2 $newconf" } proc propertiespanel_close {w} { diff --git a/examples/slider2.tcl b/examples/slider2.tcl index 197be29..1cf1335 100644 --- a/examples/slider2.tcl +++ b/examples/slider2.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 set ::script_path [file dirname [info script]] @@ -60,6 +60,7 @@ pd::guiproc slider2_update {self c x y config state} { } proc+ slider2::constructor {self args} { + set @canvas [canvas_getcurrent] pd::add_outlet $self float sys_gui "source {[file join $::script_path properties.tcl]}\n" # set defaults: @@ -78,7 +79,7 @@ proc+ slider2::constructor {self args} { proc+ slider2::destructor {self} { if {[dict get $@config -receivesymbol] != {}} { - pd_unbind [tclpd_get_instance_pd $self] $@recv + pd_unbind $self $@recv } } @@ -93,6 +94,10 @@ proc+ slider2::0_printconfig {self args} { } } +proc+ slider2::0_config2 {self args} { + uplevel "0_config $self [string map {$ @} $args]" +} + proc+ slider2::0_config {self args} { pd::post [info level 0] set newconf [list] @@ -119,21 +124,18 @@ proc+ slider2::0_config {self args} { # process -{send,receive}symbol if {[dict exists $newconf -receivesymbol]} { set new_recv [dict get $newconf -receivesymbol] - set selfpd [tclpd_get_instance_pd $self] if {[dict get $@config -receivesymbol] != {}} { - pd_unbind $selfpd $@recv + pd_unbind $self $@recv } if {$new_recv != {}} { - set @recv [canvas_realizedollar \ - [tclpd_get_glist $self] [gensym $new_recv]] - pd_bind $selfpd $@recv + set @recv [canvas_realizedollar $@canvas $new_recv] + pd_bind $self $@recv } else {set @recv {}} } if {[dict exists $newconf -sendsymbol]} { set new_send [dict get $newconf -sendsymbol] if {$new_send != {}} { - set @send [canvas_realizedollar \ - [tclpd_get_glist $self] [gensym $new_send]] + set @send [canvas_realizedollar $@canvas $new_send] } else {set @send {}} } # changing orient -> swap sizes @@ -168,8 +170,7 @@ proc+ slider2::0_config {self args} { sys_gui [list slider2_update $self $@c $@x $@y $@config $@state]\n } if {[dict exists $newconf -width] || [dict exists $newconf -height]} { - canvas_fixlinesfor \ - [tclpd_get_glist $self] [tclpd_get_instance_text $self] + canvas_fixlinesfor $@canvas $self } } @@ -221,12 +222,8 @@ proc+ slider2::properties {self} { dict set c $opt [dict get $c2 $opt] } - lappend c -foo - lappend c \$foo - - pd::post gfxstub_new [tclpd_get_object_pd $self] [tclpd_get_instance $self] \ - [list propertieswindow %s $c "\[slider2\] properties"] - gfxstub_new [tclpd_get_object_pd $self] [tclpd_get_instance $self] \ + set c [string map {$ @} $c] + gfxstub_new $self $self \ [list propertieswindow %s $c "\[slider2\] properties"]\n } @@ -278,8 +275,7 @@ proc+ slider2::widgetbehavior_click {self args} { } } set @motion_start_v [dict get $@config -initvalue] - tclpd_guiclass_grab [tclpd_get_instance $self] \ - [tclpd_get_glist $self] $x $y + tclpd_guiclass_grab $self $@canvas $x $y } } diff --git a/examples/tclpd-console.tcl b/examples/tclpd-console.tcl index 0c37904..56053cd 100644 --- a/examples/tclpd-console.tcl +++ b/examples/tclpd-console.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 package require base64 @@ -49,7 +49,8 @@ proc tclpd-console::constructor {self} { set ::tclpd-console::loaded 1 set ::${self}_loaded 1 - pd_bind [tclpd_get_instance_pd $self] [gensym $self] + # beware: typemap magic (1st arg get cast to a t_pd, second to a t_symbol) + pd_bind $self $self sys_gui "set ::tclpd_console $self" sys_gui { @@ -92,7 +93,7 @@ proc tclpd-console::destructor {self} { if {[set ::${self}_loaded]} { sys_gui { destroy .pdwindow.tcl.tclpd ; unset ::tclpd_console } - pd_unbind [tclpd_get_instance_pd $self] [gensym $self] + pd_unbind $self $self # restore original puts if {[info procs puts_tclpd_console] ne {}} { diff --git a/hashtable.c b/hashtable.c index c2fa96f..6d69c5e 100644 --- a/hashtable.c +++ b/hashtable.c @@ -12,8 +12,8 @@ uint32_t hash_str(const char *s) { return h ^ (h >> 16); } -list_node_t* list_add(list_node_t* head, const char* k, void* v) { - list_node_t* n = (list_node_t*)malloc(sizeof(list_node_t)); +list_node_t * list_add(list_node_t *head, const char *k, void *v) { + list_node_t *n = (list_node_t *)malloc(sizeof(list_node_t)); n->next = head; #ifdef HASHTABLE_COPY_KEYS n->k = strdup(k); @@ -24,10 +24,10 @@ list_node_t* list_add(list_node_t* head, const char* k, void* v) { return n; } -list_node_t* list_remove(list_node_t* head, const char* k) { +list_node_t * list_remove(list_node_t *head, const char *k) { if(!head) return NULL; - list_node_t* tmp; + list_node_t *tmp; // head remove while(head && strcmp(head->k, k) == 0) { @@ -39,7 +39,7 @@ list_node_t* list_remove(list_node_t* head, const char* k) { free(tmp); } - list_node_t* p = head; + list_node_t *p = head; // normal (non-head) remove while(p->next) { @@ -59,7 +59,7 @@ list_node_t* list_remove(list_node_t* head, const char* k) { return head; } -list_node_t* list_get(list_node_t* head, const char* k) { +list_node_t * list_get(list_node_t *head, const char *k) { while(head) { if(strcmp(head->k, k) == 0) { return head; @@ -69,7 +69,7 @@ list_node_t* list_get(list_node_t* head, const char* k) { return NULL; } -size_t list_length(list_node_t* head) { +size_t list_length(list_node_t *head) { size_t length = 0; while(head) { length++; @@ -78,18 +78,18 @@ size_t list_length(list_node_t* head) { return length; } -hash_table_t* hashtable_new(size_t size) { - hash_table_t* ht = NULL; +hash_table_t * hashtable_new(size_t size) { + hash_table_t *ht = NULL; if(size > 0) { - ht = (hash_table_t*)malloc(sizeof(hash_table_t)); + ht = (hash_table_t *)malloc(sizeof(hash_table_t)); ht->sz = size; - ht->t = (list_node_t**)malloc(sizeof(list_node_t*) * size); + ht->t = (list_node_t **)malloc(sizeof(list_node_t *) * size); for(int i = 0; i < size; i++) ht->t[i] = NULL; } return ht; } -void hashtable_free(hash_table_t* ht) { +void hashtable_free(hash_table_t *ht) { if(ht) { free(ht->t); free(ht); diff --git a/hashtable.h b/hashtable.h index f2d1a4a..a45de35 100644 --- a/hashtable.h +++ b/hashtable.h @@ -6,38 +6,38 @@ #include typedef struct list_node { - const char* k; - void* v; - struct list_node* next; + const char *k; + void *v; + struct list_node *next; } list_node_t; typedef struct hash_table { - list_node_t** t; + list_node_t **t; size_t sz; } hash_table_t; uint32_t hash_str(const char *s); -list_node_t* list_add(list_node_t* head, const char* k, void* v); -list_node_t* list_remove(list_node_t* head, const char* k); -list_node_t* list_get(list_node_t* head, const char* k); -size_t list_length(list_node_t* head); +list_node_t * list_add(list_node_t *head, const char *k, void *v); +list_node_t * list_remove(list_node_t *head, const char *k); +list_node_t * list_get(list_node_t *head, const char *k); +size_t list_length(list_node_t *head); -hash_table_t* hashtable_new(size_t size); -void hash_table_free(hash_table_t* ht); +hash_table_t * hashtable_new(size_t size); +void hash_table_free(hash_table_t *ht); -static inline void hashtable_add(hash_table_t* ht, const char* name, void* c) { +static inline void hashtable_add(hash_table_t *ht, const char *name, void *c) { uint32_t h = hash_str(name) % ht->sz; - ht->t[h] = list_add(ht->t[h], name, (void*)c); -} + ht->t[h] = list_add(ht->t[h], name, (void *)c); +} -static inline void hashtable_remove(hash_table_t* ht, const char* name) { +static inline void hashtable_remove(hash_table_t *ht, const char *name) { uint32_t h = hash_str(name) % ht->sz; ht->t[h] = list_remove(ht->t[h], name); } -static inline void* hashtable_get(hash_table_t* ht, const char* name) { +static inline void * hashtable_get(hash_table_t *ht, const char *name) { uint32_t h = hash_str(name) % ht->sz; - list_node_t* n = list_get(ht->t[h], name); + list_node_t *n = list_get(ht->t[h], name); return n ? n->v : NULL; } diff --git a/tcl.i b/tcl.i deleted file mode 100644 index af4628b..0000000 --- a/tcl.i +++ /dev/null @@ -1,124 +0,0 @@ -%module tclpd -%include exception.i -%include cpointer.i - -#define __attribute__(x) - -/* functions that are in m_pd.h but don't exist in modern versions of pd */ -%ignore pd_getfilename; -%ignore pd_getdirname; -%ignore pd_anything; -%ignore class_parentwidget; -%ignore sys_isreadablefile; -%ignore garray_get; -%ignore c_extern; -%ignore c_addmess; - -/* functions that we can't auto-wrap, because they have varargs */ -%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" - -%{ - #include "m_pd.h" - #include "tcl_extras.h" - - typedef t_atom t_atom_array; -%} - -/* this does the trick of solving - 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); - -%typemap(in) (int argc, t_atom *argv) { - if(Tcl_ListObjLength(tcl_for_pd, $input, &$1) == TCL_ERROR) - return TCL_ERROR; - $2 = (t_atom *)getbytes(sizeof(t_atom) * $1); - int i; - Tcl_Obj *oi; - for(i = 0; i < len; i++) { - oi = Tcl_ListObjIndex(tcl_for_pd, $input, i, &oi); - if(tcl_to_pdatom(oi, $2[i]) == TCL_ERROR) { - SWIG_fail; - } - } -} - -%typemap(in) t_atom * { - t_atom *a = (t_atom*)getbytes(sizeof(t_atom)); - if(tcl_to_pdatom($input, a) == TCL_ERROR) { - SWIG_fail; - } - $1 = a; -} - -%typemap(freearg) t_atom * { - freebytes($1, sizeof(t_atom)); -} - -%typemap(out) t_atom * { - Tcl_Obj* res_obj; - if(pdatom_to_tcl($1, &res_obj) == TCL_ERROR) { - SWIG_fail; - } - Tcl_SetObjResult(tcl_for_pd, res_obj); -} - -%typemap(in) t_symbol * { - t_symbol *s; - if(tcl_to_pdsymbol($input, &s) == TCL_ERROR) { - SWIG_fail; - } - $1 = s; -} - -%typemap(out) t_symbol * { - Tcl_Obj* res_obj; - if(pdsymbol_to_tcl($1, &res_obj) == TCL_ERROR) { - SWIG_fail; - } - Tcl_SetObjResult(tcl_for_pd, res_obj); -} - -/* helper functions for t_atom arrays */ -%inline %{ - t_atom_array *new_atom_array(int size) { - return (t_atom_array*)getbytes(size*sizeof(t_atom)); - } - - void delete_atom_array(t_atom_array *a, int size) { - freebytes(a, size*sizeof(t_atom)); - } - - t_atom* get_atom_array(t_atom_array *a, int index) { - return &a[index]; - } - - void set_atom_array(t_atom_array *a, int index, t_atom *n) { - memcpy(&a[index], n, sizeof(t_atom)); - } -%} - - diff --git a/tcl_class.c b/tcl_class.c index da8228f..46870e8 100644 --- a/tcl_class.c +++ b/tcl_class.c @@ -1,26 +1,42 @@ -#include "tcl_extras.h" +#include "tclpd.h" #include #include #include #include "hashtable.h" -static hash_table_t* class_table = NULL; -static hash_table_t* object_table = NULL; -static hash_table_t* source_table = NULL; +static hash_table_t *class_table = NULL; +static hash_table_t *object_table = NULL; +static hash_table_t *source_table = NULL; -#define class_table_add(n, c) hashtable_add(class_table, n, (void*)c) -#define class_table_remove(n) hashtable_remove(class_table, n) -#define class_table_get(n) ((t_class*)hashtable_get(class_table, n)) +void class_table_add(const char *n, t_class *c) { + hashtable_add(class_table, n, (void *)c); +} + +void class_table_remove(const char *n) { + hashtable_remove(class_table, n); +} + +t_class * class_table_get(const char *n) { + return (t_class *)hashtable_get(class_table, n); +} + +void object_table_add(const char *n, t_tcl *o) { + hashtable_add(object_table, n, (void *)o); +} + +void object_table_remove(const char *n) { + hashtable_remove(object_table, n); +} -#define object_table_add(n, c) hashtable_add(object_table, n, (void*)c) -#define object_table_remove(n) hashtable_remove(object_table, n) -#define object_table_get(n) ((t_tcl*)hashtable_get(object_table, n)) +t_tcl * object_table_get(const char *n) { + return (t_tcl *)hashtable_get(object_table, n); +} static unsigned long objectSequentialId = 0; /* set up the class that handles loading of tcl classes */ -t_class* tclpd_class_new(const char* name, int flags) { - t_class* c = class_new(gensym(name), (t_newmethod)tclpd_new, +t_class * tclpd_class_new(const char *name, int flags) { + t_class *c = class_new(gensym(name), (t_newmethod)tclpd_new, (t_method)tclpd_free, sizeof(t_tcl), flags, A_GIMME, A_NULL); if(!class_table) @@ -36,23 +52,23 @@ t_class* tclpd_class_new(const char* name, int flags) { class_addmethod(c, (t_method)tclpd_open, gensym("menu-open"), A_NULL); char buf[80]; - Tcl_Obj* res; + Tcl_Obj *res; int res_i; // use properties function if exists in tcl space. snprintf(buf, 80, "llength [info procs ::%s::properties]", name); - if(Tcl_Eval(tcl_for_pd, buf) == TCL_OK) { - res = Tcl_GetObjResult(tcl_for_pd); - if(Tcl_GetIntFromObj(tcl_for_pd, res, &res_i) == TCL_OK && res_i > 0) { + if(Tcl_Eval(tclpd_interp, buf) == TCL_OK) { + res = Tcl_GetObjResult(tclpd_interp); + if(Tcl_GetIntFromObj(tclpd_interp, res, &res_i) == TCL_OK && res_i > 0) { class_setpropertiesfn(c, tclpd_properties); } } // use save function if exists in tcl space. snprintf(buf, 80, "llength [info procs ::%s::save]", name); - if(Tcl_Eval(tcl_for_pd, buf) == TCL_OK) { - res = Tcl_GetObjResult(tcl_for_pd); - if(Tcl_GetIntFromObj(tcl_for_pd, res, &res_i) == TCL_OK && res_i > 0) { + if(Tcl_Eval(tclpd_interp, buf) == TCL_OK) { + res = Tcl_GetObjResult(tclpd_interp); + if(Tcl_GetIntFromObj(tclpd_interp, res, &res_i) == TCL_OK && res_i > 0) { class_setsavefn(c, tclpd_save); } } @@ -60,9 +76,9 @@ t_class* tclpd_class_new(const char* name, int flags) { return c; } -t_class* tclpd_guiclass_new(const char* name, int flags) { - t_class* c = tclpd_class_new(name, flags); - t_widgetbehavior* wb = (t_widgetbehavior*)getbytes(sizeof(t_widgetbehavior)); +t_class * tclpd_guiclass_new(const char *name, int flags) { + t_class *c = tclpd_class_new(name, flags); + t_widgetbehavior *wb = (t_widgetbehavior *)getbytes(sizeof(t_widgetbehavior)); wb->w_getrectfn = tclpd_guiclass_getrect; wb->w_displacefn = tclpd_guiclass_displace; wb->w_selectfn = tclpd_guiclass_select; @@ -74,14 +90,14 @@ t_class* tclpd_guiclass_new(const char* name, int flags) { return c; } -t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) { +t_tcl * tclpd_new(t_symbol *classsym, int ac, t_atom *at) { // lookup in class table - const char* name = classsym->s_name; - t_class* qlass = class_table_get(name); + const char *name = classsym->s_name; + t_class *qlass = class_table_get(name); - t_tcl* x = (t_tcl*)pd_new(qlass); + t_tcl *x = (t_tcl *)pd_new(qlass); x->ninlets = 1 /* qlass->c_firstin ??? */; - x->x_glist = (t_glist*)canvas_getcurrent(); + x->x_glist = (t_glist *)canvas_getcurrent(); x->source_file = (char *)hashtable_get(source_table, name); if(!x->source_file) { @@ -130,7 +146,7 @@ t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) { } // call constructor - if(Tcl_EvalObjv(tcl_for_pd, ac+3, av, 0) != TCL_OK) { + if(Tcl_EvalObjv(tclpd_interp, ac+3, av, 0) != TCL_OK) { goto error; } @@ -143,14 +159,14 @@ t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) { error: tclpd_interp_error(NULL, TCL_ERROR); for(int i = 0; i < (ac+3); i++) { - if(!av[i]) break; // XXX: I don't remind why I add this + if(!av[i]) break; // could have gone here before doing all av[]s Tcl_DecrRefCount(av[i]); } - pd_free((t_pd*)x); + pd_free((t_pd *)x); return 0; } -void tclpd_free(t_tcl* x) { +void tclpd_free(t_tcl *x) { // build destructor command Tcl_Obj *av[3]; InitArray(av, 3, NULL); av[0] = x->dispatcher; @@ -161,7 +177,7 @@ void tclpd_free(t_tcl* x) { Tcl_IncrRefCount(av[2]); // call destructor - if(Tcl_EvalObjv(tcl_for_pd, 3, av, 0) != TCL_OK) { + if(Tcl_EvalObjv(tclpd_interp, 3, av, 0) != TCL_OK) { #ifdef DEBUG post("tclpd_free: failed to call destructor"); #endif @@ -181,13 +197,13 @@ void tclpd_free(t_tcl* x) { #endif } -void tclpd_anything(t_tcl* x, t_symbol* s, int ac, t_atom* 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* x, 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: method args... - Tcl_Obj* av[ac+5]; InitArray(av, ac+5, NULL); + Tcl_Obj *av[ac+5]; InitArray(av, ac+5, NULL); int result; av[0] = x->dispatcher; @@ -211,7 +227,7 @@ void tclpd_inlet_anything(t_tcl* x, int inlet, t_symbol* s, int ac, t_atom* at) goto error; } } - result = Tcl_EvalObjv(tcl_for_pd, ac+5, av, 0); + result = Tcl_EvalObjv(tclpd_interp, ac+5, av, 0); if(result != TCL_OK) { goto error; } @@ -225,13 +241,13 @@ void tclpd_inlet_anything(t_tcl* x, int inlet, t_symbol* s, int ac, t_atom* at) error: tclpd_interp_error(x, TCL_ERROR); for(int i=0; i < (ac+5); i++) { - if(!av[i]) break; + if(!av[i]) break; // could have gone here before doing all av[]s Tcl_DecrRefCount(av[i]); } return; } -void tclpd_loadbang(t_tcl* x) { +void tclpd_loadbang(t_tcl *x) { tclpd_inlet_anything(x, 0, gensym("loadbang"), 0, NULL); } @@ -244,8 +260,8 @@ void tclpd_open(t_tcl *x) { /* Tcl glue: */ -t_proxyinlet* tclpd_add_proxyinlet(t_tcl* x) { - t_proxyinlet* proxy = (t_proxyinlet*)pd_new(proxyinlet_class); +t_proxyinlet * tclpd_add_proxyinlet(t_tcl *x) { + t_proxyinlet *proxy = (t_proxyinlet *)pd_new(proxyinlet_class); proxyinlet_init(proxy); proxy->target = x; proxy->ninlet = x->ninlets++; @@ -253,57 +269,71 @@ t_proxyinlet* tclpd_add_proxyinlet(t_tcl* x) { return proxy; } -t_tcl* tclpd_get_instance(const char* objectSequentialId) { - return (t_tcl*)object_table_get(objectSequentialId); +/* +t_tcl * tclpd_get_instance(const char *objectSequentialId) { + return (t_tcl *)object_table_get(objectSequentialId); } -t_pd* tclpd_get_instance_pd(const char* objectSequentialId) { - return (t_pd*)object_table_get(objectSequentialId); +t_pd * tclpd_get_instance_pd(const char *objectSequentialId) { + return (t_pd *)object_table_get(objectSequentialId); } -t_text* tclpd_get_instance_text(const char* objectSequentialId) { - return (t_text*)object_table_get(objectSequentialId); +t_text * tclpd_get_instance_text(const char *objectSequentialId) { + return (t_text *)object_table_get(objectSequentialId); } -t_object* tclpd_get_object(const char* objectSequentialId) { - t_tcl* x = tclpd_get_instance(objectSequentialId); +t_object * tclpd_get_object(const char *objectSequentialId) { + t_tcl *x = tclpd_get_instance(objectSequentialId); return &x->o; } -t_pd* tclpd_get_object_pd(const char* objectSequentialId) { - t_object* o = tclpd_get_object(objectSequentialId); +t_pd * tclpd_get_object_pd(const char *objectSequentialId) { + t_object *o = tclpd_get_object(objectSequentialId); return &o->ob_pd; } -t_binbuf* tclpd_get_object_binbuf(const char* objectSequentialId) { - t_object* o = tclpd_get_object(objectSequentialId); +t_binbuf * tclpd_get_object_binbuf(const char *objectSequentialId) { + t_object *o = tclpd_get_object(objectSequentialId); return o->ob_binbuf; } -t_glist* tclpd_get_glist(const char* objectSequentialId) { - t_tcl* x = tclpd_get_instance(objectSequentialId); +t_glist * tclpd_get_glist(const char *objectSequentialId) { + t_tcl *x = tclpd_get_instance(objectSequentialId); return x->x_glist; } -t_atom* tclpd_binbuf_get_atom(t_binbuf* b, int n) { +t_atom * tclpd_binbuf_get_atom(t_binbuf *b, int n) { if(binbuf_getnatom(b) <= n || n < 0) return NULL; return binbuf_getvec(b) + n; } +*/ + +t_object * CAST_t_object(t_object *o) { + return o; +} + +t_pd * CAST_t_pd(t_pd *o) { + return o; +} -t_symbol* null_symbol() { - return (t_symbol*)0; +t_text * CAST_t_text(t_text *o) { + return o; +} + +t_tcl * CAST_t_tcl(t_tcl *o) { + return o; } void poststring2 (const char *s) { post("%s", s); } -void tclpd_save(t_gobj* z, t_binbuf* b) { - Tcl_Obj* av[3]; InitArray(av, 3, NULL); - Tcl_Obj* res; +void tclpd_save(t_gobj *z, t_binbuf *b) { + Tcl_Obj *av[3]; InitArray(av, 3, NULL); + Tcl_Obj *res; - t_tcl* x = (t_tcl*)z; + t_tcl *x = (t_tcl *)z; av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); @@ -312,13 +342,13 @@ void tclpd_save(t_gobj* z, t_binbuf* b) { av[2] = Tcl_NewStringObj("save", -1); Tcl_IncrRefCount(av[2]); - int result = Tcl_EvalObjv(tcl_for_pd, 3, av, 0); + int result = Tcl_EvalObjv(tclpd_interp, 3, av, 0); if(result == TCL_OK) { - res = Tcl_GetObjResult(tcl_for_pd); + res = Tcl_GetObjResult(tclpd_interp); Tcl_IncrRefCount(res); int objc; - Tcl_Obj** objv; - result = Tcl_ListObjGetElements(tcl_for_pd, res, &objc, &objv); + Tcl_Obj **objv; + result = Tcl_ListObjGetElements(tclpd_interp, res, &objc, &objv); if(result == TCL_OK) { if(objc == 0 && objv == NULL) { // call default savefn @@ -328,11 +358,11 @@ void tclpd_save(t_gobj* z, t_binbuf* b) { int i; double tmp; for(i = 0; i < objc; i++) { - result = Tcl_GetDoubleFromObj(tcl_for_pd, objv[i], &tmp); + result = Tcl_GetDoubleFromObj(tclpd_interp, objv[i], &tmp); if(result == TCL_OK) { binbuf_addv(b, "f", (t_float)tmp); } else { - char* tmps = Tcl_GetStringFromObj(objv[i], NULL); + char *tmps = Tcl_GetStringFromObj(objv[i], NULL); if(!strcmp(tmps, ";")) { binbuf_addv(b, ";"); } else { @@ -356,10 +386,10 @@ void tclpd_save(t_gobj* z, t_binbuf* b) { Tcl_DecrRefCount(av[2]); } -void tclpd_properties(t_gobj* z, t_glist* owner) { - Tcl_Obj* av[3]; InitArray(av, 3, NULL); +void tclpd_properties(t_gobj *z, t_glist *owner) { + Tcl_Obj *av[3]; InitArray(av, 3, NULL); - t_tcl* x = (t_tcl*)z; + t_tcl *x = (t_tcl *)z; av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); @@ -368,9 +398,9 @@ void tclpd_properties(t_gobj* z, t_glist* owner) { av[2] = Tcl_NewStringObj("properties", -1); Tcl_IncrRefCount(av[2]); - int result = Tcl_EvalObjv(tcl_for_pd, 3, av, 0); + int result = Tcl_EvalObjv(tclpd_interp, 3, av, 0); if(result != TCL_OK) { - //res = Tcl_GetObjResult(tcl_for_pd); + //res = Tcl_GetObjResult(tclpd_interp); pd_error(x, "Tcl: object properties: failed"); tclpd_interp_error(x, result); } @@ -380,13 +410,13 @@ void tclpd_properties(t_gobj* z, t_glist* owner) { Tcl_DecrRefCount(av[2]); } -void tclpd_class_namespace_init(const char* classname) { +void tclpd_class_namespace_init(const char *classname) { char cmd[256]; snprintf(cmd, 256, "if [namespace exists ::%s] " "{namespace delete ::%s}; " "namespace eval ::%s {}", classname, classname, classname); - Tcl_Eval(tcl_for_pd, cmd); + Tcl_Eval(tclpd_interp, cmd); } void source_table_remove(const char *object_name) { diff --git a/tcl_extras.h b/tcl_extras.h deleted file mode 100644 index f09a7ba..0000000 --- a/tcl_extras.h +++ /dev/null @@ -1,109 +0,0 @@ -#include "m_pd.h" -//#include "m_imp.h" -#include "g_canvas.h" -//#include "s_stuff.h" - -#include - -/* PATH_MAX is not defined in limits.h on some platforms */ -#ifndef PATH_MAX -#define PATH_MAX 4096 -#endif - -#define TCLPD_VERSION "0.2.3" - -#define InitArray(name, size, value) for(int zz=0; zz<(size); zz++) name[zz]=value - -typedef struct _t_tcl { - t_object o; - int ninlets; - t_glist* x_glist; - - char *source_file; - - // Tcl-interpreter related objects: - Tcl_Obj* self; - Tcl_Obj* classname; - Tcl_Obj* dispatcher; -} t_tcl; - -typedef struct _t_proxyinlet { - t_object obj; - t_tcl* target; - int ninlet; - t_symbol* sel; - int argc; - t_atom* argv; -} t_proxyinlet; - -/* tcl_proxyinlet.c */ -extern t_class* proxyinlet_class; -void proxyinlet_init(t_proxyinlet* x); -void proxyinlet_clear(t_proxyinlet* x); -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); - -/* tcl_wrap.c */ -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); - -/* tclpd.c */ -extern Tcl_Interp* tcl_for_pd; -extern void tclpd_setup(void); -void tclpd_interp_error(t_tcl* x, int result); - -/* tcl_class.c */ -t_class* tclpd_class_new(const char* name, int flags); -t_class* tclpd_guiclass_new(const 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_inlet_anything(t_tcl *self, int inlet, t_symbol *s, int ac, t_atom *at); -void tclpd_loadbang(t_tcl* x); -void tclpd_open(t_tcl* x); -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_text* tclpd_get_instance_text(const char* objectSequentialId); -t_object* tclpd_get_object(const char* objectSequentialId); -t_pd* tclpd_get_object_pd(const char* objectSequentialId); -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_symbol* null_symbol(); -void poststring2(const char* s); -extern void text_save(t_gobj *z, t_binbuf *b); -void tclpd_save(t_gobj* z, t_binbuf* b); -void tclpd_properties(t_gobj* z, t_glist* owner); -void tclpd_class_namespace_init(const char* classname); - -/* tcl_widgetbehavior.c */ -void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* xp2, int* yp2); -void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy); -void tclpd_guiclass_select(t_gobj* z, t_glist* glist, int selected); -void tclpd_guiclass_activate(t_gobj* z, t_glist* glist, int state); -void tclpd_guiclass_delete(t_gobj* z, t_glist* glist); -void tclpd_guiclass_vis(t_gobj* z, t_glist* glist, int vis); -int tclpd_guiclass_click(t_gobj* z, t_glist* glist, int xpix, int ypix, int shift, int alt, int dbl, int doit); -void tclpd_guiclass_motion(t_tcl* x, t_floatarg dx, t_floatarg dy); -void tclpd_guiclass_grab(t_tcl* x, t_glist* glist, int xpix, int ypix); - -/* tcl_loader.c */ -extern int tclpd_do_load_lib(t_canvas* canvas, char* objectname); -/* pd loader private stuff: */ -typedef int (*loader_t)(t_canvas *canvas, char* classname); -extern void sys_register_loader(loader_t loader); -extern int sys_onloadlist(char* classname); -extern void sys_putonloadlist(char* classname); -extern void class_set_extern_dir(t_symbol* s); diff --git a/tcl_loader.c b/tcl_loader.c index 9ff6723..a1b1f16 100644 --- a/tcl_loader.c +++ b/tcl_loader.c @@ -1,4 +1,4 @@ -#include "tcl_extras.h" +#include "tclpd.h" #include #include @@ -7,9 +7,6 @@ void source_table_add(const char *object_name, const char *source_path); extern int tclpd_do_load_lib(t_canvas *canvas, char *objectname) { -#ifdef DEBUG - post("Tcl loader: registering tcl class loader mechanism"); -#endif char filename[MAXPDSTRING], dirbuf[MAXPDSTRING], *classname, *nameptr; int fd; @@ -20,49 +17,56 @@ extern int tclpd_do_load_lib(t_canvas *canvas, char *objectname) { classname = objectname; if(sys_onloadlist(objectname)) { - post("%s: already loaded", objectname); - return (1); + verbose(-1, "tclpd loader: already loaded: %s", objectname); + return 1; } /* try looking in the path for (objectname).(tcl) ... */ + verbose(-1, "tclpd loader: searching for %s in path...", objectname); if ((fd = canvas_open(canvas, objectname, ".tcl", dirbuf, &nameptr, MAXPDSTRING, 1)) >= 0) - goto gotone; + goto found; /* next try (objectname)/(classname).(tcl) ... */ strncpy(filename, objectname, MAXPDSTRING); - filename[MAXPDSTRING-2] = 0; + filename[MAXPDSTRING - 2] = 0; strcat(filename, "/"); strncat(filename, classname, MAXPDSTRING-strlen(filename)); - filename[MAXPDSTRING-1] = 0; + filename[MAXPDSTRING - 1] = 0; + verbose(-1, "tclpd loader: searching for %s in path...", filename); if ((fd = canvas_open(canvas, filename, ".tcl", dirbuf, &nameptr, MAXPDSTRING, 1)) >= 0) - goto gotone; + goto found; + verbose(-1, "tclpd loader: found nothing!"); return 0; -gotone: +found: + verbose(-1, "tclpd loader: found!"); close(fd); class_set_extern_dir(gensym(dirbuf)); /* rebuild the absolute pathname */ strncpy(filename, dirbuf, MAXPDSTRING); - filename[MAXPDSTRING-2] = 0; + filename[MAXPDSTRING - 2] = 0; strcat(filename, "/"); - strncat(filename, nameptr, MAXPDSTRING-strlen(filename)); - filename[MAXPDSTRING-1] = 0; + strncat(filename, nameptr, MAXPDSTRING - strlen(filename)); + filename[MAXPDSTRING - 1] = 0; + verbose(-1, "tclpd loader: absolute path is %s", filename); int result; // create the required tcl namespace for the class + verbose(-1, "tclpd loader: init namespace for class %s", classname); tclpd_class_namespace_init(classname); // load tcl external: - result = Tcl_EvalFile(tcl_for_pd, filename); + verbose(-1, "tclpd loader: loading tcl file %s", filename); + result = Tcl_EvalFile(tclpd_interp, filename); if(result == TCL_OK) { source_table_add(objectname, filename); - verbose(0, "Tcl loader: loaded %s", filename); + verbose(0, "tclpd loader: loaded %s", filename); } else { - error("Tcl loader: error trying to load %s", filename); + error("tclpd loader: error trying to load %s", filename); tclpd_interp_error(NULL, result); return 0; } @@ -71,10 +75,11 @@ gotone: // call the setup method: char cmd[64]; snprintf(cmd, 64, "::%s::setup", classname); - result = Tcl_Eval(tcl_for_pd, cmd); + verbose(-1, "tclpd loader: calling setup function for %s", classname); + result = Tcl_Eval(tclpd_interp, cmd); if(result == TCL_OK) { } else { - error("Tcl loader: error in %s %s::setup", filename, classname); + error("tclpd loader: error in %s %s::setup", filename, classname); tclpd_interp_error(NULL, result); return 0; } diff --git a/tcl_proxyinlet.c b/tcl_proxyinlet.c index e1cdb48..295b2db 100644 --- a/tcl_proxyinlet.c +++ b/tcl_proxyinlet.c @@ -1,8 +1,8 @@ -#include "tcl_extras.h" +#include "tclpd.h" -t_class* proxyinlet_class; +t_class *proxyinlet_class; -void proxyinlet_init(t_proxyinlet* x) { +void proxyinlet_init(t_proxyinlet *x) { //x->pd = proxyinlet_class; x->target = NULL; x->sel = gensym("none"); @@ -10,7 +10,7 @@ void proxyinlet_init(t_proxyinlet* x) { x->argv = NULL; } -void proxyinlet_clear(t_proxyinlet* x) { +void proxyinlet_clear(t_proxyinlet *x) { if(x->argv) { freebytes(x->argv, x->argc * sizeof(*x->argv)); } @@ -18,10 +18,10 @@ 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) { +void proxyinlet_anything(t_proxyinlet *x, t_symbol *s, int argc, t_atom *argv) { proxyinlet_clear(x); - if(!(x->argv = (t_atom*)getbytes((argc+PROXYINLET_SEL_TO_LIST) * 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; @@ -39,22 +39,22 @@ void proxyinlet_anything(t_proxyinlet* x, t_symbol* s, int argc, t_atom* argv) { proxyinlet_trigger(x); } -void proxyinlet_trigger(t_proxyinlet* x) { +void proxyinlet_trigger(t_proxyinlet *x) { if(x->target != NULL && x->sel != gensym("none")) { tclpd_inlet_anything(x->target, x->ninlet, x->sel, x->argc, x->argv); } } -t_atom* proxyinlet_get_atoms(t_proxyinlet* x) { +t_atom * proxyinlet_get_atoms(t_proxyinlet *x) { return x->argv; } -void proxyinlet_clone(t_proxyinlet* x, t_proxyinlet* y) { +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)))) { + if(!(y->argv = (t_atom *)getbytes(y->argc * sizeof(*y->argv)))) { y->argc = 0; error("proxyinlet: getbytes: out of memory"); return; diff --git a/tcl_typemap.c b/tcl_typemap.c index 486f015..0f4b5d0 100644 --- a/tcl_typemap.c +++ b/tcl_typemap.c @@ -1,22 +1,22 @@ -#include "tcl_extras.h" +#include "tclpd.h" #include int tcl_to_pdatom(Tcl_Obj *input, t_atom *output) { int llength; - if(Tcl_ListObjLength(tcl_for_pd, input, &llength) == TCL_ERROR) + 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(tcl_for_pd, input, i, &obj[i]); - char* argv0 = Tcl_GetStringFromObj(obj[0], 0); + 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(tcl_for_pd, obj[1], &dbl) == TCL_ERROR) + if(Tcl_GetDoubleFromObj(tclpd_interp, obj[1], &dbl) == TCL_ERROR) return TCL_ERROR; SETFLOAT(output, dbl); } else if(strcmp(argv0, "symbol") == 0) { @@ -29,12 +29,12 @@ int tcl_to_pdatom(Tcl_Obj *input, t_atom *output) { } int tcl_to_pdsymbol(Tcl_Obj *input, t_symbol **output) { - char* s = Tcl_GetStringFromObj(input, 0); + char *s = Tcl_GetStringFromObj(input, 0); *output = gensym(s); return TCL_OK; } -const char* pdatom_type_string(t_atom* a) { +const char * pdatom_type_string(t_atom *a) { switch(a->a_type) { case A_FLOAT: case A_DEFFLOAT: @@ -54,28 +54,22 @@ const char* pdatom_type_string(t_atom* a) { } } -const char* pdatom_symbol_value(t_atom* a) { +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); + t_symbol *s = gensym(buf); return s->s_name; } return a->a_w.w_symbol->s_name; } -float pdatom_float_value(t_atom* a) { +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]; -#ifdef DEBUG - post("pdatom_to_tcl: atom type = %d (%s)", - input->a_type, input->a_type == A_FLOAT ? "A_FLOAT" : - input->a_type == A_SYMBOL ? "A_SYMBOL" : - input->a_type == A_POINTER ? "A_POINTER" : "?"); -#endif + Tcl_Obj *tcl_t_atom[2]; switch (input->a_type) { case A_FLOAT: { tcl_t_atom[0] = Tcl_NewStringObj("float", -1); @@ -99,8 +93,10 @@ int pdatom_to_tcl(t_atom *input, Tcl_Obj **output) { break; } } -#ifdef DEBUG - post("pdatom_to_tcl: atom value = \"%s\"", Tcl_GetStringFromObj(tcl_t_atom[1], 0)); +#if 0 + verbose(-1, "tclpd: pdatom_to_tcl: atom [type = %s, value = %s]", + Tcl_GetStringFromObj(tcl_t_atom[0], 0), + Tcl_GetStringFromObj(tcl_t_atom[1], 0)); #endif *output = Tcl_NewListObj(2, &tcl_t_atom[0]); Tcl_IncrRefCount(*output); @@ -108,10 +104,14 @@ int pdatom_to_tcl(t_atom *input, Tcl_Obj **output) { } int pdsymbol_to_tcl(t_symbol *input, Tcl_Obj **output) { - Tcl_Obj* s[2]; +#if 0 + Tcl_Obj *s[2]; s[0] = Tcl_NewStringObj("symbol", -1); s[1] = Tcl_NewStringObj(input->s_name, -1); *output = Tcl_NewListObj(2, &s[0]); +#else + *output = Tcl_NewStringObj(input->s_name, -1); +#endif Tcl_IncrRefCount(*output); return TCL_OK; } diff --git a/tcl_widgetbehavior.c b/tcl_widgetbehavior.c index 2a1186f..47be1e1 100644 --- a/tcl_widgetbehavior.c +++ b/tcl_widgetbehavior.c @@ -1,8 +1,8 @@ -#include "tcl_extras.h" +#include "tclpd.h" #include -void tclpd_guiclass_motion(t_tcl* x, t_floatarg dx, t_floatarg dy) { - Tcl_Obj* av[6]; InitArray(av, 6, NULL); +void tclpd_guiclass_motion(t_tcl *x, t_floatarg dx, t_floatarg dy) { + Tcl_Obj *av[6]; InitArray(av, 6, NULL); av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); av[1] = x->self; @@ -15,7 +15,7 @@ void tclpd_guiclass_motion(t_tcl* x, t_floatarg dx, t_floatarg dy) { Tcl_IncrRefCount(av[4]); av[5] = Tcl_NewDoubleObj(dy); Tcl_IncrRefCount(av[5]); - int result = Tcl_EvalObjv(tcl_for_pd, 6, av, 0); + int result = Tcl_EvalObjv(tclpd_interp, 6, av, 0); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; @@ -31,16 +31,16 @@ cleanup: Tcl_DecrRefCount(av[5]); } -void tclpd_guiclass_grab(t_tcl* x, t_glist* glist, int xpix, int ypix) { +void tclpd_guiclass_grab(t_tcl *x, t_glist *glist, int xpix, int ypix) { glist_grab(glist, &x->o.te_g, (t_glistmotionfn)tclpd_guiclass_motion, 0, \ (t_floatarg)xpix, (t_floatarg)ypix); } -int tclpd_guiclass_click(t_gobj* z, t_glist* glist, int xpix, int ypix, int shift, int alt, int dbl, int doit) { - Tcl_Obj* av[10]; InitArray(av, 10, NULL); - Tcl_Obj* o = NULL; +int tclpd_guiclass_click(t_gobj *z, t_glist *glist, int xpix, int ypix, int shift, int alt, int dbl, int doit) { + Tcl_Obj *av[10]; InitArray(av, 10, NULL); + Tcl_Obj *o = NULL; int i = 0; - t_tcl* x = (t_tcl*)z; + t_tcl *x = (t_tcl *)z; av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); av[1] = x->self; @@ -61,14 +61,14 @@ int tclpd_guiclass_click(t_gobj* z, t_glist* glist, int xpix, int ypix, int shif Tcl_IncrRefCount(av[8]); av[9] = Tcl_NewIntObj(doit); Tcl_IncrRefCount(av[9]); - int result = Tcl_EvalObjv(tcl_for_pd, 10, av, 0); + int result = Tcl_EvalObjv(tclpd_interp, 10, av, 0); if(result != TCL_OK) { goto error; } - o = Tcl_GetObjResult(tcl_for_pd); + o = Tcl_GetObjResult(tclpd_interp); Tcl_IncrRefCount(o); if(strlen(Tcl_GetStringFromObj(o, NULL)) > 0) { - result = Tcl_GetIntFromObj(tcl_for_pd, o, &i); + result = Tcl_GetIntFromObj(tclpd_interp, o, &i); if(result != TCL_OK) { goto error; } @@ -95,12 +95,12 @@ cleanup: return i; } -void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* xp2, int* yp2) { - Tcl_Obj* av[6]; InitArray(av, 6, NULL); - Tcl_Obj* o; - Tcl_Obj* theList = NULL; +void tclpd_guiclass_getrect(t_gobj *z, t_glist *owner, int *xp1, int *yp1, int *xp2, int *yp2) { + Tcl_Obj *av[6]; InitArray(av, 6, NULL); + Tcl_Obj *o; + Tcl_Obj *theList = NULL; int tmp[4], i, length; - t_tcl* x = (t_tcl*)z; + t_tcl *x = (t_tcl *)z; av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); av[1] = x->self; @@ -113,16 +113,16 @@ void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* Tcl_IncrRefCount(av[4]); av[5] = Tcl_NewIntObj(text_ypix(&x->o, owner)); Tcl_IncrRefCount(av[5]); - int result = Tcl_EvalObjv(tcl_for_pd, 6, av, 0); + int result = Tcl_EvalObjv(tclpd_interp, 6, av, 0); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; } - theList = Tcl_GetObjResult(tcl_for_pd); + theList = Tcl_GetObjResult(tclpd_interp); Tcl_IncrRefCount(theList); length = 0; - //result = Tcl_ListObjGetElements(tcl_for_pd, theList, @, @); - result = Tcl_ListObjLength(tcl_for_pd, theList, &length); + //result = Tcl_ListObjGetElements(tclpd_interp, theList, @, @); + result = Tcl_ListObjLength(tclpd_interp, theList, &length); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; @@ -133,12 +133,12 @@ void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* } o = NULL; for(i = 0; i < 4; i++) { - result = Tcl_ListObjIndex(tcl_for_pd, theList, i, &o); + result = Tcl_ListObjIndex(tclpd_interp, theList, i, &o); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; } - result = Tcl_GetIntFromObj(tcl_for_pd, o, &tmp[i]); + result = Tcl_GetIntFromObj(tclpd_interp, o, &tmp[i]); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; @@ -157,12 +157,12 @@ cleanup: Tcl_DecrRefCount(av[5]); } -void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy) { - Tcl_Obj* av[6]; InitArray(av, 6, NULL); - Tcl_Obj* theList = NULL; - Tcl_Obj* o; +void tclpd_guiclass_displace(t_gobj *z, t_glist *glist, int dx, int dy) { + Tcl_Obj *av[6]; InitArray(av, 6, NULL); + Tcl_Obj *theList = NULL; + Tcl_Obj *o; int length, i, tmp[2]; - t_tcl* x = (t_tcl*)z; + t_tcl *x = (t_tcl *)z; av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); av[1] = x->self; @@ -175,16 +175,16 @@ void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy) { Tcl_IncrRefCount(av[4]); av[5] = Tcl_NewIntObj(dy); Tcl_IncrRefCount(av[5]); - int result = Tcl_EvalObjv(tcl_for_pd, 6, av, 0); + int result = Tcl_EvalObjv(tclpd_interp, 6, av, 0); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; } - theList = Tcl_GetObjResult(tcl_for_pd); + theList = Tcl_GetObjResult(tclpd_interp); Tcl_IncrRefCount(theList); length = 0; - //result = Tcl_ListObjGetElements(tcl_for_pd, theList, @, @); - result = Tcl_ListObjLength(tcl_for_pd, theList, &length); + //result = Tcl_ListObjGetElements(tclpd_interp, theList, @, @); + result = Tcl_ListObjLength(tclpd_interp, theList, &length); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; @@ -195,12 +195,12 @@ void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy) { } o = NULL; for(i = 0; i < 2; i++) { - result = Tcl_ListObjIndex(tcl_for_pd, theList, i, &o); + result = Tcl_ListObjIndex(tclpd_interp, theList, i, &o); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; } - result = Tcl_GetIntFromObj(tcl_for_pd, o, &tmp[i]); + result = Tcl_GetIntFromObj(tclpd_interp, o, &tmp[i]); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; @@ -208,7 +208,7 @@ void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy) { } x->o.te_xpix = tmp[0]; x->o.te_ypix = tmp[1]; - canvas_fixlinesfor(glist_getcanvas(glist), (t_text*)x); + canvas_fixlinesfor(glist_getcanvas(glist), (t_text *)x); goto cleanup; error: cleanup: @@ -221,9 +221,9 @@ cleanup: Tcl_DecrRefCount(av[5]); } -void tclpd_guiclass_select(t_gobj* z, t_glist* glist, int selected) { - Tcl_Obj* av[5]; InitArray(av, 5, NULL); - t_tcl* x = (t_tcl*)z; +void tclpd_guiclass_select(t_gobj *z, t_glist *glist, int selected) { + Tcl_Obj *av[5]; InitArray(av, 5, NULL); + t_tcl *x = (t_tcl *)z; av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); av[1] = x->self; @@ -234,7 +234,7 @@ void tclpd_guiclass_select(t_gobj* z, t_glist* glist, int selected) { Tcl_IncrRefCount(av[3]); av[4] = Tcl_NewIntObj(selected); Tcl_IncrRefCount(av[4]); - int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); + int result = Tcl_EvalObjv(tclpd_interp, 5, av, 0); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; @@ -249,9 +249,9 @@ cleanup: Tcl_DecrRefCount(av[4]); } -void tclpd_guiclass_activate(t_gobj* z, t_glist* glist, int state) { - Tcl_Obj* av[5]; InitArray(av, 5, NULL); - t_tcl* x = (t_tcl*)z; +void tclpd_guiclass_activate(t_gobj *z, t_glist *glist, int state) { + Tcl_Obj *av[5]; InitArray(av, 5, NULL); + t_tcl *x = (t_tcl *)z; av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); av[1] = x->self; @@ -262,7 +262,7 @@ void tclpd_guiclass_activate(t_gobj* z, t_glist* glist, int state) { Tcl_IncrRefCount(av[3]); av[4] = Tcl_NewIntObj(state); Tcl_IncrRefCount(av[4]); - int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); + int result = Tcl_EvalObjv(tclpd_interp, 5, av, 0); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; @@ -277,14 +277,14 @@ cleanup: Tcl_DecrRefCount(av[4]); } -void tclpd_guiclass_delete(t_gobj* z, t_glist* glist) { +void tclpd_guiclass_delete(t_gobj *z, t_glist *glist) { /* will this be ever need to be accessed in Tcl land? */ - canvas_deletelinesfor(glist_getcanvas(glist), (t_text*)z); + canvas_deletelinesfor(glist_getcanvas(glist), (t_text *)z); } -void tclpd_guiclass_vis(t_gobj* z, t_glist* glist, int vis) { - Tcl_Obj* av[8]; InitArray(av, 8, NULL); - t_tcl* x = (t_tcl*)z; +void tclpd_guiclass_vis(t_gobj *z, t_glist *glist, int vis) { + Tcl_Obj *av[8]; InitArray(av, 8, NULL); + t_tcl *x = (t_tcl *)z; av[0] = x->dispatcher; Tcl_IncrRefCount(av[0]); av[1] = x->self; @@ -303,7 +303,7 @@ void tclpd_guiclass_vis(t_gobj* z, t_glist* glist, int vis) { Tcl_IncrRefCount(av[6]); av[7] = Tcl_NewIntObj(vis); Tcl_IncrRefCount(av[7]); - int result = Tcl_EvalObjv(tcl_for_pd, 8, av, 0); + int result = Tcl_EvalObjv(tclpd_interp, 8, av, 0); if(result != TCL_OK) { tclpd_interp_error(x, result); goto error; diff --git a/tclpd-meta.pd b/tclpd-meta.pd index 3ef5d2a..d223f45 100644 --- a/tclpd-meta.pd +++ b/tclpd-meta.pd @@ -2,5 +2,5 @@ #N canvas 25 49 420 300 META 1; #X text 13 41 NAME tclpd; #X text 10 25 AUTHOR Federico Ferri; -#X text 10 10 VERSION 0.2.3; +#X text 10 10 VERSION 0.3.0; #X restore 10 10 pd META; diff --git a/tclpd.c b/tclpd.c index 0440952..6925852 100644 --- a/tclpd.c +++ b/tclpd.c @@ -1,13 +1,13 @@ -#include "tcl_extras.h" +#include "tclpd.h" #include #include #include #include -Tcl_Interp *tcl_for_pd = NULL; +Tcl_Interp *tclpd_interp = NULL; void tclpd_setup(void) { - if(tcl_for_pd) { + if(tclpd_interp) { return; } @@ -16,41 +16,52 @@ void tclpd_setup(void) { proxyinlet_setup(); - tcl_for_pd = Tcl_CreateInterp(); - Tcl_Init(tcl_for_pd); - Tclpd_SafeInit(tcl_for_pd); + tclpd_interp = Tcl_CreateInterp(); + Tcl_Init(tclpd_interp); + Tclpd_SafeInit(tclpd_interp); - Tcl_Eval(tcl_for_pd, "package provide Tclpd " TCLPD_VERSION); + Tcl_Eval(tclpd_interp, "package provide Tclpd " TCLPD_VERSION); - t_class* foo_class = class_new(gensym("tclpd_init"), 0, 0, 0, 0, 0); + t_class *foo_class = class_new(gensym("tclpd_init"), 0, 0, 0, 0, 0); char buf[PATH_MAX]; - snprintf(buf, PATH_MAX, "%s/tclpd.tcl", foo_class->c_externdir->s_name); - if(Tcl_EvalFile(tcl_for_pd, buf) != TCL_OK) { - error("tclpd loader: error loading %s", buf); + verbose(-1, "tclpd: trying to load %s...", buf); + int result = Tcl_EvalFile(tclpd_interp, buf); + switch(result) { + case TCL_ERROR: + error("tclpd: error loading %s", buf); + break; + case TCL_RETURN: + error("tclpd: warning: %s exited with code return", buf); + break; + case TCL_BREAK: + case TCL_CONTINUE: + error("tclpd: warning: %s exited with code break/continue", buf); + break; } + verbose(-1, "tclpd: loaded %s", buf); sys_register_loader(tclpd_do_load_lib); } -void tclpd_interp_error(t_tcl* x, int result) { - error("tclpd error: %s", Tcl_GetStringResult(tcl_for_pd)); +void tclpd_interp_error(t_tcl *x, int result) { + error("tclpd error: %s", Tcl_GetStringResult(tclpd_interp)); - logpost(x, 3, "------------------- Tcl error: -------------------\n"); + logpost(x, 3, "------------------- Tcl error: -------------------"); // Tcl_GetReturnOptions and Tcl_DictObjGet only available in Tcl >= 8.5 #if ((TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 5) || (TCL_MAJOR_VERSION > 8)) - Tcl_Obj* dict = Tcl_GetReturnOptions(tcl_for_pd, result); - Tcl_Obj* errorInfo = NULL; - Tcl_Obj* errorInfoK = Tcl_NewStringObj("-errorinfo", -1); + Tcl_Obj *dict = Tcl_GetReturnOptions(tclpd_interp, result); + Tcl_Obj *errorInfo = NULL; + Tcl_Obj *errorInfoK = Tcl_NewStringObj("-errorinfo", -1); Tcl_IncrRefCount(errorInfoK); - Tcl_DictObjGet(tcl_for_pd, dict, errorInfoK, &errorInfo); + Tcl_DictObjGet(tclpd_interp, dict, errorInfoK, &errorInfo); Tcl_DecrRefCount(errorInfoK); logpost(x, 3, "%s\n", Tcl_GetStringFromObj(errorInfo, 0)); #else - logpost(x, 3, "Backtrace not available in Tcl < 8.5. Please upgrade Tcl.\n"); + logpost(x, 3, "Backtrace not available in Tcl < 8.5. Please upgrade Tcl."); #endif - logpost(x, 3, "--------------------------------------------------\n"); + logpost(x, 3, "--------------------------------------------------"); } diff --git a/tclpd.h b/tclpd.h new file mode 100644 index 0000000..1fddff7 --- /dev/null +++ b/tclpd.h @@ -0,0 +1,121 @@ +#include "m_pd.h" +//#include "m_imp.h" +#include "g_canvas.h" +//#include "s_stuff.h" + +#include + +/* PATH_MAX is not defined in limits.h on some platforms */ +#ifndef PATH_MAX +#define PATH_MAX 4096 +#endif + +#define TCLPD_VERSION "0.3.0" + +#define InitArray(name, size, value) for(int zz=0; zz<(size); zz++) name[zz]=value + +typedef struct _t_tcl { + t_object o; + int ninlets; /* used for proxy inlet count */ + t_glist *x_glist; + + char *source_file; + + // Tcl-interpreter related objects: + Tcl_Obj *self; + Tcl_Obj *classname; + Tcl_Obj *dispatcher; +} t_tcl; + +typedef struct _t_proxyinlet { + t_object obj; + t_tcl *target; + int ninlet; + t_symbol *sel; + int argc; + t_atom *argv; +} t_proxyinlet; + +/* tcl_proxyinlet.c */ +extern t_class *proxyinlet_class; +void proxyinlet_init(t_proxyinlet *x); +void proxyinlet_clear(t_proxyinlet *x); +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); + +/* tcl_wrap.c */ +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); + +/* tclpd.c */ +extern Tcl_Interp *tclpd_interp; +extern void tclpd_setup(void); +void tclpd_interp_error(t_tcl *x, int result); + +/* tcl_class.c */ +void class_table_add(const char *n, t_class *c); +void class_table_remove(const char *n); +t_class * class_table_get(const char *n); +void object_table_add(const char *n, t_tcl *o); +void object_table_remove(const char *n); +t_tcl * object_table_get(const char *n); +t_class * tclpd_class_new(const char *name, int flags); +t_class * tclpd_guiclass_new(const 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_inlet_anything(t_tcl *self, int inlet, t_symbol *s, int ac, t_atom *at); +void tclpd_loadbang(t_tcl *x); +void tclpd_open(t_tcl *x); +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_text * tclpd_get_instance_text(const char *objectSequentialId); +t_object * tclpd_get_object(const char *objectSequentialId); +t_pd * tclpd_get_object_pd(const char *objectSequentialId); +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_object * CAST_t_object(t_object *o); +t_pd * CAST_t_pd(t_pd *o); +t_text * CAST_t_text(t_text *o); +t_tcl * CAST_t_tcl(t_tcl *o); + +void poststring2(const char *s); +extern void text_save(t_gobj *z, t_binbuf *b); +void tclpd_save(t_gobj *z, t_binbuf *b); +void tclpd_properties(t_gobj *z, t_glist *owner); +void tclpd_class_namespace_init(const char *classname); + +/* tcl_widgetbehavior.c */ +void tclpd_guiclass_getrect(t_gobj *z, t_glist *owner, int *xp1, int *yp1, int *xp2, int *yp2); +void tclpd_guiclass_displace(t_gobj *z, t_glist *glist, int dx, int dy); +void tclpd_guiclass_select(t_gobj *z, t_glist *glist, int selected); +void tclpd_guiclass_activate(t_gobj *z, t_glist *glist, int state); +void tclpd_guiclass_delete(t_gobj *z, t_glist *glist); +void tclpd_guiclass_vis(t_gobj *z, t_glist *glist, int vis); +int tclpd_guiclass_click(t_gobj *z, t_glist *glist, int xpix, int ypix, int shift, int alt, int dbl, int doit); +void tclpd_guiclass_motion(t_tcl *x, t_floatarg dx, t_floatarg dy); +void tclpd_guiclass_grab(t_tcl *x, t_glist *glist, int xpix, int ypix); + +/* tcl_loader.c */ +extern int tclpd_do_load_lib(t_canvas *canvas, char *objectname); +/* pd loader private stuff: */ +typedef int (*loader_t)(t_canvas *canvas, char *classname); +extern void sys_register_loader(loader_t loader); +extern int sys_onloadlist(char *classname); +extern void sys_putonloadlist(char *classname); +extern void class_set_extern_dir(t_symbol *s); diff --git a/tclpd.i b/tclpd.i new file mode 100644 index 0000000..453e802 --- /dev/null +++ b/tclpd.i @@ -0,0 +1,183 @@ +%module tclpd + +%{ +#undef EXTERN +#include "tclpd.h" +#define __attribute__(x) +%} + +%include exception.i +%include cpointer.i +%include carrays.i +%include typemaps.i + +%pointer_functions(t_atom, atom) +%pointer_functions(t_symbol, symbol) + +%array_functions(t_atom, atom_array) +/* +Creates four functions. + +type *new_name(int nelements) +type *delete_name(type *ary) +type name_getitem(type *ary, int index) +void name_setitem(type *ary, int index, type value) + */ + +%typemap(in) (int argc, t_atom *argv) { + if(Tcl_ListObjLength(interp, $input, &$1) == TCL_ERROR) { + SWIG_exception(SWIG_RuntimeError, "failed to get list length"); + SWIG_fail; + } + $2 = (t_atom *)getbytes(sizeof(t_atom) * $1); + int i; + Tcl_Obj *oi; + for(i = 0; i < $1; i++) { + if(Tcl_ListObjIndex(interp, $input, i, &oi) == TCL_ERROR) { + SWIG_exception(SWIG_RuntimeError, "failed to access list element"); + SWIG_fail; + } + if(tcl_to_pdatom(oi, &$2[i]) == TCL_ERROR) { + SWIG_exception(SWIG_RuntimeError, "failed tcl_to_pdatom conversion"); + SWIG_fail; + } + } +} + +%typemap(freearg) (int argc, t_atom *argv) { + if($2) freebytes($2, sizeof(t_atom) * $1); +} + +%typemap(in) t_atom * { + $1 = (t_atom *)getbytes(sizeof(t_atom)); + if(tcl_to_pdatom($input, $1) == TCL_ERROR) { + SWIG_exception(SWIG_RuntimeError, "failed tcl_to_pdatom conversion"); + SWIG_fail; + } +} + +%typemap(freearg) t_atom * { + freebytes($1, sizeof(t_atom)); +} + +%typemap(out) t_atom * { + Tcl_Obj *lst; + if(pdatom_to_tcl($1, &lst) == TCL_ERROR) { + SWIG_exception(SWIG_RuntimeError, "failed pdatom_to_tcl conversion"); + SWIG_fail; + } + Tcl_SetObjResult(interp, lst); +} + +%typemap(in) t_symbol * { + if(tcl_to_pdsymbol($input, &$1) == TCL_ERROR) { + SWIG_exception(SWIG_RuntimeError, "failed tcl_to_pdsymbol conversion"); + SWIG_fail; + } +} + +%typemap(out) t_symbol * { + Tcl_Obj *lst; + if(pdsymbol_to_tcl($1, &lst) == TCL_ERROR) { + SWIG_exception(SWIG_RuntimeError, "failed pdsymbol_to_tcl conversion"); + SWIG_fail; + } + Tcl_SetObjResult(interp, lst); +} + +%typemap(in) t_tcl * { + const char *str = Tcl_GetStringFromObj($input, NULL); + $1 = object_table_get(str); + if(!$1) { + SWIG_exception(SWIG_RuntimeError, "not a t_tcl * instance"); + SWIG_fail; + } +} + +%typemap(in) t_text * { + const char *str = Tcl_GetStringFromObj($input, NULL); + $1 = object_table_get(str); + if(!$1) { + SWIG_exception(SWIG_RuntimeError, "not a t_text * instance"); + SWIG_fail; + } +} + +%typemap(in) t_pd * { + const char *str = Tcl_GetStringFromObj($input, NULL); + $1 = object_table_get(str); + if(!$1) { + SWIG_exception(SWIG_RuntimeError, "not a t_pd * instance"); + SWIG_fail; + } +} + +%typemap(in) t_object * { + const char *str = Tcl_GetStringFromObj($input, NULL); + t_tcl *x = object_table_get(str); + if(!x) { + SWIG_exception(SWIG_RuntimeError, "not a t_tcl * instance"); + SWIG_fail; + } + $1 = &x->o; +} + +/* functions that are in m_pd.h but don't exist in modern versions of pd */ +%ignore pd_getfilename; +%ignore pd_getdirname; +%ignore pd_anything; +%ignore class_parentwidget; +%ignore sys_isreadablefile; +%ignore garray_get; +%ignore c_extern; +%ignore c_addmess; + +/* functions that we can't auto-wrap, because they have varargs */ +%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; + +/* function that we don't want to wrap, because they are internal */ +%ignore tclpd_setup; +%ignore tclpd_interp_error; +%ignore tcl_to_pdatom; +%ignore tcl_to_pdsymbol; +%ignore pdatom_to_tcl; +%ignore pdsymbol_to_tcl; +%ignore class_table_add; +%ignore class_table_remove; +%ignore class_table_get; +%ignore object_table_add; +%ignore object_table_remove; +%ignore object_table_get; + +/* not needed - typemaps take care of this */ +%ignore gensym; + +/* end of ignore-list */ + +%include "m_pd.h" +%include "g_canvas.h" +%include "tclpd.h" + +/* this does the trick of solving + 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); +*/ + diff --git a/tclpd.tcl b/tclpd.tcl index e3b2583..7c2d658 100644 --- a/tclpd.tcl +++ b/tclpd.tcl @@ -1,10 +1,10 @@ -# TCL objectized library for PD api -# by Federico Ferri - (C) 2007-2011 +# TCL helper library for PD/tclpd api +# Copyright (c) 2007-2011 Federico Ferri -package provide TclpdLib 0.19 +package provide TclpdLib 0.20 package require Tcl 8.5 -package require Tclpd 0.2.3 +package require Tclpd 0.3.0 set verbose 0 @@ -23,30 +23,30 @@ namespace eval ::pd { proc add_inlet {self sel} { if $::verbose {post [info level 0]} variable _ - tclpd_add_proxyinlet [tclpd_get_instance $self] + tclpd_add_proxyinlet $self } proc add_outlet {self {sel {}}} { if $::verbose {post [info level 0]} variable _ if {$sel == {}} { - set o [outlet_new [tclpd_get_object $self] [null_symbol]] + set o [outlet_new $self NULL] } 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]] + set o [outlet_new $self $sel] } lappend _($self:x_outlet) $o return $o } # used inside class for outputting some value - proc outlet {self n sel args} { + proc outlet {self numInlet selector args} { if $::verbose {post [info level 0]} variable _ - set outlet [lindex $_($self:x_outlet) $n] - switch -- $sel { + set outlet [lindex $_($self:x_outlet) $numInlet] + switch -- $selector { float { set v [lindex $args 0] outlet_float $outlet $v @@ -57,26 +57,14 @@ namespace eval ::pd { } list { 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_list $outlet [gensym "list"] $sz $aa - delete_atom_array $aa $sz + outlet_list $outlet list $v } bang { outlet_bang $outlet } default { 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 + outlet_anything $outlet $selector $v } } } @@ -267,7 +255,10 @@ namespace eval ::pd { } proc get_binbuf {self} { - set binbuf [tclpd_get_object_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} { @@ -282,6 +273,7 @@ namespace eval ::pd { lappend result [list $selector $value] } return $result + } else {return {}} } } -- cgit v1.2.1