#include "tcl_extras.h" #include #include #include #include #define CLASS_TABLE_SIZE (1 << 7) #define OBJECT_TABLE_SIZE (1 << 8) static inline uint32_t hash_str(const char *s) { const unsigned char *p = (const unsigned char *)s; uint32_t h = 5381; while (*p) { h *= 33; h ^= *p++; } return h ^ (h >> 16); } typedef struct list_node { const char* k; void* v; struct list_node* next; } list_node_t; static inline 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; n->k = strdup(k); n->v = v; return n; } static inline list_node_t* list_remove(list_node_t* head, const char* k) { list_node_t* tmp; // head remove while(head && strcmp(head->k, k) == 0) { tmp = head; head = head->next; free(tmp->k); free(tmp); } list_node_t* p = head; // normal (non-head) remove while(p->next) { if(strcmp(p->next->k, k) == 0) { tmp = p->next; p->next = p->next->next; free(tmp); continue; } p = p->next; } return head; } static inline void* list_get(list_node_t* head, const char* k) { while(head) { if(strcmp(head->k, k) == 0) { return head->v; } head = head->next; } #ifdef DEBUG debug_print("list_get(%lx, %s) = NULL\n", head, k); #endif return (void*)0; } static list_node_t* class_tbl[CLASS_TABLE_SIZE]; static list_node_t* object_tbl[OBJECT_TABLE_SIZE]; static inline void class_table_add(const char* name, t_class* c) { uint32_t h = hash_str(name) % CLASS_TABLE_SIZE; class_tbl[h] = list_add(class_tbl[h], name, (void*)c); } static inline void class_table_remove(const char* name) { uint32_t h = hash_str(name) % CLASS_TABLE_SIZE; class_tbl[h] = list_remove(class_tbl[h], name); } static inline t_class* class_table_get(const char* name) { uint32_t h = hash_str(name) % CLASS_TABLE_SIZE; return (t_class*)list_get(class_tbl[h], name); } static inline void object_table_add(const char* name, t_tcl* o) { uint32_t h = hash_str(name) % OBJECT_TABLE_SIZE; object_tbl[h] = list_add(object_tbl[h], name, (void*)o); } static inline void object_table_remove(const char* name) { uint32_t h = hash_str(name) % OBJECT_TABLE_SIZE; object_tbl[h] = list_remove(object_tbl[h], name); } static inline t_tcl* object_table_get(const char* name) { uint32_t h = hash_str(name) % OBJECT_TABLE_SIZE; return (t_pd*)list_get(object_tbl[h], name); } static unsigned long objectSequentialId = 0; static list_node_t* class_tbl[CLASS_TABLE_SIZE]; static list_node_t* object_tbl[OBJECT_TABLE_SIZE]; /* 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_method)tclpd_free, sizeof(t_tcl), flags, A_GIMME, A_NULL); if(!class_table_get(name)) class_table_add(name, c); class_addanything(c, tclpd_anything); class_addmethod(c, (t_method)tclpd_loadbang, gensym("loadbang"), A_NULL); // always set save function. it will call the default if // none exists in tcl space. class_setsavefn(c, tclpd_save); // check if properties function exists in tcl space. char buf[80]; int res_i; snprintf(buf, 80, "llength [info procs ::%s_object_properties]", name); if(Tcl_Eval(tcl_for_pd, buf) == TCL_OK) { Tcl_Obj* res = Tcl_GetObjResult(tcl_for_pd); if(Tcl_GetIntFromObj(tcl_for_pd, res, &res_i) == TCL_OK) { if(res_i) { class_setpropertiesfn(c, tclpd_properties); } #ifdef DEBUG else { post("tclpd_class_new: propertiesfn does not exist", buf); } #endif } #ifdef DEBUG else { post("tclpd_class_new: Tcl_GetIntFromObj returned an error"); } #endif } #ifdef DEBUG else { post("tclpd_class_new: [info procs] returned an error"); } #endif 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)); wb->w_getrectfn = tclpd_guiclass_getrect; wb->w_displacefn = tclpd_guiclass_displace; wb->w_selectfn = tclpd_guiclass_select; wb->w_activatefn = NULL; wb->w_deletefn = tclpd_guiclass_delete; wb->w_visfn = tclpd_guiclass_vis; wb->w_clickfn = tclpd_guiclass_click; class_setwidget(c, wb); return c; } 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); t_tcl* x = (t_tcl*)pd_new(qlass); x->ninlets = 1 /* qlass->c_firstin ??? */; x->x_glist = (t_glist*)canvas_getcurrent(); x->classname = Tcl_NewStringObj(name, -1); char s[64]; snprintf(s, 64, "tclpd:%s:x%lx", name, objectSequentialId++); x->self = Tcl_NewStringObj(s, -1); // the lifetime of x->classname and x->self is greater than this // function, hence they get an extra Tcl_IncrRefCount here: // (see tclpd_free()) Tcl_IncrRefCount(x->classname); Tcl_IncrRefCount(x->self); // store in object table (for later lookup) if(!object_table_get(s)) object_table_add(s, x); // build constructor command Tcl_Obj *av[ac+2]; InitArray(av, ac+2, NULL); av[0] = x->classname; Tcl_IncrRefCount(av[0]); av[1] = x->self; Tcl_IncrRefCount(av[1]); for(int i=0; iclassname, 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]); // here ends the lifetime of x->classname and x->self Tcl_DecrRefCount(x->self); Tcl_DecrRefCount(x->classname); #ifdef DEBUG post("tclpd_free called"); #endif } 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) { // proxy method - format: ... Tcl_Obj* av[ac+3]; InitArray(av, ac+3, NULL); int result; av[0] = x->self; Tcl_IncrRefCount(av[0]); av[1] = Tcl_NewIntObj(inlet); Tcl_IncrRefCount(av[1]); av[2] = Tcl_NewStringObj(s->s_name, -1); Tcl_IncrRefCount(av[2]); for(int i=0; itarget = x; proxy->ninlet = x->ninlets++; inlet_new(&x->o, &proxy->obj.ob_pd, 0, 0); return proxy; } 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_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); return &x->o; } 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); return &o->ob_binbuf; } 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) { if(binbuf_getnatom(b) <= n || n < 0) return NULL; return binbuf_getvec(b) + n; } t_symbol* null_symbol() { return (t_symbol*)0; } 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; t_tcl* x = (t_tcl*)z; av[0] = x->self; Tcl_IncrRefCount(av[0]); av[1] = Tcl_NewStringObj("object", -1); Tcl_IncrRefCount(av[1]); av[2] = Tcl_NewStringObj("save", -1); Tcl_IncrRefCount(av[2]); int result = Tcl_EvalObjv(tcl_for_pd, 3, av, 0); if(result == TCL_OK) { res = Tcl_GetObjResult(tcl_for_pd); Tcl_IncrRefCount(res); int objc; Tcl_Obj** objv; result = Tcl_ListObjGetElements(tcl_for_pd, res, &objc, &objv); if(result == TCL_OK) { if(objc == 0 && objv == NULL) { // call default savefn text_save(z, b); } else { // do custom savefn int i; double tmp; for(i = 0; i < objc; i++) { result = Tcl_GetDoubleFromObj(tcl_for_pd, objv[i], &tmp); if(result == TCL_OK) { binbuf_addv(b, "f", (t_float)tmp); } else { char* tmps = Tcl_GetStringFromObj(objv[i], NULL); if(!strcmp(tmps, ";")) { binbuf_addv(b, ";"); } else { binbuf_addv(b, "s", gensym(tmps)); } } } } } else { pd_error(x, "Tcl: object save: failed"); tclpd_interp_error(x, result); } Tcl_DecrRefCount(res); } else { pd_error(x, "Tcl: object save: failed"); tclpd_interp_error(x, result); } Tcl_DecrRefCount(av[0]); Tcl_DecrRefCount(av[1]); Tcl_DecrRefCount(av[2]); } void tclpd_properties(t_gobj* z, t_glist* owner) { Tcl_Obj* av[3]; InitArray(av, 3, NULL); Tcl_Obj* res; t_tcl* x = (t_tcl*)z; av[0] = x->self; Tcl_IncrRefCount(av[0]); av[1] = Tcl_NewStringObj("object", -1); Tcl_IncrRefCount(av[1]); av[2] = Tcl_NewStringObj("properties", -1); Tcl_IncrRefCount(av[2]); int result = Tcl_EvalObjv(tcl_for_pd, 3, av, 0); if(result != TCL_OK) { //res = Tcl_GetObjResult(tcl_for_pd); pd_error(x, "Tcl: object properties: failed"); tclpd_interp_error(x, result); } Tcl_DecrRefCount(av[0]); Tcl_DecrRefCount(av[1]); Tcl_DecrRefCount(av[2]); }