From fe9c1e057945318cf1a74545c25e2b556ee3743b Mon Sep 17 00:00:00 2001 From: mescalinum Date: Wed, 2 Sep 2009 16:09:06 +0000 Subject: support for GUI externals almost complete svn path=/trunk/externals/tclpd/; revision=12183 --- pdlib.tcl | 43 ++++++++++++++++++++++++++++++++++------- tcl_class.cxx | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++--------- 2 files changed, 89 insertions(+), 16 deletions(-) diff --git a/pdlib.tcl b/pdlib.tcl index 82f8133..2d15d89 100644 --- a/pdlib.tcl +++ b/pdlib.tcl @@ -76,13 +76,7 @@ namespace eval ::pd { post "Tcl class $classname: inlet $inlet: no such method: $sel" } - # this handles the pd::class definition - proc class {classname def} { - if $::verbose {post [lrange [info level 0] 0 end-1]} - variable class_db - array set class_db {} - set class_db($classname:d_inlet) {} - set class_db($classname:d_outlet) {} + proc read_class_definition {classname def} { # strip comments: set def2 [regsub -all -line {#.*$} $def {}] set patchable_flag 1 @@ -125,10 +119,28 @@ namespace eval ::pd { 3 * ($patchable_flag != 0) }] + return $flag + } + + # this handles the pd::class definition + proc class {classname def} { + if $::verbose {post [lrange [info level 0] 0 end-1]} + + set flag [read_class_definition $classname $def] + # this wraps the call to class_new() tclpd_class_new $classname $flag } + proc guiclass {classname def} { + if $::verbose {post [lrange [info level 0] 0 end-1]} + + set flag [read_class_definition $classname $def] + + # this wraps the call to class_new() + tclpd_guiclass_new $classname $flag + } + # wrapper to post() withouth vargs proc post {args} { poststring2 [concat {*}$args] @@ -160,5 +172,22 @@ namespace eval ::pd { return $value } } + + # mechanism for uploading procs to gui interp, without the hassle of escaping [encoder] + proc guiproc {name argz body} { + # upload the decoder + sys_gui "proc guiproc {name argz body} {set map {}; for {set i 0} {\$i < 256} {incr i} {lappend map %\[format %02x \$i\] \[format %c \$i\]}; foreach x {name argz body} {set \$x \[string map \$map \[set \$x\]\]}; uplevel \[list proc \$name \$argz \$body\]}\n" + # build the mapping + set map {} + for {set i 0} {$i < 256} {incr i} { + set chr [format %c $i] + set hex [format %02x $i] + if {[regexp {[^A-Za-z0-9]} $chr]} {lappend map $chr %$hex} + } + # encode data + foreach x {name argz body} {set $x [string map $map [set $x]]} + # upload proc + sys_gui "guiproc $name $argz $body\n" + } } diff --git a/tcl_class.cxx b/tcl_class.cxx index f98da6c..694005f 100644 --- a/tcl_class.cxx +++ b/tcl_class.cxx @@ -37,8 +37,8 @@ t_tcl* tclpd_new(t_symbol* classsym, int ac, t_atom* at) { t_class* qlass = class_table[string(name)]; t_tcl* self = (t_tcl*)pd_new(qlass); self->ninlets = 1 /* qlass->c_firstin ??? */; - char s[32]; - sprintf(s, "tclpd:%s:x%lx", name, objectSequentialId++); + char s[64]; + snprintf(s, 64, "tclpd:%s:x%lx", name, objectSequentialId++); self->self = Tcl_NewStringObj(s, -1); Tcl_IncrRefCount(self->self); object_table[string(s)] = (t_pd*)self; @@ -133,7 +133,7 @@ void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* Tcl_IncrRefCount(av[2]); av[3] = Tcl_NewIntObj(text_xpix(&x->o, owner)); Tcl_IncrRefCount(av[3]); - av[4] = Tcl_NewIntObj(text_xpix(&x->o, owner)); + av[4] = Tcl_NewIntObj(text_ypix(&x->o, owner)); Tcl_IncrRefCount(av[4]); int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); if(result != TCL_OK) { @@ -176,7 +176,8 @@ cleanup: } void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy) { - Tcl_Obj* av[5]; + Tcl_Obj* av[5], *theList, *o; + int length, i, tmp[2]; t_tcl* x = (t_tcl*)z; av[0] = x->self; av[1] = Tcl_NewStringObj("widgetbehavior", -1); @@ -192,6 +193,35 @@ void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy) { tclpd_interp_error(result); goto error; } + theList = Tcl_GetObjResult(tcl_for_pd); + length = 0; + //result = Tcl_ListObjGetElements(tcl_for_pd, theList, @, @); + result = Tcl_ListObjLength(tcl_for_pd, theList, &length); + if(result != TCL_OK) { + tclpd_interp_error(result); + goto error; + } + if(length != 2) { + pd_error(x, "widgetbehavior displace: must return a list of 2 integers"); + goto error; + } + o = NULL; + for(i = 0; i < 2; i++) { + result = Tcl_ListObjIndex(tcl_for_pd, theList, i, &o); + if(result != TCL_OK) { + tclpd_interp_error(result); + goto error; + } + result = Tcl_GetIntFromObj(tcl_for_pd, o, &tmp[i]); + if(result != TCL_OK) { + tclpd_interp_error(result); + goto error; + } + } + x->o.te_xpix = tmp[0]; + x->o.te_ypix = tmp[1]; + canvas_fixlinesfor(glist_getcanvas(glist), (t_text*)x); + goto cleanup; error: cleanup: Tcl_DecrRefCount(av[1]); @@ -210,11 +240,12 @@ void tclpd_guiclass_select(t_gobj* z, t_glist* glist, int selected) { Tcl_IncrRefCount(av[2]); av[3] = Tcl_NewIntObj(selected); Tcl_IncrRefCount(av[3]); - int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); + int result = Tcl_EvalObjv(tcl_for_pd, 4, av, 0); if(result != TCL_OK) { tclpd_interp_error(result); goto error; } + goto cleanup; error: cleanup: Tcl_DecrRefCount(av[1]); @@ -232,11 +263,12 @@ void tclpd_guiclass_activate(t_gobj* z, t_glist* glist, int state) { Tcl_IncrRefCount(av[2]); av[3] = Tcl_NewIntObj(state); Tcl_IncrRefCount(av[3]); - int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); + int result = Tcl_EvalObjv(tcl_for_pd, 4, av, 0); if(result != TCL_OK) { tclpd_interp_error(result); goto error; } + goto cleanup; error: cleanup: Tcl_DecrRefCount(av[1]); @@ -250,25 +282,37 @@ void tclpd_guiclass_delete(t_gobj* z, t_glist* glist) { } void tclpd_guiclass_vis(t_gobj* z, t_glist* glist, int vis) { - Tcl_Obj* av[4]; + Tcl_Obj* av[7]; t_tcl* x = (t_tcl*)z; av[0] = x->self; av[1] = Tcl_NewStringObj("widgetbehavior", -1); Tcl_IncrRefCount(av[1]); av[2] = Tcl_NewStringObj("vis", -1); Tcl_IncrRefCount(av[2]); - av[3] = Tcl_NewIntObj(vis); + char buf[32]; + snprintf(buf, 32, ".x%x.c", glist_getcanvas(glist)); + av[3] = Tcl_NewStringObj(buf, -1); Tcl_IncrRefCount(av[3]); - int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); + av[4] = Tcl_NewIntObj(text_xpix(&x->o, glist)); + Tcl_IncrRefCount(av[4]); + av[5] = Tcl_NewIntObj(text_ypix(&x->o, glist)); + Tcl_IncrRefCount(av[5]); + av[6] = Tcl_NewIntObj(vis); + Tcl_IncrRefCount(av[6]); + int result = Tcl_EvalObjv(tcl_for_pd, 7, av, 0); if(result != TCL_OK) { tclpd_interp_error(result); goto error; } + goto cleanup; error: cleanup: Tcl_DecrRefCount(av[1]); Tcl_DecrRefCount(av[2]); Tcl_DecrRefCount(av[3]); + Tcl_DecrRefCount(av[4]); + Tcl_DecrRefCount(av[5]); + Tcl_DecrRefCount(av[6]); } int tclpd_guiclass_click(t_gobj* z, t_glist* glist, int xpix, int ypix, int shift, int alt, int dbl, int doit) { -- cgit v1.2.1