From 5a38f01421e93db2cf5b5c05afe84fb73eb89425 Mon Sep 17 00:00:00 2001 From: mescalinum Date: Sun, 2 Oct 2011 16:34:46 +0000 Subject: mv *.cxx *.c svn path=/trunk/externals/loaders/tclpd/; revision=15442 --- tcl_class.cxx | 446 ---------------------------------------------------------- 1 file changed, 446 deletions(-) delete mode 100644 tcl_class.cxx (limited to 'tcl_class.cxx') diff --git a/tcl_class.cxx b/tcl_class.cxx deleted file mode 100644 index 25af02d..0000000 --- a/tcl_class.cxx +++ /dev/null @@ -1,446 +0,0 @@ -#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 = 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); - } - - 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; - } - return (void*)0; -} - -static inline void list_print(list_node_t* head) -{ - if(!head) - { - printf("NULL\n"); - return; - } - while(head) - { - printf("%s=x%8.8X", head->k, head->v); - if(head->next) printf(", "); - head = head->next; - } - printf("\n"); -} - - -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_pd* 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_pd* 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->classname = Tcl_NewStringObj(name, -1); - Tcl_IncrRefCount(x->classname); - - char s[64]; - snprintf(s, 64, "tclpd:%s:x%lx", name, objectSequentialId++); - x->self = Tcl_NewStringObj(s, -1); - Tcl_IncrRefCount(x->self); - - x->x_glist = (t_glist*)canvas_getcurrent(); - - // 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]); - - 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_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_glist* tclpd_get_glist(const char* objectSequentialId) { - t_tcl* x = tclpd_get_instance(objectSequentialId); - return x->x_glist; -} - -t_symbol* null_symbol() { - return (t_symbol*)0; -} - -void poststring2 (const char *s) { - post("%s", s); -} - -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(result); - } - Tcl_DecrRefCount(res); - } else { - pd_error(x, "Tcl: object save: failed"); - tclpd_interp_error(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(result); - } - Tcl_DecrRefCount(av[0]); - Tcl_DecrRefCount(av[1]); - Tcl_DecrRefCount(av[2]); -} -- cgit v1.2.1