From 964ccc647e67d21c223365d69dd6bebb691679a0 Mon Sep 17 00:00:00 2001 From: mescalinum Date: Wed, 2 Sep 2009 00:12:26 +0000 Subject: implemented all widgetbehavior functions (Tcl wrappers) svn path=/trunk/externals/tclpd/; revision=12177 --- pdlib.tcl | 6 +- tcl_class.cxx | 178 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 179 insertions(+), 5 deletions(-) diff --git a/pdlib.tcl b/pdlib.tcl index c20f822..82f8133 100644 --- a/pdlib.tcl +++ b/pdlib.tcl @@ -62,7 +62,7 @@ namespace eval ::pd { } } - # add a class method (that is: a proc named _) + # used internally (from dispatcher) to call a class method proc call_classmethod {classname self inlet sel args} { if $::verbose {post [info level 0]} set m_sel "::${classname}_${inlet}_${sel}" @@ -71,9 +71,9 @@ namespace eval ::pd { } set m_any "::${classname}_${inlet}_anything" if {[llength [info commands $m_any]] > 0} { - return [$m_any $self $sel {*}$args] + return [$m_any $self [list symbol $sel] {*}$args] } - post "class $classname: inlet $inlet: no such selector: $sel" + post "Tcl class $classname: inlet $inlet: no such method: $sel" } # this handles the pd::class definition diff --git a/tcl_class.cxx b/tcl_class.cxx index d5e9b77..f98da6c 100644 --- a/tcl_class.cxx +++ b/tcl_class.cxx @@ -87,7 +87,8 @@ void tclpd_inlet_anything(t_tcl* self, int inlet, t_symbol* s, int ac, t_atom* a } int result = Tcl_EvalObjv(tcl_for_pd, ac+3, av, 0); Tcl_DecrRefCount(av[1]); - if (result != TCL_OK) { + Tcl_DecrRefCount(av[2]); + if(result != TCL_OK) { tclpd_interp_error(TCL_ERROR); } } @@ -122,23 +123,196 @@ void poststring2 (const char *s) { } void tclpd_guiclass_getrect(t_gobj* z, t_glist* owner, int* xp1, int* yp1, int* xp2, int* yp2) { + Tcl_Obj* av[5], *o, *theList; + int tmp[4], i, length; + t_tcl* x = (t_tcl*)z; + av[0] = x->self; + av[1] = Tcl_NewStringObj("widgetbehavior", -1); + Tcl_IncrRefCount(av[1]); + av[2] = Tcl_NewStringObj("getrect", -1); + 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)); + Tcl_IncrRefCount(av[4]); + int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); + if(result != TCL_OK) { + 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 != 4) { + pd_error(x, "widgetbehavior getrect: must return a list of 4 integers"); + goto error; + } + o = NULL; + for(i = 0; i < 4; 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; + } + } + *xp1 = tmp[0]; *yp1 = tmp[1]; *xp2 = tmp[2]; *yp2 = tmp[3]; + goto cleanup; +error: +cleanup: + Tcl_DecrRefCount(av[1]); + Tcl_DecrRefCount(av[2]); + Tcl_DecrRefCount(av[3]); + Tcl_DecrRefCount(av[4]); } void tclpd_guiclass_displace(t_gobj* z, t_glist* glist, int dx, int dy) { + Tcl_Obj* av[5]; + t_tcl* x = (t_tcl*)z; + av[0] = x->self; + av[1] = Tcl_NewStringObj("widgetbehavior", -1); + Tcl_IncrRefCount(av[1]); + av[2] = Tcl_NewStringObj("displace", -1); + Tcl_IncrRefCount(av[2]); + av[3] = Tcl_NewIntObj(dx); + Tcl_IncrRefCount(av[3]); + av[4] = Tcl_NewIntObj(dy); + Tcl_IncrRefCount(av[4]); + int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); + if(result != TCL_OK) { + tclpd_interp_error(result); + goto error; + } +error: +cleanup: + Tcl_DecrRefCount(av[1]); + Tcl_DecrRefCount(av[2]); + Tcl_DecrRefCount(av[3]); + Tcl_DecrRefCount(av[4]); } void tclpd_guiclass_select(t_gobj* z, t_glist* glist, int selected) { + Tcl_Obj* av[4]; + t_tcl* x = (t_tcl*)z; + av[0] = x->self; + av[1] = Tcl_NewStringObj("widgetbehavior", -1); + Tcl_IncrRefCount(av[1]); + av[2] = Tcl_NewStringObj("select", -1); + Tcl_IncrRefCount(av[2]); + av[3] = Tcl_NewIntObj(selected); + Tcl_IncrRefCount(av[3]); + int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); + if(result != TCL_OK) { + tclpd_interp_error(result); + goto error; + } +error: +cleanup: + Tcl_DecrRefCount(av[1]); + Tcl_DecrRefCount(av[2]); + Tcl_DecrRefCount(av[3]); } void tclpd_guiclass_activate(t_gobj* z, t_glist* glist, int state) { + Tcl_Obj* av[4]; + t_tcl* x = (t_tcl*)z; + av[0] = x->self; + av[1] = Tcl_NewStringObj("widgetbehavior", -1); + Tcl_IncrRefCount(av[1]); + av[2] = Tcl_NewStringObj("activate", -1); + Tcl_IncrRefCount(av[2]); + av[3] = Tcl_NewIntObj(state); + Tcl_IncrRefCount(av[3]); + int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); + if(result != TCL_OK) { + tclpd_interp_error(result); + goto error; + } +error: +cleanup: + Tcl_DecrRefCount(av[1]); + Tcl_DecrRefCount(av[2]); + Tcl_DecrRefCount(av[3]); } 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); } void tclpd_guiclass_vis(t_gobj* z, t_glist* glist, int vis) { + Tcl_Obj* av[4]; + 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); + Tcl_IncrRefCount(av[3]); + int result = Tcl_EvalObjv(tcl_for_pd, 5, av, 0); + if(result != TCL_OK) { + tclpd_interp_error(result); + goto error; + } +error: +cleanup: + Tcl_DecrRefCount(av[1]); + Tcl_DecrRefCount(av[2]); + Tcl_DecrRefCount(av[3]); } int tclpd_guiclass_click(t_gobj* z, t_glist* glist, int xpix, int ypix, int shift, int alt, int dbl, int doit) { - return 0; + Tcl_Obj* av[9], *o; + int i = 0; + t_tcl* x = (t_tcl*)z; + av[0] = x->self; + av[1] = Tcl_NewStringObj("widgetbehavior", -1); + Tcl_IncrRefCount(av[1]); + av[2] = Tcl_NewStringObj("click", -1); + Tcl_IncrRefCount(av[2]); + av[3] = Tcl_NewIntObj(xpix); + Tcl_IncrRefCount(av[3]); + av[4] = Tcl_NewIntObj(ypix); + Tcl_IncrRefCount(av[4]); + av[5] = Tcl_NewIntObj(shift); + Tcl_IncrRefCount(av[5]); + av[6] = Tcl_NewIntObj(alt); + Tcl_IncrRefCount(av[6]); + av[7] = Tcl_NewIntObj(dbl); + Tcl_IncrRefCount(av[7]); + av[8] = Tcl_NewIntObj(doit); + Tcl_IncrRefCount(av[8]); + int result = Tcl_EvalObjv(tcl_for_pd, 9, av, 0); + if(result != TCL_OK) { + tclpd_interp_error(result); + goto error; + } + o = Tcl_GetObjResult(tcl_for_pd); + result = Tcl_GetIntFromObj(tcl_for_pd, o, &i); + 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]); + Tcl_DecrRefCount(av[7]); + Tcl_DecrRefCount(av[8]); + return i; } -- cgit v1.2.1