diff options
44 files changed, 4141 insertions, 347 deletions
diff --git a/Makefile.common b/Makefile.common index fcdfbed..46bdc38 100644 --- a/Makefile.common +++ b/Makefile.common @@ -1,6 +1,9 @@ # next line has to be edited manually PD_DIR = $(ROOT_DIR)/../../pd/src +# FIXME +TCL_LIB = -l`grep -osm1 'tcl8\.[345]' $(PD_DIR)/makefile` + OS_NAME = $(shell uname -s) ifneq ($(OS_NAME),Linux) ifneq ($(OS_NAME),Darwin) @@ -86,7 +89,7 @@ TYPES_RULE = $(foreach fn,$(call TYPES_EXTERNS,$1),$(OUT_DIR)/$(fn)): \ $(OUT_DIR)/%$($1_TILDE).$(X_SUFFIX) \ : $(call TYPES_DIR,$1)%.o $($1_PRIVATEOBJECTS) \ $(foreach obj,$($1_OBJECTS),$(SHARED_DIR)/$(obj)) \ - ; $(CC) -o $$@ $(CFLAGS) $(LFLAGS) $$+ + ; $(CC) -o $$@ $(CFLAGS) $(LFLAGS) $($1_LIBS) $$+ # LATER find a better way... $(if $(word 1,$(TYPES)),$(call TYPES_RULE,$(word 1,$(TYPES)))) diff --git a/Makefile.dirs b/Makefile.dirs index 55e7d03..d47abdd 100644 --- a/Makefile.dirs +++ b/Makefile.dirs @@ -1,7 +1,9 @@ MIXED_DIRS = \ shared \ cyclone \ - toxy + toxy \ + xeq \ + vexing RELEASE_DIRS = \ cyclone \ diff --git a/cyclone/build_counter b/cyclone/build_counter index 778edc3..6178b17 100644 --- a/cyclone/build_counter +++ b/cyclone/build_counter @@ -1,3 +1,3 @@ #define CYCLONE_VERSION "0.1" #define CYCLONE_RELEASE "alpha" -#define CYCLONE_BUILD 47 +#define CYCLONE_BUILD 48 diff --git a/cyclone/hammer/coll.c b/cyclone/hammer/coll.c index 3d9aa68..5308341 100644 --- a/cyclone/hammer/coll.c +++ b/cyclone/hammer/coll.c @@ -9,6 +9,7 @@ #include "common/loud.h" #include "hammer/file.h" +/* FIXME sort -1 -1, sort 1 crashes in pd large */ /* FIXME sort crashes after (corrupt?) transfers from the editor */ /* LATER make sure that ``reentrancy protection hack'' is really working... */ /* CHECKME default fname for 'write' -- c_filename, x_name, nothing? */ diff --git a/cyclone/hammer/comment.c b/cyclone/hammer/comment.c index 3fe6ec6..72e8a57 100644 --- a/cyclone/hammer/comment.c +++ b/cyclone/hammer/comment.c @@ -5,6 +5,8 @@ /* FIXME creation lag (X-specific) */ /* LATER think about pushing text to the text editor (ctrl-t) -- not easy, because we are not 'textedfor' */ +/* LATER think about making the <Button> binding for the entire bbox, + instead of the text item, to ease the pain of resizing, somewhat. */ #include <stdlib.h> #include <stdio.h> diff --git a/cyclone/hammer/grab.c b/cyclone/hammer/grab.c index a54a3eb..2ffc152 100644 --- a/cyclone/hammer/grab.c +++ b/cyclone/hammer/grab.c @@ -89,10 +89,9 @@ static t_pd *grab_next(t_grab *x) nextremote: if (x->x_tograbbed) { - t_inlet *ip; int inno; - x->x_tograbbed = obj_nexttraverseoutlet(x->x_tograbbed, - &x->x_grabbed, &ip, &inno); + x->x_tograbbed = + fragile_outlet_nextconnection(x->x_tograbbed, &x->x_grabbed, &inno); if (x->x_grabbed) { if (inno) diff --git a/cyclone/hammer/sustain.c b/cyclone/hammer/sustain.c index 975e6aa..8764f5d 100644 --- a/cyclone/hammer/sustain.c +++ b/cyclone/hammer/sustain.c @@ -23,6 +23,7 @@ static void sustain_float(t_sustain *x, t_float f) int pitch = (int)f; if (pitch >= 0 && pitch < SUSTAIN_NPITCHES) { + /* CHECKED a plain note-off accumulator */ if (x->x_velocity || !x->x_switch) { outlet_float(x->x_voutlet, x->x_velocity); diff --git a/cyclone/sickle/rand.c b/cyclone/sickle/rand.c index 146cbc9..30014a5 100644 --- a/cyclone/sickle/rand.c +++ b/cyclone/sickle/rand.c @@ -11,7 +11,6 @@ typedef struct _rand { t_sic x_sic; - t_float x_rate; double x_lastphase; double x_nextphase; float x_rcpsr; @@ -71,7 +70,7 @@ static void rand_dsp(t_rand *x, t_signal **sp) dsp_add(rand_perform, 4, x, sp[0]->s_n, sp[0]->s_vec, sp[1]->s_vec); } -static void *rand_new(t_floatarg inirate) +static void *rand_new(t_floatarg f) { t_rand *x = (t_rand *)pd_new(rand_class); /* borrowed from d_osc.c, LATER rethink */ @@ -80,7 +79,7 @@ static void *rand_new(t_floatarg inirate) x->x_lastphase = 0.; x->x_nextphase = 1.; /* start from 0, force retargetting */ x->x_target = x->x_scaling = 0; - x->x_rate = (inirate > 0 ? -inirate : 0); + sic_newinlet((t_sic *)x, (f > 0. ? -f : 0.)); outlet_new((t_object *)x, &s_signal); return (x); } diff --git a/doc/src/Makefile b/doc/src/Makefile new file mode 100644 index 0000000..4c72963 --- /dev/null +++ b/doc/src/Makefile @@ -0,0 +1,8 @@ +include Makefile.dirs + +default: all + +.DEFAULT: + @for SUB_DIR in $(SUB_DIRS) ; \ + do ( if [ -d $$SUB_DIR ] ; then \ + cd $$SUB_DIR; $(MAKE) $@ ; fi ) ; done diff --git a/doc/src/Makefile.dirs b/doc/src/Makefile.dirs new file mode 100644 index 0000000..3bc700a --- /dev/null +++ b/doc/src/Makefile.dirs @@ -0,0 +1,2 @@ +SUB_DIRS = \ +externs diff --git a/doc/src/externs/keepme b/doc/src/externs/keepme new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/doc/src/externs/keepme @@ -0,0 +1 @@ + diff --git a/quoteinitializer b/quoteinitializer new file mode 100755 index 0000000..495eefe --- /dev/null +++ b/quoteinitializer @@ -0,0 +1,13 @@ +#!/usr/bin/awk -f + +BEGIN\ +{ + print "// Do not edit this file (edit \""ARGV[1]"\", and run \"make\").\n" + if (ARGC > 2) { print ARGV[2]; ARGC = 2 } +} + +{ + gsub("\\\\", "\\\\"); + gsub("\\\"", "\\\""); + print "\""$0"\\n\"" +} diff --git a/shared/getridof.baddeps b/shared/getridof.baddeps index 37c56d5..9483b3b 100644 --- a/shared/getridof.baddeps +++ b/shared/getridof.baddeps @@ -1,7 +1,9 @@ This is the list of all dependencies among miXed/shared objects. Some are inevitable, but others can, and should be removed. +unstable/fragile -> common/loud unstable/fringe -> unstable/forky +toxy/plusbob -> common/loud toxy/scriptlet -> common/loud, common/grow, common/props sickle/sic -> common/loud sickle/arsic -> common/loud, common/vefl, sickle/sic, unstable/fragile diff --git a/shared/toxy/Makefile.sources b/shared/toxy/Makefile.sources index 5f34f42..0613017 100644 --- a/shared/toxy/Makefile.sources +++ b/shared/toxy/Makefile.sources @@ -1,2 +1,3 @@ OTHER_SOURCES = \ -scriptlet.c +scriptlet.c \ +plusbob.c diff --git a/shared/toxy/plusbob.c b/shared/toxy/plusbob.c new file mode 100644 index 0000000..fb587cc --- /dev/null +++ b/shared/toxy/plusbob.c @@ -0,0 +1,371 @@ +/* Copyright (c) 2003 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +#include <string.h> +#include "m_pd.h" +#include "common/loud.h" +#include "plusbob.h" + +//#define PLUSBOB_DEBUG + +/* LATER let there be a choice of using either fake-symbols, or gpointers. + The gpointer layout would be such: gs_un points to a plusbob-like + structure (without the bob_tag field), a unique integer code has to be + reserved for gs_which, the fields gp_un and gp_valid are ignored. + Using bob_refcount instead of gs_refcount is likely to simplify code. */ + +/* Currently, objects of all +bob types are tagged with the same name: */ +static char plustag_name[] = "+bob"; + +static void plustag_init(t_symbol *tag) +{ + tag->s_name = plustag_name; + tag->s_thing = 0; + tag->s_next = 0; +} + +/* silent if caller is empty */ +int plustag_isvalid(t_symbol *tag, t_pd *caller) +{ + if (tag->s_name == plustag_name) + return (1); + else if (caller) + { + if (strcmp(tag->s_name, plustag_name)) + loud_error((caller == PLUSBOB_OWNER ? 0 : caller), + "does not understand '%s' (check object connections)", tag->s_name); + else + loud_error((caller == PLUSBOB_OWNER ? 0 : caller), "confused..."); + } + return (0); +} + +/* +bob is an object tossed around, a bobbing object. Currently, this is + a wrapping for Tcl_Interp, Tcl_Obj, or a tcl variable, but the +bob + interface is abstract enough to be suitable for other types of objects. + The t_plusbob is kind of a virtual base. */ + +struct _plustype +{ + t_plustype *tp_base; /* empty, if directly derived from t_plusbob */ + t_symbol *tp_name; + size_t tp_size; + /* constructor is to be called explicitly, from derived constructors, + or from a public wrapper. */ + t_plustypefn tp_deletefn; /* destructor */ + t_plustypefn tp_preservefn; + t_plustypefn tp_releasefn; + t_plustypefn tp_attachfn; +}; + +static t_plustype *plustype_default = 0; + +t_plustype *plustype_new(t_plustype *base, t_symbol *name, size_t sz, + t_plustypefn deletefn, + t_plustypefn preservefn, t_plustypefn releasefn, + t_plustypefn attachfn) +{ + t_plustype *tp = getbytes(sizeof(*tp)); + tp->tp_base = base; + tp->tp_name = name; + tp->tp_size = sz; + tp->tp_deletefn = deletefn; + tp->tp_preservefn = preservefn; + tp->tp_releasefn = releasefn; + tp->tp_attachfn = attachfn; + return (tp); +} + +static void plusbob_doattach(t_plusbob *bob, t_plusbob *parent) +{ + if (bob->bob_parent = parent) + { + /* become the youngest child: */ + bob->bob_prev = 0; + if (bob->bob_next = parent->bob_children) + { + if (parent->bob_children->bob_prev) + bug("plusbob_doattach 1"); + parent->bob_children->bob_prev = bob; + } + parent->bob_children = bob; + } + else bug("plusbob_doattach 2"); +} + +static void plusbob_dodetach(t_plusbob *bob) +{ + if (bob->bob_parent) + { + if (bob->bob_prev) + { + if (bob == bob->bob_parent->bob_children) + bug("plusbob_dodetach 1"); + bob->bob_prev->bob_next = bob->bob_next; + } + if (bob->bob_next) + bob->bob_next->bob_prev = bob->bob_prev; + if (bob == bob->bob_parent->bob_children) + bob->bob_parent->bob_children = bob->bob_next; + } + else bug("plusbob_dodetach 2"); +} + +/* To be called from derived constructors. + Preserving is caller's responsibility. */ +t_plusbob *plusbob_create(t_plustype *tp, t_plusbob *parent) +{ + t_plusbob *bob; + if (!tp) + { + if (!plustype_default) + plustype_default = plustype_new(0, 0, sizeof(t_plusbob), + 0, 0, 0, 0); + tp = plustype_default; + } + if (bob = getbytes(tp->tp_size)) + { + plustag_init(&bob->bob_tag); + bob->bob_type = tp; + while (tp->tp_base) tp = tp->tp_base; + bob->bob_root = tp; + bob->bob_owner = 0; + bob->bob_refcount = 0; + bob->bob_dorefcount = 1; + bob->bob_children = 0; + if (parent) + plusbob_doattach(bob, parent); + else + bob->bob_parent = 0; + } + return (bob); +} + +/* Should never be called, but from plusbob_release(). + Calling from a derived destructor is illegal. */ +static void plusbob_free(t_plusbob *bob) +{ + t_plustype *tp; + if (bob->bob_parent) + plusbob_dodetach(bob); + for (tp = bob->bob_type; tp; tp = tp->tp_base) + if (tp->tp_deletefn) (*tp->tp_deletefn)(bob); + freebytes(bob, (bob->bob_type ? bob->bob_type->tp_size : sizeof(*bob))); +} + +void plusbob_preserve(t_plusbob *bob) +{ + if (bob->bob_dorefcount) + { + t_plustype *tp; + for (tp = bob->bob_type; tp; tp = tp->tp_base) + if (tp->tp_preservefn) (*tp->tp_preservefn)(bob); + bob->bob_refcount++; + } +} + +void plusbob_release(t_plusbob *bob) +{ + if (bob->bob_dorefcount) + { + t_plustype *tp; + for (tp = bob->bob_type; tp; tp = tp->tp_base) + if (tp->tp_releasefn) (*tp->tp_releasefn)(bob); + if (--bob->bob_refcount <= 0) + { + if (bob->bob_refcount == 0) + plusbob_free(bob); + else + bug("plusbob_release"); + } + } +} + +t_plusbob *plusbob_getparent(t_plusbob *bob) +{ + return (bob->bob_parent); +} + +/* To be called for redirection only. Bobs created as orphans are a special + case, and cannot be attached later on. Likewise, changing non-orphan bobs + to orphans is illegal. */ +void plusbob_attach(t_plusbob *bob, t_plusbob *newparent) +{ + if (bob->bob_parent && newparent) + { + t_plustype *tp; + plusbob_dodetach(bob); + plusbob_doattach(bob, newparent); + for (tp = bob->bob_type; tp; tp = tp->tp_base) + if (tp->tp_attachfn) (*tp->tp_attachfn)(bob); + } + else if (newparent) + bug("plusbob_attach 1"); + else + bug("plusbob_attach 2"); +} + +t_plusbob *plusbob_getnext(t_plusbob *bob) +{ + return (bob->bob_next); +} + +t_plusbob *plusbob_getchildren(t_plusbob *bob) +{ + return (bob->bob_children); +} + +/* Redirect all bobs to a replacement parent. + Assuming replacement exists. */ +void plusbob_detachchildren(t_plusbob *bob, t_plusbob *newparent) +{ + while (bob->bob_children) + plusbob_attach(bob->bob_children, newparent); +} + +void plusbob_detachownedchildren(t_plusbob *bob, t_plusbob *newparent, + t_pd *owner) +{ + t_plusbob *child = bob->bob_children, *next; + while (child) + { + next = child->bob_next; + if (child->bob_owner == owner) + plusbob_attach(child, newparent); + child = next; + } +} + +void plusbob_setowner(t_plusbob *bob, t_pd *owner) +{ + bob->bob_owner = owner; +} + +t_pd *plusbob_getowner(t_plusbob *bob) +{ + return (bob->bob_owner); +} + +void outlet_plusbob(t_outlet *o, t_plusbob *bob) +{ + outlet_symbol(o, (t_symbol *)bob); +} + +/* silent if caller is empty */ +int plustag_validtype(t_symbol *tag, t_symbol *tname, t_pd *caller) +{ + if (tag->s_name == plustag_name) + { + if (((t_plusbob *)tag)->bob_type->tp_name == tname) + return (1); + else if (caller) + { + t_symbol *s = ((t_plusbob *)tag)->bob_type->tp_name; + loud_error((caller == PLUSBOB_OWNER ? + ((t_plusbob *)tag)->bob_owner : caller), + "invalid type '%s' ('%s' expected)", + (s ? s->s_name : "<unknown>"), + (tname ? tname->s_name : "<unknown>")); + } + } + else if (plustag_isvalid(tag, caller)) /* print the error there */ + bug("plustag_validtype"); + return (0); +} + +/* silent if caller is empty */ +int plustag_validroot(t_symbol *tag, t_symbol *rname, t_pd *caller) +{ + if (tag->s_name == plustag_name) + { + if (((t_plusbob *)tag)->bob_root->tp_name == rname) + return (1); + else if (caller) + { + t_symbol *s = ((t_plusbob *)tag)->bob_root->tp_name; + loud_error((caller == PLUSBOB_OWNER ? + ((t_plusbob *)tag)->bob_owner : caller), + "invalid base type '%s' ('%s' expected)", + (s ? s->s_name : "<unknown>"), + (rname ? rname->s_name : "<unknown>")); + } + } + else if (plustag_isvalid(tag, caller)) /* print the error there */ + bug("plustag_validroot"); + return (0); +} + +t_symbol *plustag_typename(t_symbol *tag, int validate, t_pd *caller) +{ + if (!validate || tag->s_name == plustag_name) + return (((t_plusbob *)tag)->bob_type->tp_name); + else if (plustag_isvalid(tag, caller)) /* print the error there */ + bug("plustag_typename"); + return (0); +} + +t_symbol *plustag_rootname(t_symbol *tag, int validate, t_pd *caller) +{ + if (!validate || tag->s_name == plustag_name) + return (((t_plusbob *)tag)->bob_root->tp_name); + else if (plustag_isvalid(tag, caller)) /* print the error there */ + bug("plustag_rootname"); + return (0); +} + +/* Plusenv (aka +env) is the base for an `environment' +bob. Environment + encapsulates data common for a collection of +bobs. This is the standard + way of grouping +bobs, according to a parent/children relationship. */ + +static t_plustype *plusenv_type = 0; +static t_plusbob *plusenv_parent = 0; /* the parent of all environments */ + +/* To be called from derived constructors (or, LATER, plusenv's provider). */ +t_plusenv *plusenv_create(t_plustype *tp, t_plusbob *parent, t_symbol *id) +{ + t_plusenv *env = 0; + if (env = (t_plusenv *)plusbob_create(tp, parent)) + { + if (!id) + /* LATER design a public interface for bob_dorefcount */ + ((t_plusbob *)env)->bob_dorefcount = 0; + env->env_id = id; /* LATER rethink */ + } + return (env); +} + +t_plusenv *plusenv_find(t_symbol *id, t_plusenv *defenv) +{ + if (plusenv_parent && id) + { + t_plusbob *bob; + for (bob = plusenv_parent->bob_children; bob; bob = bob->bob_next) + if (((t_plusenv *)bob)->env_id == id) + break; + return ((t_plusenv *)bob); + } + else return (defenv); +} + +t_symbol *plusenv_getid(t_plusenv *env) +{ + return (env->env_id); +} + +/* Type ignored, LATER rethink. */ +t_plusbob *plusenv_getparent(t_plustype *tp) +{ + if (!plusenv_parent) plusenv_parent = plusbob_create(0, 0); + return (plusenv_parent); +} + +t_plustype *plusenv_setup(void) +{ + if (!plusenv_type) + { + plusenv_type = plustype_new(0, gensym("+env"), + sizeof(t_plusenv), 0, 0, 0, 0); + } + return (plusenv_type); +} diff --git a/shared/toxy/plusbob.h b/shared/toxy/plusbob.h new file mode 100644 index 0000000..bdfe356 --- /dev/null +++ b/shared/toxy/plusbob.h @@ -0,0 +1,71 @@ +/* Copyright (c) 2003 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +#ifndef __PLUSBOB_H__ +#define __PLUSBOB_H__ + +EXTERN_STRUCT _plustype; +#define t_plustype struct _plustype +EXTERN_STRUCT _plusbob; +#define t_plusbob struct _plusbob +EXTERN_STRUCT _plusenv; +#define t_plusenv struct _plusenv + +struct _plusbob +{ + t_symbol bob_tag; /* common value for all bob types */ + t_plustype *bob_type; /* our type */ + t_plustype *bob_root; /* our base type directly derived from t_plusbob */ + t_pd *bob_owner; + int bob_refcount; + int bob_dorefcount; + t_plusbob *bob_children; /* empty, unless we are a parent */ + /* each bob has exactly one parent, unless being a special, `orphan' case */ + t_plusbob *bob_parent; + t_plusbob *bob_prev; /* younger brother */ + t_plusbob *bob_next; /* older sister */ +}; + +struct _plusenv +{ + t_plusbob env_bob; + t_symbol *env_id; /* LATER use local symbol namespace */ +}; + +#define PLUSBOB_OWNER ((t_pd *)-1) + +typedef void (*t_plustypefn)(void *); + +int plustag_isvalid(t_symbol *s, t_pd *caller); + +t_plustype *plustype_new(t_plustype *base, t_symbol *name, size_t sz, + t_plustypefn deletefn, + t_plustypefn preservefn, t_plustypefn releasefn, + t_plustypefn attachfn); + +t_plusbob *plusbob_create(t_plustype *tp, t_plusbob *parent); +void plusbob_preserve(t_plusbob *bob); +void plusbob_release(t_plusbob *bob); +t_plusbob *plusbob_getparent(t_plusbob *bob); +void plusbob_attach(t_plusbob *bob, t_plusbob *newparent); +t_plusbob *plusbob_getnext(t_plusbob *bob); +t_plusbob *plusbob_getchildren(t_plusbob *bob); +void plusbob_detachchildren(t_plusbob *bob, t_plusbob *newparent); +void plusbob_detachownedchildren(t_plusbob *bob, t_plusbob *newparent, + t_pd *owner); +void plusbob_setowner(t_plusbob *bob, t_pd *owner); +t_pd *plusbob_getowner(t_plusbob *bob); +void outlet_plusbob(t_outlet *o, t_plusbob *bob); +int plustag_validtype(t_symbol *tag, t_symbol *tname, t_pd *caller); +int plustag_validroot(t_symbol *tag, t_symbol *rname, t_pd *caller); +t_symbol *plustag_typename(t_symbol *tag, int validate, t_pd *caller); +t_symbol *plustag_rootname(t_symbol *tag, int validate, t_pd *caller); + +t_plusenv *plusenv_create(t_plustype *tp, t_plusbob *parent, t_symbol *id); +t_plusenv *plusenv_find(t_symbol *id, t_plusenv *defenv); +t_symbol *plusenv_getid(t_plusenv *env); +t_plusbob *plusenv_getparent(t_plustype *tp); +t_plustype *plusenv_setup(void); + +#endif diff --git a/shared/toxy/scriptlet.c b/shared/toxy/scriptlet.c index e2f9883..635c106 100644 --- a/shared/toxy/scriptlet.c +++ b/shared/toxy/scriptlet.c @@ -28,14 +28,15 @@ enum { SCRIPTLET_CVOK, SCRIPTLET_CVUNKNOWN, SCRIPTLET_CVMISSING }; struct _scriptlet { - t_pd *s_owner; - t_glist *s_glist; /* containing glist (possibly null) */ - t_symbol *s_rptarget; /* reply target */ - t_symbol *s_cbtarget; /* callback target */ - t_symbol *s_item; - t_scriptlet_cvfn s_cvfn; - t_canvas *s_cv; - int s_cvstate; + t_pd *s_owner; + t_glist *s_glist; /* containing glist (empty allowed) */ + t_symbol *s_rptarget; /* reply target */ + t_symbol *s_cbtarget; /* callback target */ + t_symbol *s_item; + t_scriptlet_cvfn s_cvfn; /* if empty, passing resolveall is a bug */ + t_canvas *s_cv; /* as returned by cvfn */ + int s_cvstate; + int s_locked; /* append lock, for filtering, when reading from file */ int s_size; char *s_buffer; char s_bufini[SCRIPTLET_INISIZE]; @@ -83,7 +84,7 @@ static int scriptlet_ready(t_scriptlet *sp) static int scriptlet_doappend(t_scriptlet *sp, char *buf) { - if (buf) + if (buf && !sp->s_locked) { int nprefix = sp->s_head - sp->s_buffer; int nused = sp->s_tail - sp->s_buffer; @@ -192,38 +193,68 @@ static char *scriptlet_dedot(t_scriptlet *sp, char *ibuf, char *obuf, len = 1; } break; - case '~': + case '~': /* FIXME, the dot-tilde stuff is purely experimental. */ if (resolveall) { t_canvas *cv; if (cv = scriptlet_canvasvalidate(sp, visedonly)) { - /* FIXME */ - if (!strcmp(&ibuf[1], "x1")) + if (!strncmp(&ibuf[1], "tag", 3)) + { + t_rtext *rt; + if (cv->gl_owner && glist_isvisible(cv->gl_owner) && + cv->gl_owner->gl_editor && + (rt = glist_findrtext(cv->gl_owner, (t_object *)cv))) + sprintf(obuf, "%s", rtext_gettag(rt)); + else + obuf[0] = 0; + len = 4; + } + else if (!strncmp(&ibuf[1], "owner", 5)) + { + if (cv->gl_owner && glist_isvisible(cv->gl_owner)) + sprintf(obuf, ".x%x", (int)cv->gl_owner); + else + obuf[0] = 0; + len = 6; + } + else if (!strncmp(&ibuf[1], "root", 4)) + { + sprintf(obuf, ".x%x", (int)canvas_getrootfor(cv)); + len = 5; + } + /* LATER find out when gl_<coords> are updated, + think how to better sync them to Tk. */ + else if (!strncmp(&ibuf[1], "x1", 2)) { sprintf(obuf, "%d", cv->gl_screenx1); len = 3; } - else if (!strcmp(&ibuf[1], "x2")) + else if (!strncmp(&ibuf[1], "x2", 2)) { sprintf(obuf, "%d", cv->gl_screenx2); len = 3; } - else if (!strcmp(&ibuf[1], "y1")) + else if (!strncmp(&ibuf[1], "y1", 2)) { sprintf(obuf, "%d", cv->gl_screeny1); len = 3; } - else if (!strcmp(&ibuf[1], "y2")) + else if (!strncmp(&ibuf[1], "y2", 2)) { sprintf(obuf, "%d", cv->gl_screeny2); len = 3; } - else if (!strcmp(&ibuf[1], "edit")) + else if (!strncmp(&ibuf[1], "edit", 4)) { sprintf(obuf, "%d", cv->gl_edit); len = 5; } + else if (!strncmp(&ibuf[1], "gop", 3)) + { + sprintf(obuf, "%d", glist_isgraph(cv)); + len = 4; + } else loud_error(sp->s_owner, "bad field '%s'", &ibuf[1]); } } @@ -249,19 +280,17 @@ static char *scriptlet_dedot(t_scriptlet *sp, char *ibuf, char *obuf, { if (ibuf[1] == ':') { - sprintf(obuf, "{::toxy::callback "); + sprintf(obuf, "{pd [concat "); len = 2; } else if (ibuf[1] == '|') { - sprintf(obuf, "{::toxy::callback %s ", - sp->s_rptarget->s_name); + sprintf(obuf, "{pd [concat %s ", sp->s_rptarget->s_name); len = 2; } else { - sprintf(obuf, "{::toxy::callback %s _cb ", - sp->s_cbtarget->s_name); + sprintf(obuf, "{pd [concat %s _cb ", sp->s_cbtarget->s_name); len = 1; } } @@ -269,7 +298,7 @@ static char *scriptlet_dedot(t_scriptlet *sp, char *ibuf, char *obuf, case '>': if (resolveall) { - sprintf(obuf, "}"); + sprintf(obuf, "\\;]}"); len = 1; } break; @@ -285,6 +314,7 @@ int scriptlet_isempty(t_scriptlet *sp) void scriptlet_reset(t_scriptlet *sp) { sp->s_cvstate = SCRIPTLET_CVUNKNOWN; + sp->s_locked = 0; sp->s_separator = 0; strcpy(sp->s_buffer, "namespace eval ::toxy {\ proc query {} {set ::toxy::reply [\n"); @@ -400,7 +430,7 @@ void scriptlet_qpush(t_scriptlet *sp) } } -/* Non-expanding -- LATER think if this is likely to cause any confusion. +/* Non-substituting -- LATER think if this is likely to cause any confusion. Especially, consider the widget_vis() vs. widget_update() case. */ void scriptlet_vpush(t_scriptlet *sp, char *varname) { @@ -496,53 +526,86 @@ char *scriptlet_nextword(char *buf) return (0); } -static int scriptlet_doread(t_scriptlet *sp, FILE *fp, char *rc, - t_scriptlet_cmntfn cmntfn) +static int scriptlet_doread(t_scriptlet *sp, t_pd *caller, FILE *fp, + char *rc, char *builtin, t_scriptlet_cmntfn cmntfn) { t_scriptlet *outsp = sp, *newsp; char buf[MAXPDSTRING]; - scriptlet_reset(outsp); - while (!feof(fp)) + if (!caller) caller = sp->s_owner; + while ((fp && !feof(fp) && fgets(buf, MAXPDSTRING - 1, fp)) + || builtin) { - if (fgets(buf, MAXPDSTRING - 1, fp)) + char *ptr; + if (builtin) { - char *ptr = buf; - while (*ptr == ' ' || *ptr == '\t') ptr++; - if (*ptr == '#') + int i; + for (i = 0, ptr = buf; i < MAXPDSTRING - 1; i++, ptr++) { - if (cmntfn) + if ((*ptr = (*builtin ? *builtin : '\n')) == '\n') { - char sel = *++ptr; - if (sel && sel != '\n') + ptr[1] = 0; + if (*builtin) builtin++; + if (!*builtin) builtin = 0; + break; + } + else builtin++; + } + } + ptr = buf; + while (*ptr == ' ' || *ptr == '\t') ptr++; + if (*ptr == '#') + { + if (cmntfn) + { + char sel = *++ptr; + if (sel && sel != '\n') + { + ptr++; + while (*ptr == ' ' || *ptr == '\t') ptr++; + if (*ptr == '\n') + *ptr = 0; + if (*ptr) + { + char *ep = ptr + strlen(ptr) - 1; + while (*ep == ' ' || *ep == '\t' || *ep == '\n') + ep--; + ep[1] = 0; + } + newsp = cmntfn(caller, rc, sel, ptr); + if (newsp == SCRIPTLET_UNLOCK) + outsp->s_locked = 0; + else if (newsp == SCRIPTLET_LOCK) + outsp->s_locked = 1; + else if (newsp != outsp) { - ptr++; - while (*ptr == ' ' || *ptr == '\t') ptr++; - if (*ptr == '\n') - *ptr = 0; - if (*ptr) - { - char *ep = ptr + strlen(ptr) - 1; - while (*ep == ' ' || *ep == '\t' || *ep == '\n') - ep--; - ep[1] = 0; - } - newsp = cmntfn(sp->s_owner, rc, sel, ptr); - if (newsp && newsp != outsp) - scriptlet_reset(outsp = newsp); + outsp->s_locked = 0; + scriptlet_reset(outsp = newsp); } } } - else if (*ptr && *ptr != '\n') - scriptlet_doappend(outsp, buf); } - else break; + else if (*ptr && *ptr != '\n') + scriptlet_doappend(outsp, buf); } + outsp->s_locked = 0; return (SCRIPTLET_OK); } -int scriptlet_rcload(t_scriptlet *sp, char *rc, char *ext, - t_scriptlet_cmntfn cmntfn) +/* Load particular section(s) from buffer (skip up to an unlocking comment, + keep appending up to a locking comment, repeat). */ +int scriptlet_rcparse(t_scriptlet *sp, t_pd *caller, char *rc, char *contents, + t_scriptlet_cmntfn cmntfn) { + int result; + sp->s_locked = 1; /* see scriptlet_doread() above for unlocking scheme */ + result = scriptlet_doread(sp, caller, 0, rc, contents, cmntfn); + return (result); +} + +int scriptlet_rcload(t_scriptlet *sp, t_pd *caller, char *rc, char *ext, + char *builtin, t_scriptlet_cmntfn cmntfn) +{ + int result; char filename[MAXPDSTRING], buf[MAXPDSTRING], *nameptr, *dir; int fd; if (sp->s_glist) @@ -551,32 +614,41 @@ int scriptlet_rcload(t_scriptlet *sp, char *rc, char *ext, dir = ""; if ((fd = open_via_path(dir, rc, ext, buf, &nameptr, MAXPDSTRING, 0)) < 0) { - return (SCRIPTLET_NOFILE); + result = SCRIPTLET_NOFILE; } else { FILE *fp; close(fd); - strcpy(filename, buf); - strcat(filename, "/"); - strcat(filename, nameptr); - sys_bashfilename(filename, filename); + if (nameptr != buf) + { + strcpy(filename, buf); + strcat(filename, "/"); + strcat(filename, nameptr); + sys_bashfilename(filename, filename); + } + else sys_bashfilename(nameptr, filename); if (fp = fopen(filename, "r")) { - int result = scriptlet_doread(sp, fp, rc, cmntfn); + result = scriptlet_doread(sp, caller, fp, rc, 0, cmntfn); fclose(fp); - return (result); } else { bug("scriptlet_rcload"); - return (SCRIPTLET_NOFILE); + result = SCRIPTLET_NOFILE; } } + if (result != SCRIPTLET_OK) + { + scriptlet_doread(sp, caller, 0, rc, builtin, cmntfn); + } + return (result); } int scriptlet_read(t_scriptlet *sp, t_symbol *fn) { + int result; FILE *fp; char buf[MAXPDSTRING]; post("loading scriptlet file \"%s\"", fn->s_name); @@ -587,15 +659,16 @@ int scriptlet_read(t_scriptlet *sp, t_symbol *fn) sys_bashfilename(buf, buf); if (fp = fopen(buf, "r")) { - int result = scriptlet_doread(sp, fp, 0, 0); + scriptlet_reset(sp); + result = scriptlet_doread(sp, 0, fp, 0, 0, 0); fclose(fp); - return (result); } else { loud_error(sp->s_owner, "error while loading file \"%s\"", fn->s_name); - return (SCRIPTLET_NOFILE); + result = SCRIPTLET_NOFILE; } + return (result); } int scriptlet_write(t_scriptlet *sp, t_symbol *fn) @@ -640,11 +713,22 @@ char *scriptlet_getbuffer(t_scriptlet *sp, int *sizep) return (sp->s_buffer); } +void scriptlet_setowner(t_scriptlet *sp, t_pd *owner) +{ + sp->s_owner = owner; +} + void scriptlet_clone(t_scriptlet *to, t_scriptlet *from) { scriptlet_reset(to); to->s_separator = ' '; - /* LATER use from's buffer with refcount */ + /* LATER add a flag to optionally use from's buffer with refcount */ + scriptlet_doappend(to, from->s_head); +} + +void scriptlet_append(t_scriptlet *to, t_scriptlet *from) +{ + to->s_separator = ' '; scriptlet_doappend(to, from->s_head); } @@ -658,8 +742,11 @@ void scriptlet_free(t_scriptlet *sp) } } +/* The parameter 'gl' (null accepted) is necessary, because the 's_glist' + field, if implicitly set, would be dangerous (after a glist is gone) + and confusing (current directory used for i/o of a global scriptlet). */ t_scriptlet *scriptlet_new(t_pd *owner, t_symbol *rptarget, t_symbol *cbtarget, - t_symbol *item, t_scriptlet_cvfn cvfn) + t_symbol *item, t_glist *gl, t_scriptlet_cvfn cvfn) { t_scriptlet *sp = getbytes(sizeof(*sp)); if (sp) @@ -667,12 +754,10 @@ t_scriptlet *scriptlet_new(t_pd *owner, t_symbol *rptarget, t_symbol *cbtarget, static int configured = 0; if (!configured) { - sys_gui("namespace eval ::toxy {\ - proc callback {args} {pd $args \\;}}\n"); sys_gui("image create bitmap ::toxy::img::empty -data {}\n"); } sp->s_owner = owner; - sp->s_glist = canvas_getcurrent(); + sp->s_glist = gl; sp->s_rptarget = rptarget; sp->s_cbtarget = cbtarget; sp->s_item = item; diff --git a/shared/toxy/scriptlet.h b/shared/toxy/scriptlet.h index 336d729..b284797 100644 --- a/shared/toxy/scriptlet.h +++ b/shared/toxy/scriptlet.h @@ -7,6 +7,8 @@ enum { SCRIPTLET_OK = 0, SCRIPTLET_NOFILE, SCRIPTLET_BADFILE, SCRIPTLET_IGNORED }; +#define SCRIPTLET_UNLOCK ((t_scriptlet *)0) +#define SCRIPTLET_LOCK ((t_scriptlet *)1) EXTERN_STRUCT _scriptlet; #define t_scriptlet struct _scriptlet @@ -30,15 +32,19 @@ void scriptlet_vpush(t_scriptlet *sp, char *varname); int scriptlet_evaluate(t_scriptlet *insp, t_scriptlet *outsp, int visedonly, int ac, t_atom *av, t_props *argprops); char *scriptlet_nextword(char *buf); -int scriptlet_rcload(t_scriptlet *sp, char *rc, char *ext, - t_scriptlet_cmntfn cmntfn); +int scriptlet_rcparse(t_scriptlet *sp, t_pd *caller, char *rc, char *contents, + t_scriptlet_cmntfn cmntfn); +int scriptlet_rcload(t_scriptlet *sp, t_pd *caller, char *rc, char *ext, + char *builtin, t_scriptlet_cmntfn cmntfn); int scriptlet_read(t_scriptlet *sp, t_symbol *fn); int scriptlet_write(t_scriptlet *sp, t_symbol *fn); char *scriptlet_getcontents(t_scriptlet *sp, int *lenp); char *scriptlet_getbuffer(t_scriptlet *sp, int *sizep); +void scriptlet_setowner(t_scriptlet *sp, t_pd *owner); void scriptlet_clone(t_scriptlet *to, t_scriptlet *from); +void scriptlet_append(t_scriptlet *to, t_scriptlet *from); void scriptlet_free(t_scriptlet *sp); t_scriptlet *scriptlet_new(t_pd *owner, t_symbol *rptarget, t_symbol *cbtarget, - t_symbol *item, t_scriptlet_cvfn cvfn); + t_symbol *item, t_glist *gl, t_scriptlet_cvfn cvfn); #endif diff --git a/shared/unstable/fragile.c b/shared/unstable/fragile.c index 2c9e8e3..b86fba8 100644 --- a/shared/unstable/fragile.c +++ b/shared/unstable/fragile.c @@ -6,6 +6,7 @@ #include <string.h> #include "m_pd.h" +#include "common/loud.h" #include "unstable/pd_imp.h" #include "unstable/fragile.h" @@ -68,6 +69,61 @@ t_outconnect *fragile_outlet_connections(t_outlet *o) return (o ? o->o_connections : 0); } +t_outconnect *fragile_outlet_nextconnection(t_outconnect *last, + t_object **destp, int *innop) +{ + t_inlet *dummy; + return (obj_nexttraverseoutlet(last, destp, &dummy, innop)); +} + +/* silent, if caller is empty */ +t_object *fragile_outlet_destination(t_outlet *op, + int ntypes, t_symbol **types, + t_pd *caller, char *errand) +{ + t_object *booty = 0; + t_symbol *badtype = 0; + int count = 0; + t_outconnect *tobooty = fragile_outlet_connections(op); + while (tobooty) + { + t_object *ob; + int inno; + count++; + tobooty = fragile_outlet_nextconnection(tobooty, &ob, &inno); + if (ob && inno == 0) + { + /* LATER ask for class_getname()'s symbol version */ + t_symbol **tp, *dsttype = gensym(class_getname(*(t_pd *)ob)); + int i; + for (i = 0, tp = types; i < ntypes; i++, tp++) + { + if (*tp == dsttype) + { + booty = ob; + break; + } + else badtype = dsttype; + } + } + } + if (booty) + { + if (count > 1 && caller) + loud_warning(caller, "multiple targets"); + } + else if (caller) + { + if (badtype) + loud_error(caller, "bad target type '%s'", badtype->s_name); + else + loud_error(caller, "no target"); + if (errand) + loud_errand(caller, errand); + } + return (booty); +} + /* These are local to m_obj.c. */ union inletunion { diff --git a/shared/unstable/fragile.h b/shared/unstable/fragile.h index 984fb0a..ad26384 100644 --- a/shared/unstable/fragile.h +++ b/shared/unstable/fragile.h @@ -9,6 +9,11 @@ int fragile_class_count(void); void fragile_class_printnames(char *msg, int firstndx, int lastndx); t_glist *fragile_garray_glist(void *arr); t_outconnect *fragile_outlet_connections(t_outlet *o); +t_outconnect *fragile_outlet_nextconnection(t_outconnect *last, + t_object **destp, int *innop); +t_object *fragile_outlet_destination(t_outlet *op, + int ntypes, t_symbol **types, + t_pd *caller, char *errand); t_sample *fragile_inlet_signalscalar(t_inlet *i); #endif diff --git a/test/toxy/button-test.pd b/test/toxy/button-test.pd index 1fff19f..b37978b 100644 --- a/test/toxy/button-test.pd +++ b/test/toxy/button-test.pd @@ -14,12 +14,14 @@ red -command .<.>; #X msg 56 101 -bg gray -text ""; #X msg 250 74 query tk_chooseColor; #X obj 250 101 tot .; -#X msg 166 187 -command .<:t1 bang.>; +#X msg 166 186 -command .<:t1 bang.>; #X msg 68 186 -width \$1; #X floatatom 68 162 5 0 0 0 - - -; #X msg 62 132 set -activebackground \$1; #X msg 90 213 -command .(set c [tk_chooseColor] .: eval .<| set "-bg" $c "-text" $c.>.); +#X obj 294 268 loadbang; +#X msg 294 295 ini .- config -textvariable ""; #X connect 0 0 3 0; #X connect 1 0 0 0; #X connect 2 0 0 0; @@ -35,3 +37,5 @@ $c "-text" $c.>.); #X connect 14 0 13 0; #X connect 15 0 0 0; #X connect 16 0 0 0; +#X connect 17 0 18 0; +#X connect 18 0 0 0; diff --git a/test/toxy/default.wid b/test/toxy/default.wid index abe9a5a..f3f549f 100644 --- a/test/toxy/default.wid +++ b/test/toxy/default.wid @@ -1,54 +1,152 @@ -# first the setup stuff (is this the right place for it?) +# LATER transfer the `standard' toxy setup definitions into a tcl package +# LATER think about using a slave interpreter, and a toxy-specific connection # LATER ask for adding something of the sort to pd.tk: bind Canvas <1> {+focus %W} -proc ::toxy::itemleave {path target varname} { - if {[catch {$path get} ::toxy::itemvalue] == 0} { - set $varname $::toxy::itemvalue -# LATER try sending only if changed - pd $target.rp _value $::toxy::itemvalue \; - } +# In order to keep the state after our canvas has been destroyed +# (i.e. our subpatch closed) -- use 'store' and 'restore' handlers, +# if defined, otherwise try setting -variable and -textvariable traces. + +proc ::toxy::itemdotrace {target varname ndxname op} { + if {[catch {set v [set $varname]}] == 0} { + if {$v != [set $varname.last]} { +# FIXME activate this on demand (for explicit traces) +# pd $target.rp _value $v \; + set $varname.last $v + } + } else { puts stderr [concat failed ::toxy::itemdotrace] } } -proc ::toxy::itemvis {tkclass path target name varname cvpath px py} { - set ::toxy::itemfailure [catch {$tkclass $path} ::toxy::itemerrmess] - if {$::toxy::itemfailure} { - pd $target.rp _failure $::toxy::itemerrmess \; - } else { +proc ::toxy::itembindtrace {varname mastername ndxname op} { + set $varname [set $mastername] +} - if {[info exists ::toxy::itemoptions]} { - catch {eval $path config $::toxy::itemoptions} - unset ::toxy::itemoptions +proc ::toxy::itemsettrace {op path target varname} { + if {[catch {$path cget $op} res] == 0} { + if {$res == ""} { + if {[catch {$path config $op $varname} err]} { + error $err + } + } else { + trace add variable $res write "::toxy::itembindtrace $varname" } + if {![info exists $varname.last]} { set $varname.last "" } + trace add variable $varname write "::toxy::itemdotrace $target" + return + } else { return 0 } +} - $cvpath create window $px $py \ - -anchor nw -window $path -tags [concat toxy$name $target] +# LATER revisit -- seems clumsy and fragile +proc ::toxy::itemremovetrace {op path varname} { + if {[catch {$path cget $op} res] == 0} { + if {$res == $varname} { + if {[catch {$path config $op ""} err]} { + error $err + } + } elseif {$res != ""} { + catch { trace remove variable \ + $res write "::toxy::itembindtrace $varname" } + } + } +} - if {[info exists ::toxy::masterinits]} { - catch {eval $::toxy::masterinits} - unset ::toxy::masterinits +proc ::toxy::itemdestroy {path varname} { + ::toxy::itemremovetrace -variable $path $varname.var + ::toxy::itemremovetrace -textvariable $path $varname.txt + unset -nocomplain $varname.last $varname.var $varname.txt $varname + catch {destroy $path} +} + +proc ::toxy::itemgetconfig {path target} { + pd $target.rp _config $target.rp [$path cget -bg] \ + [winfo reqwidth $path] [winfo reqheight $path] \ + [catch {$path config -state normal}]\; +} + +proc ::toxy::itemvisconfig {path target name varname cvpath px py} { + if {[info exists ::toxy::itemoptions]} { + catch {eval $path config $::toxy::itemoptions} + unset ::toxy::itemoptions + } + + $cvpath create window $px $py \ + -anchor nw -window $path -tags [concat toxy$name $target] + +# FIXME + if {[info exists ::toxy::storethispath]} { +# FIXME explicit traces + set needtraces 0 + } else { + set needtraces 1 + } + + if {$needtraces != 0} { + if {[catch {::toxy::itemsettrace -variable \ + $path $target $varname.var} res1]} { + error $res1 } - if {[info exists ::toxy::typeinits]} { - catch {eval $::toxy::typeinits} - unset ::toxy::typeinits + if {[catch {::toxy::itemsettrace -textvariable \ + $path $target $varname.txt} res2]} { + error $res2 } - if {[info exists ::toxy::iteminits]} { - catch {eval $::toxy::iteminits} - unset ::toxy::iteminits +# puts stderr [concat traces: ($res1) ($res2)] + if {$res1 == 0 && $res2 == 0} { +# puts stderr [concat toxy warning: $path untraceable] } + } - pd $target.rp _config $target.rp [$path cget -bg] \ - [winfo reqwidth $path] [winfo reqheight $path] \ - [catch {$path config -state normal}]\; + if {[info exists ::toxy::masterinits]} { + catch {eval $::toxy::masterinits} + unset ::toxy::masterinits + } + if {[info exists ::toxy::typeinits]} { + catch {eval $::toxy::typeinits} + unset ::toxy::typeinits + } + if {[info exists ::toxy::iteminits]} { + catch {eval $::toxy::iteminits} + unset ::toxy::iteminits + } -# LATER think where to plug this in - bind $path <Leave> [concat ::toxy::itemleave $path $target $varname] - if {[info exists $varname]} { - catch {eval $path set $$varname} - unset $varname - } + ::toxy::itemgetconfig $path $target + + return +} + +proc ::toxy::itemvis {tkclass path target name varname cvpath px py} { + if {[winfo exists $path]} { +# puts [concat $path exists] + set ::toxy::itemfailure 0 + } else { + set ::toxy::itemfailure [catch {$tkclass $path} ::toxy::itemerrmess] + } + if {$::toxy::itemfailure == 0} { + set ::toxy::itemfailure [catch {::toxy::itemvisconfig \ + $path $target $name $varname $cvpath $px $py} \ + ::toxy::itemerrmess] } + if {$::toxy::itemfailure} { + if {[winfo exists $path]} {destroy $path} + pd $target.rp _failure $::toxy::itemerrmess \; + } +} + +proc ::toxy::itemclick {target cvpath x y b f} { + pd $target.rp _click \ + [$cvpath canvasx [expr $x - [winfo rootx $cvpath]]] \ + [$cvpath canvasy [expr $y - [winfo rooty $cvpath]]] $b $f\; +} + +# FIXME +proc ::toxy::scalecommand {target sel v} { + pd [concat $target $sel $v \;] +} + +proc ::toxy::popupcommand {path target remote i text} { + set [$path cget -textvariable] $text + pd [concat $target _cb $i \;] + pd [concat $remote $i \;] } proc ::toxy::popup {path target remote entries args} { @@ -56,86 +154,51 @@ proc ::toxy::popup {path target remote entries args} { set i 1 foreach e $entries { $path.pop add command -label [lindex $e 0] \ - -command [concat ::toxy::callback $target \ - -text [lindex $e [expr {[llength $e] > 1}]] \; \ - ::toxy::callback $remote $i] + -command [concat ::toxy::popupcommand $path $target $remote $i \ + [lindex $e [expr {[llength $e] > 1}]]] incr i } } -proc ::toxy::kb {path target remote noctaves size} { - set lft [expr {round(5 * $size)}] - set top [expr {5 * $size}] - set bot [expr {100 * $size}] - set dx [expr {round(17 * $size)}] - set wid [expr {$dx - $size * .5}] - set blbot [expr {$bot * .65}] - - $path config -height [expr {$bot + $top}] \ - -width [expr {$dx * ($noctaves * 7 + 1) + $lft * 2 - 1}] - - for {set octave 0} {$octave <= $noctaves} {incr octave} { - set prevkey 0 - foreach key {0 2 4 5 7 9 11} { - set ndx [expr $octave * 12 + $key] - set id [$path create rect $lft $top \ - [expr {$lft + $wid}] $bot -fill white -tags $path.$ndx] - $path bind $id <1> [concat ::toxy::kbset \ - $path $target $remote $ndx] - if {$key - $prevkey > 1} { - incr ndx -1 - set x [expr {$lft - $wid * .22}] - set id [$path create rect $x $top [expr {$x + $wid * .44}] \ - $blbot -fill black -tags $path.$ndx] - $path bind $id <1> [concat ::toxy::kbset \ - $path $target $remote $ndx] - } - set prevkey $key - incr lft $dx - if {$octave == $noctaves && $key == 0} break - } - } - set ::toxy::kbval($target) 0 - set ::toxy::kbcol($target) white - $path itemconfig $path.0 -fill grey -} - -proc ::toxy::kbout {path target remote} { - ::toxy::callback $target _cb $::toxy::kbval($target) - if {$remote != "."} {::toxy::callback $remote $::toxy::kbval($target)} -} - -proc ::toxy::kbset {path target remote value} { - $path itemconfig $path.$::toxy::kbval($target) \ - -fill $::toxy::kbcol($target) - set ::toxy::kbval($target) $value - set ::toxy::kbcol($target) [lindex [$path itemconfig $path.$value -fill] 4] - $path itemconfig $path.$value -fill grey - ::toxy::kbout $path $target $remote -} - # the default initializer #> default +# empirically, binding event coords as %X - [winfo rootx .^.c] works better, +# than %x + [winfo x %W], or %x + t->te_xpix, LATER investigate + # pdtk_canvas_mouseup is a hack, which we must call anyway bind .- <ButtonRelease> { - eval .<|_inout 1.> - pdtk_canvas_mouseup .^.c [expr %x + [winfo x %W]] [expr %y + [winfo y %W]] %b + eval .<|_inout 3.> + pdtk_canvas_mouseup .^.c \ + [expr %X - [winfo rootx .^.c]] [expr %Y - [winfo rooty .^.c]] %b } -bind .- <1> .<|_click %x %y %b 0.> -bind .- <3> .<|_click %x %y %b 8.> -bind .- <Motion> .<|_motion %x %y.> +bind .- <1> {::toxy::itemclick .| .^.c %X %Y %b 0} +bind .- <Shift-1> {::toxy::itemclick .| .^.c %X %Y %b 1} +bind .- <Control-1> {::toxy::itemclick .| .^.c %X %Y %b 2} +bind .- <Control-Shift-1> {::toxy::itemclick .| .^.c %X %Y %b 3} +bind .- <Alt-1> {::toxy::itemclick .| .^.c %X %Y %b 4} +bind .- <Alt-Shift-1> {::toxy::itemclick .| .^.c %X %Y %b 5} +bind .- <Alt-Control-1> {::toxy::itemclick .| .^.c %X %Y %b 6} +bind .- <Alt-Control-Shift-1> {::toxy::itemclick .| .^.c %X %Y %b 7} +bind .- <3> {::toxy::itemclick .| .^.c %X %Y %b 8} + +bind .- <Motion> .<|_motion \ + [.^.c canvasx [expr %X - [winfo rootx .^.c]]] \ + [.^.c canvasy [expr %Y - [winfo rooty .^.c]]] 0.> bind .- <Enter> .<|_inout 1.> bind .- <Leave> .<|_inout 0.> +# standard widget types + #> bang button #. -image ::toxy::img::empty -command .<.> #. -bg pink -activebackground red -width 50 -height 50 #. @bang .- flash .: .- invoke #> float scale -#. -command .<.> -bg pink -activebackground red -length 200 +#. -command [concat ::toxy::scalecommand .| _cb] +#. -bg pink -activebackground red -length 200 #. @float .- set .#1 #> symbol entry @@ -143,14 +206,3 @@ bind .- <Leave> .<|_inout 0.> #. @symbol .- delete 0 end .: .- insert 0 .#1 bind .- <Return> {eval .<[.- get].>; focus .^.c} - -#> kb canvas -#. -bg yellow -cursor hand1 -#. #oct 4 #size .75 -#. @bang ::toxy::kbout .- .| . -#. @float ::toxy::kbset .- .| . .#1 - -::toxy::kb .- .| . .#oct .#size - -# undo the "bind Canvas <1> {+focus %W}" in the setup part above -bind .- <FocusIn> {focus .^.c} diff --git a/test/toxy/kb.wid b/test/toxy/kb.wid new file mode 100644 index 0000000..e447697 --- /dev/null +++ b/test/toxy/kb.wid @@ -0,0 +1,63 @@ +proc ::toxy::kb {path target remote noctaves size} { + set lft [expr {round(5 * $size)}] + set top [expr {5 * $size}] + set bot [expr {100 * $size}] + set dx [expr {round(17 * $size)}] + set wid [expr {$dx - $size * .5}] + set blbot [expr {$bot * .65}] + + $path config -height [expr {$bot + $top}] \ + -width [expr {$dx * ($noctaves * 7 + 1) + $lft * 2 - 1}] + + for {set octave 0} {$octave <= $noctaves} {incr octave} { + set prevkey 0 + foreach key {0 2 4 5 7 9 11} { + set ndx [expr $octave * 12 + $key] + set id [$path create rect $lft $top \ + [expr {$lft + $wid}] $bot -fill white -tags $path.$ndx] + $path bind $id <1> [concat ::toxy::kbset \ + $path $target $remote $ndx] + if {$key - $prevkey > 1} { + incr ndx -1 + set x [expr {$lft - $wid * .22}] + set id [$path create rect $x $top [expr {$x + $wid * .44}] \ + $blbot -fill black -tags $path.$ndx] + $path bind $id <1> [concat ::toxy::kbset \ + $path $target $remote $ndx] + } + set prevkey $key + incr lft $dx + if {$octave == $noctaves && $key == 0} break + } + } + set ::toxy::kbval($target) 0 + set ::toxy::kbcol($target) white + $path itemconfig $path.0 -fill grey +} + +proc ::toxy::kbout {path target remote} { + pd [concat $target _cb $::toxy::kbval($target) \;] + if {$remote != "."} { + pd [concat $remote $::toxy::kbval($target) \;] + } +} + +proc ::toxy::kbset {path target remote value} { + $path itemconfig $path.$::toxy::kbval($target) \ + -fill $::toxy::kbcol($target) + set ::toxy::kbval($target) $value + set ::toxy::kbcol($target) [lindex [$path itemconfig $path.$value -fill] 4] + $path itemconfig $path.$value -fill grey + ::toxy::kbout $path $target $remote +} + +#> kb canvas +#. -bg yellow -cursor hand1 +#. #oct 4 #size .75 +#. @bang ::toxy::kbout .- .| . +#. @float ::toxy::kbset .- .| . .#1 + +::toxy::kb .- .| . .#oct .#size + +# undo the "bind Canvas <1> {+focus %W}" in the setup part above +bind .- <FocusIn> {focus .^.c} diff --git a/test/toxy/scale-test.pd b/test/toxy/scale-test.pd index e35a4a2..c13d3b3 100644 --- a/test/toxy/scale-test.pd +++ b/test/toxy/scale-test.pd @@ -1,7 +1,8 @@ #N canvas 79 51 599 397 12; -#X obj 22 197 widget scale s -command .<.> -variable ::toxy::simplescale --label "Simple Scale" -orient h -length 300 -width 50 -font "Helvetica -12" -from -16 -to 16 -showvalue 0 @float .- set .#1; +#X obj 22 197 widget scale s -command [concat ::toxy::scalecommand +.| _cb] -variable ::toxy::simplescale -label "Simple Scale" -orient +h -length 300 -width 50 -font "Helvetica 12" -from -16 -to 16 -showvalue +0 @float .- set .#1; #X floatatom 22 336 5 0 0 0 - - -; #X floatatom 191 128 5 0 0 0 - - -; #X msg 191 159 -from \$1; @@ -11,19 +12,21 @@ #X obj 44 133 tgl 15 0 empty empty empty 0 -6 0 8 -262144 -1 -1 0 1 ; #X floatatom 214 336 5 0 0 0 - - -; -#X msg 36 102 -command .<.>; +#X msg 33 103 -command [concat ::toxy::scalecommand .| _cb]; #X obj 214 306 r \$0-scale; -#X msg 22 70 -command .<: \$1-scale .>; +#X msg 22 70 -command [concat ::toxy::scalecommand \$1-scale float] +; #X obj 22 10 loadbang; #X obj 22 40 int \$0; #X msg 113 10 bang; -#X msg 269 67 @float .- set .#1; -#X msg 269 102 remove @float; -#X floatatom 269 40 5 0 0 0 - - -; +#X msg 188 10 @float .- set .#1; +#X msg 188 40 remove @float; +#X floatatom 89 45 5 0 0 0 - - -; #N canvas 0 0 450 420 linked 0; -#X obj 54 49 widget scale s -command .<.> -variable ::toxy::simplescale --orient v -length 300 -width 50 -font "Helvetica 12" -from -16 -to -16 -showvalue 0 @float .- set .#1; +#X obj 54 49 widget scale s -command [concat ::toxy::scalecommand .| +_cb] -variable ::toxy::simplescale -orient v -length 300 -width 50 +-font "Helvetica 12" -from -16 -to 16 -showvalue 0 @float .- set .#1 +; #X coords 0 0 1 1 80 360 1; #X restore 472 20 pd linked; #X connect 0 0 1 0; diff --git a/test/toxy/test.wid b/test/toxy/test.wid new file mode 100644 index 0000000..3cb82f1 --- /dev/null +++ b/test/toxy/test.wid @@ -0,0 +1,6 @@ +puts before + +#> test button +#. -bg green -text test + +puts after diff --git a/test/toxy/txt-test.pd b/test/toxy/txt-test.pd new file mode 100644 index 0000000..fe4b48a --- /dev/null +++ b/test/toxy/txt-test.pd @@ -0,0 +1,25 @@ +#N canvas 0 0 487 327 12; +#X obj 20 24 bng 15 250 50 0 empty empty empty 0 -6 0 8 -262144 -1 +-1; +#X floatatom 72 92 5 0 0 0 - - -; +#X obj 95 251 print; +#X obj 20 210 route bang; +#N canvas 517 44 481 430 txtpanel 1; +#X obj 64 37 widget txt t; +#X restore 305 31 pd txtpanel; +#X obj 20 173 tow txtpanel txt t; +#X msg 79 126 tot pd nlines [expr [.- index end] - 1] .`.:; +#X obj 243 173 r nlines; +#X floatatom 243 210 5 0 0 0 - - -; +#X msg 136 92 replace test; +#X msg 65 59 insert trailer end; +#X msg 60 24 insert header "0.0"; +#X connect 0 0 5 0; +#X connect 1 0 5 0; +#X connect 3 1 2 0; +#X connect 5 0 3 0; +#X connect 6 0 5 0; +#X connect 7 0 8 0; +#X connect 9 0 5 0; +#X connect 10 0 5 0; +#X connect 11 0 5 0; diff --git a/test/toxy/txt.wid b/test/toxy/txt.wid new file mode 100644 index 0000000..29d7a3e --- /dev/null +++ b/test/toxy/txt.wid @@ -0,0 +1,9 @@ +#> txt text +#. -bg lightgreen -foreground brown -font .(helvetica 12 bold.) -width 40 -height 16 +#. @bang pd .| _cb [string map .(" " ".`.` ".) [.- get "0.0" end]] .`.: +#. @float pd .| _cb [string map .(" " ".`.` ".) [.- get .#1.0 .#1.end]] .`.: +#. @insert .- insert .#2 .#1 +#. @replace .- delete "0.0" end .: .- insert "0.0" .#1 + +#. @store set .#1 [.- get 0.0 end] +#. @restore insert 0.0 .#1 diff --git a/toxy/Makefile b/toxy/Makefile index fc022be..1718111 100644 --- a/toxy/Makefile +++ b/toxy/Makefile @@ -1,2 +1,6 @@ ROOT_DIR = .. +redefault: default.wiq default +default.wiq: $(ROOT_DIR)/test/toxy/default.wid + $(ROOT_DIR)/quoteinitializer $< \ + '"puts [concat loading built-in widget definitions]\n"' > $@ include $(ROOT_DIR)/Makefile.common diff --git a/toxy/Makefile.objects b/toxy/Makefile.objects index fde293c..f063097 100644 --- a/toxy/Makefile.objects +++ b/toxy/Makefile.objects @@ -7,6 +7,26 @@ hammer/gui.o \ common/props.o \ toxy/scriptlet.o +PLUSTOT_OBJECTS = \ +unstable/fragile.o \ +unstable/forky.o \ +common/loud.o \ +common/grow.o \ +hammer/file.o \ +common/props.o \ +toxy/scriptlet.o \ +toxy/plusbob.o + +PLUSTOT_PRIVATEOBJECTS = \ +plustot.env.o \ +plustot.in.o \ +plustot.var.o \ +plustot.out.o \ +plustot.qlist.o \ +plustot.print.o + +PLUSTOT_LIBS = $(TCL_LIB) + TOW_OBJECTS = \ common/loud.o \ unstable/loader.o diff --git a/toxy/Makefile.sources b/toxy/Makefile.sources index b0f3646..1626cd6 100644 --- a/toxy/Makefile.sources +++ b/toxy/Makefile.sources @@ -1,5 +1,6 @@ -TYPES = TOT TOW WIDGET +TYPES = TOT TOW WIDGET PLUSTOT TOT_SOURCES = tot.c TOW_SOURCES = tow.c WIDGET_SOURCES = widget.c +PLUSTOT_SOURCES = plustot.c diff --git a/toxy/build_counter b/toxy/build_counter index 5774bf7..a4b640c 100644 --- a/toxy/build_counter +++ b/toxy/build_counter @@ -1,3 +1,3 @@ #define TOXY_VERSION "0.1" #define TOXY_RELEASE "alpha" -#define TOXY_BUILD 1 +#define TOXY_BUILD 2 diff --git a/toxy/plustot.c b/toxy/plustot.c new file mode 100644 index 0000000..bfaeb32 --- /dev/null +++ b/toxy/plustot.c @@ -0,0 +1,2020 @@ +/* Copyright (c) 2003 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +#include <string.h> +#include "m_pd.h" +#include "g_canvas.h" +#include "common/loud.h" +#include "common/grow.h" +#include "hammer/file.h" +#include "common/props.h" +#include "toxy/scriptlet.h" +#include "toxy/plusbob.h" +#include "plustot.h" +#include "build_counter" + +#define PLUSTOT_VERBOSE +#define PLUSTOT_DEBUG +//#define PLUSTOT_DEBUGREFCOUNTS + +#ifdef PLUSTOT_DEBUG +# define PLUSDEBUG_ENDPOST(fn) endpost() +#else +# define PLUSDEBUG_ENDPOST(fn) +#endif + +#ifdef PLUSTOT_DEBUGREFCOUNTS +# define PLUSDEBUG_INCRREFCOUNT(ob, fn) \ + {post("++ %x "fn, (int)(ob)); Tcl_IncrRefCount(ob);} +# define PLUSDEBUG_DECRREFCOUNT(ob, fn) \ + {post("-- %x "fn, (int)(ob)); Tcl_DecrRefCount(ob);} +#else +# define PLUSDEBUG_INCRREFCOUNT(ob, fn) Tcl_IncrRefCount(ob) +# define PLUSDEBUG_DECRREFCOUNT(ob, fn) Tcl_DecrRefCount(ob) +#endif + +static t_symbol *plusps_tot; +static t_symbol *plusps_env; +static t_symbol *plusps_in; +static t_symbol *plusps_var; +static t_symbol *plusps_out; +static t_symbol *plusps_qlist; +static t_symbol *plusps_print; +static t_symbol *totps_query; + +static void plusloud_tcldirty(t_pd *caller, char *fnname) +{ + loud_warning((caller == PLUSBOB_OWNER ? 0 : caller), + "(%s) tcl plays dirty tricks, sorry", fnname); +} + +void plusloud_tclerror(t_pd *caller, Tcl_Interp *interp, char *msg) +{ + Tcl_Obj *ob = Tcl_GetObjResult(interp); + loud_error((caller == PLUSBOB_OWNER ? 0 : caller), msg); + if (ob) + { + int len; + char *res = Tcl_GetStringFromObj(ob, &len); + if (res && len > 0) + { + char buf[MAXPDSTRING]; + if (len > (MAXPDSTRING-2)) + { + len = (MAXPDSTRING-2); + buf[MAXPDSTRING-2] = '*'; + buf[MAXPDSTRING-1] = 0; + } + else buf[len] = 0; + strncpy(buf, res, len); + loud_errand((caller == PLUSBOB_OWNER ? 0 : caller), + "(tcl) %s", buf); + } + else ob = 0; + Tcl_ResetResult(interp); + } + if (!ob) loud_errand((caller == PLUSBOB_OWNER ? 0 : caller), + "unknown error (probably a bug)"); +} + +/* Plustin (aka +Ti) is a Tcl_Interp wrapped as a +bob. + This is a glist-based flavor of Plusenv. */ + +struct _plustin +{ + t_plusenv tin_env; + t_glist *tin_glist; + Tcl_Interp *tin_interp; +}; + +static t_plustype *plustin_basetype; +static t_plustype *plustin_type; +static t_plustin *plustin_default = 0; + +/* To be called from derived constructors or plustin's provider. */ +t_plustin *plustin_create(t_plustype *tp, t_plusbob *parent, t_symbol *id) +{ + t_plustin *tin = 0; + Tcl_Interp *interp = Tcl_CreateInterp(); + if (interp && (tin = (t_plustin *)plusenv_create(tp, parent, id))) + { +#ifdef PLUSTOT_DEBUG + post("plustin_create '%s' over %x", + (id ? id->s_name : "default"), (int)interp); +#endif + tin->tin_interp = interp; + Tcl_Preserve(interp); + if (Tcl_Init(interp) == TCL_ERROR) + plusloud_tclerror(0, interp, "interpreter initialization failed"); + Tcl_Release(interp); + } + else loud_error(0, "failed attempt to create an interpreter"); + return (tin); +} + +/* To be registered for calling from plusbob_release(). + Should never be called explicitly. */ +static void plustin_delete(t_plustin *tin) +{ +#ifdef PLUSTOT_DEBUG + t_symbol *id = plusenv_getid((t_plusenv *)tin); + post("plustin_delete '%s' over %x", + (id ? id->s_name : "default"), (int)tin->tin_interp); +#endif + Tcl_Preserve(tin->tin_interp); + if (!Tcl_InterpDeleted(tin->tin_interp)) + Tcl_DeleteInterp(tin->tin_interp); + Tcl_Release(tin->tin_interp); +} + +Tcl_Interp *plustin_getinterp(t_plustin *tin) +{ + return (tin->tin_interp); +} + +t_symbol *plustin_glistid(t_glist *gl) +{ + char buf[32]; + sprintf(buf, "+ti%x", (int)gl); + return (gensym(buf)); +} + +t_plustin *plustin_glistfind(t_glist *gl, int mode) +{ + t_plustin *tin = 0; + if (mode == PLUSTIN_GLIST_UP) + { + gl = gl->gl_owner; + mode = PLUSTIN_GLIST_ANY; + } + if (mode == PLUSTIN_GLIST_THIS) + return ((t_plustin *)plusenv_find(plustin_glistid(gl), + (t_plusenv *)plustin_default)); + else + { + while (gl) + { + char buf[32]; + sprintf(buf, "+ti%x", (int)gl); + if (tin = (t_plustin *)plusenv_find(gensym(buf), + (t_plusenv *)plustin_default)) + break; + gl = gl->gl_owner; + } + return (tin ? tin : plustin_default); + } +} + +/* To be called from client code, instead of plustin_create(). + Preserving is caller's responsibility. + Never returns null, even when called with create == 0: + if requested id not found, default returned, created if necessary. */ +t_plustin *plustin_glistprovide(t_glist *gl, int mode, int create) +{ + t_plustin *tin = 0; + t_plusbob *parent = plusenv_getparent(plustin_type); + if (mode == PLUSTIN_GLIST_UP) + { + gl = gl->gl_owner; + mode = PLUSTIN_GLIST_ANY; + } + tin = plustin_glistfind(gl, mode); + if (!tin && create) + { + if (tin = plustin_create(plustin_type, parent, plustin_glistid(gl))) + tin->tin_glist = gl; + } + if (!tin) + { + if (!plustin_default) + plustin_default = plustin_create(plustin_type, parent, 0); + tin = plustin_default; + } + return (tin); +} + +t_symbol *plustin_getglistname(t_plustin *tin) +{ + return (tin->tin_glist ? tin->tin_glist->gl_name : 0); +} + +/* Plustob (aka +To) is a Tcl_Obj wrapped as a +bob. */ + +/* LATER rethink the plustob/plusvar rules, measure performance. + There are two cases: + + `Bobbing' is taking an object from its wrapping bob, wrapping it into + another bob and, optionally, setting a variable to it. + + The main deal of bobbing design is not to Tcl_DuplicateObj while passing + bobs around. + + `Messing' is converting a Pd message (float, symbol or list) to an object, + wrapping it and, optionally, setting a variable to it. + + The obvious sequence of {Decr(old), New, Incr(new), SetVar(new)}, which + is currently used, involves picking a new object (New), while returning + an old one to the pool (by SetVar or Decr, depending on a third party + changing or not the tcl variable's value in the meantime). I guess + the overhead is negligible, unless we hit at the bottom of the pool. + Moreover, we can reduce the sequence to just {Set(old), SetVar(old)}, + in the case when old is not shared (referenced neither by a variable, + nor by a third party). The main advantage is being consistent with + the way Tcl itself was designed. + + An alternative: in the original messing design, the trick was to: + + . call Set on a prepicked object, instead of New + . call SetVar on a preserved object, as usual (var would not own its value) + . alternate between two prepicked objects in order to avoid calling UnsetVar + + So, the sequence was just {Set(v1), SetVar(v1)}, then {Set(v2), SetVar(v2)}, + again {Set(v1), SetVar(v1)}, and so on, unless a third party (other than + plusvar and a tcl variable) referenced our prepicked object. */ + +#define PLUSTOB_INIELBUFSIZE 128 /* LATER rethink */ + +struct _plustob +{ + t_plusbob tob_bob; + Tcl_Obj *tob_value; + t_plustin *tob_tin; /* redundant, LATER rethink */ + t_plusifsharedfn tob_ifsharedfn; + int tob_elbufsize; + Tcl_Obj **tob_elbuf; + Tcl_Obj *tob_elbufini[PLUSTOB_INIELBUFSIZE]; +}; + +static t_plustype *plustob_type; + +/* To be called from derived constructors. + Preserving is caller's responsibility. */ +t_plustob *plustob_create(t_plustype *tp, t_plustin *tin, Tcl_Obj *ob) +{ + t_plustob *tob = 0; + if (tin && (ob != PLUSTOB_MAKEIT || (ob = Tcl_NewObj())) + && (tob = (t_plustob *)plusbob_create(tp, (t_plusbob *)tin))) + { + if (ob) PLUSDEBUG_INCRREFCOUNT(ob, "plustob_create"); + plusbob_preserve((t_plusbob *)tin); + tob->tob_value = ob; + tob->tob_tin = tin; + tob->tob_ifsharedfn = 0; + tob->tob_elbufsize = PLUSTOB_INIELBUFSIZE; + tob->tob_elbuf = tob->tob_elbufini; + } + return (tob); +} + +/* To be registered for calling from plusbob_release(). + Should never be called explicitly. */ +static void plustob_delete(t_plustob *tob) +{ + if (tob->tob_tin) + plusbob_release((t_plusbob *)tob->tob_tin); + if (tob->tob_value) + PLUSDEBUG_DECRREFCOUNT(tob->tob_value, "plustob_delete"); + if (tob->tob_elbuf != tob->tob_elbufini) + freebytes(tob->tob_elbuf, tob->tob_elbufsize * sizeof(*tob->tob_elbuf)); +} + +/* To be registered for calling from plusbob_attach(). + Should never be called explicitly. */ +static void plustob_attach(t_plustob *tob) +{ + t_plustin *tin; + if (tin = (t_plustin *)plusbob_getparent((t_plusbob *)tob)) + { + if (tob->tob_tin) + plusbob_release((t_plusbob *)tob->tob_tin); + tob->tob_tin = tin; + plusbob_preserve((t_plusbob *)tin); + } + else bug("plustob_attach"); +} + +/* To be called from client code. + Preserving is caller's responsibility. */ +t_plustob *plustob_new(t_plustin *tin, Tcl_Obj *ob) +{ + return (plustob_create(plustob_type, tin, ob)); +} + +void plustob_setifshared(t_plustob *tob, t_plusifsharedfn ifsharedfn) +{ + tob->tob_ifsharedfn = ifsharedfn; +} + +int plustob_isshared(t_plustob *tob) +{ + return (tob->tob_value && Tcl_IsShared(tob->tob_value)); +} + +Tcl_Obj *plustob_getvalue(t_plustob *tob) +{ + return (tob->tob_value); +} + +/* silent, if caller is empty */ +t_plustin *plustag_tobtin(t_symbol *tag, t_pd *caller) +{ + return (plustag_validroot(tag, plusps_To, caller) + ? ((t_plustob *)tag)->tob_tin : 0); +} + +/* silent, if caller is empty */ +Tcl_Obj *plustag_tobvalue(t_symbol *tag, t_pd *caller) +{ + return (plustag_validroot(tag, plusps_To, caller) + ? ((t_plustob *)tag)->tob_value : 0); +} + +/* silent, if caller is empty */ +Tcl_Obj *plusatom_tobvalue(t_atom *ap, t_pd *caller) +{ + if (ap->a_type == A_SYMBOL) + return (plustag_tobvalue(ap->a_w.w_symbol, caller)); + else if (caller) + { + char buf[80]; + atom_string(ap, buf, 80); + loud_error((caller == PLUSBOB_OWNER ? 0 : caller), + "+tot does not understand '%s' (check object connections)", buf); + } + return (0); +} + +Tcl_Obj *plustob_set(t_plustob *tob, t_plustin *tin, Tcl_Obj *ob) +{ + if (tin != tob->tob_tin) + { + /* FIXME */ + loud_warning(0, "+To: environment mismatch"); + return (0); + } + if (ob != tob->tob_value) + { + if (tob->tob_value) + PLUSDEBUG_DECRREFCOUNT(tob->tob_value, "plustob_set"); + if (ob) + { + PLUSDEBUG_INCRREFCOUNT(ob, "plustob_set"); + if (Tcl_IsShared(ob)) + { + /* FIXME */ + } + } + tob->tob_value = ob; + } + return (ob); +} + +Tcl_Obj *plustob_setfloat(t_plustob *tob, t_float f) +{ + Tcl_Obj *ob = tob->tob_value; + if (!ob || Tcl_IsShared(ob)) + { + Tcl_Obj *tmp; + int i = (int)f; + if (ob && tob->tob_ifsharedfn) + { + if ((*tob->tob_ifsharedfn)((t_plusbob *)tob, ob) == 0) + return (0); + } + if (f == i) /* LATER rethink */ + tmp = Tcl_NewIntObj(i); + else + tmp = Tcl_NewDoubleObj((double)f); + if (tmp) + { + if (ob) PLUSDEBUG_DECRREFCOUNT(ob, "plustob_setfloat"); + tob->tob_value = ob = tmp; + PLUSDEBUG_INCRREFCOUNT(ob, "plustob_setfloat"); + } + else return (0); + } + else + { + int i = (int)f; + if (f == i) /* LATER rethink */ + Tcl_SetIntObj(ob, i); + else + Tcl_SetDoubleObj(ob, (double)f); + } + return (ob); +} + +Tcl_Obj *plustob_setsymbol(t_plustob *tob, t_symbol *s) +{ + if (plustag_isvalid(s, 0)) + { + if (plustag_validroot(s, plusps_To, PLUSBOB_OWNER)) + { + t_plustob *from = (t_plustob *)s; + return (plustob_set(tob, from->tob_tin, from->tob_value)); + } + else return (0); + } + else + { + Tcl_Obj *ob = tob->tob_value; + if (!ob || Tcl_IsShared(ob)) + { + Tcl_Obj *tmp; + if (ob && tob->tob_ifsharedfn) + { + if ((*tob->tob_ifsharedfn)((t_plusbob *)tob, ob) == 0) + return (0); + } + if (tmp = Tcl_NewStringObj(s->s_name, -1)) + { + if (ob) PLUSDEBUG_DECRREFCOUNT(ob, "plustob_setsymbol"); + tob->tob_value = ob = tmp; + PLUSDEBUG_INCRREFCOUNT(ob, "plustob_setsymbol"); + } + else return (0); + } + else Tcl_SetStringObj(ob, s->s_name, -1); + return (ob); + } +} + +Tcl_Obj *plustob_setlist(t_plustob *tob, int ac, t_atom *av) +{ + if (ac == 1) + { + if (av->a_type == A_FLOAT) + return (plustob_setfloat(tob, av->a_w.w_float)); + else if (av->a_type == A_SYMBOL) + return (plustob_setsymbol(tob, av->a_w.w_symbol)); + } + else if (ac > 1) + { + Tcl_Obj *ob = tob->tob_value; + int count; + t_atom *ap; + for (count = 0, ap = av; count < ac; count++, ap++) + if (ap->a_type != A_FLOAT && ap->a_type != A_SYMBOL) + break; + if (count > tob->tob_elbufsize) + { +#ifdef PLUSTOT_DEBUG + post("growing +To %d -> %d", tob->tob_elbufsize, count); +#endif + tob->tob_elbuf = + grow_nodata(&count, &tob->tob_elbufsize, tob->tob_elbuf, + PLUSTOB_INIELBUFSIZE, tob->tob_elbufini, + sizeof(*tob->tob_elbuf)); + } + if (count > 0) + { + int i; + Tcl_Obj **elp; + for (i = 0, elp = tob->tob_elbuf; i < count; i++, elp++, av++) + { + if (av->a_type == A_FLOAT) + *elp = Tcl_NewDoubleObj((double)av->a_w.w_float); + else if (av->a_type == A_SYMBOL) + *elp = Tcl_NewStringObj(av->a_w.w_symbol->s_name, -1); + } + if (!ob || Tcl_IsShared(ob)) + { + Tcl_Obj *tmp; + if (ob && tob->tob_ifsharedfn) + { + if ((*tob->tob_ifsharedfn)((t_plusbob *)tob, ob) == 0) + return (0); + } + if (tmp = Tcl_NewListObj(count, tob->tob_elbuf)) + { + if (ob) PLUSDEBUG_DECRREFCOUNT(ob, "plustob_setlist"); + tob->tob_value = ob = tmp; + PLUSDEBUG_INCRREFCOUNT(ob, "plustob_setlist"); + } + else return (0); + } + else Tcl_SetListObj(ob, count, tob->tob_elbuf); + return (ob); + } + } + return (0); /* count == 0, LATER rethink */ +} + +static int plustob_parseatoms(int ac, t_atom *av, int *natomsp, int *nlistsp, + Tcl_Obj **listobs, Tcl_Obj **atomobs) +{ + int i, natoms = 0, nlists = 0, start = 1; + t_atom *ap; + int atomcnt = 0; + Tcl_Obj **atomptr = atomobs; + for (i = 0, ap = av; i < ac; i++, ap++) + { + if (ap->a_type == A_SEMI || ap->a_type == A_COMMA) + { + /* empty lists are filtered out, LATER rethink */ + if (!start) + { + if (listobs) + { + if (listobs[nlists] = Tcl_NewListObj(atomcnt, atomptr)) + { + atomptr += atomcnt; + atomcnt = 0; + } + else goto parsefailed; + } + nlists++; + } + start = 1; + } + else + { + /* other types are ignored, LATER rethink */ + start = 0; + if (ap->a_type == A_FLOAT || ap->a_type == A_SYMBOL) + { + if (atomobs) + { + if (!(atomobs[natoms] = + (ap->a_type == A_FLOAT ? + Tcl_NewDoubleObj((double)ap->a_w.w_float) : + Tcl_NewStringObj(ap->a_w.w_symbol->s_name, -1)))) + goto parsefailed; + atomcnt++; + } + natoms++; + } + } + } + if (natoms && !start) + { + if (listobs && + !(listobs[nlists] = Tcl_NewListObj(atomcnt, atomptr))) + goto parsefailed; + nlists++; + } + if (natomsp) *natomsp = natoms; + if (nlistsp) *nlistsp = nlists; + return (1); +parsefailed: + /* FIXME cleanup */ + return (0); +} + +Tcl_Obj *plustob_setbinbuf(t_plustob *tob, t_binbuf *bb) +{ + int ac = binbuf_getnatom(bb); + if (ac) + { + t_atom *av = binbuf_getvec(bb); + Tcl_Obj *ob = tob->tob_value; + int count, natoms, nlists; + plustob_parseatoms(ac, av, &natoms, &nlists, 0, 0); + count = natoms + nlists; + if (count > tob->tob_elbufsize) + { + int n = count; +#ifdef PLUSTOT_DEBUG + post("growing +To %d -> %d", tob->tob_elbufsize, count); +#endif + tob->tob_elbuf = + grow_nodata(&n, &tob->tob_elbufsize, tob->tob_elbuf, + PLUSTOB_INIELBUFSIZE, tob->tob_elbufini, + sizeof(*tob->tob_elbuf)); + if (n < count) + goto setbbfailed; + } + if (!plustob_parseatoms(ac, av, 0, 0, + tob->tob_elbuf, tob->tob_elbuf + nlists)) + goto setbbfailed; + if (!ob || Tcl_IsShared(ob)) + { + Tcl_Obj *tmp; + if (ob && tob->tob_ifsharedfn) + { + if ((*tob->tob_ifsharedfn)((t_plusbob *)tob, ob) == 0) + goto setbbfailed; + } + if (tmp = Tcl_NewListObj(nlists, tob->tob_elbuf)) + { + if (ob) PLUSDEBUG_DECRREFCOUNT(ob, "plustob_setbinbuf"); + tob->tob_value = ob = tmp; + PLUSDEBUG_INCRREFCOUNT(ob, "plustob_setbinbuf"); + } + else goto setbbfailed; + } + else Tcl_SetListObj(ob, nlists, tob->tob_elbuf); + return (ob); + } +setbbfailed: + return (0); +} + +Tcl_Obj *plustob_grabresult(t_plustob *tob) +{ + Tcl_Interp *interp = tob->tob_tin->tin_interp; + Tcl_Obj *rob; + if (rob = Tcl_GetObjResult(interp)) + { + if (rob == tob->tob_value) + Tcl_ResetResult(interp); + else + { + PLUSDEBUG_INCRREFCOUNT(rob, "plustob_grabresult"); + Tcl_ResetResult(interp); + if (Tcl_IsShared(rob)) + { + /* FIXME */ + } + if (tob->tob_value) + PLUSDEBUG_DECRREFCOUNT(tob->tob_value, "plustob_grabresult"); + tob->tob_value = rob; + } + } + else plusloud_tcldirty(plusbob_getowner((t_plusbob *)tob), + "plustob_grabresult"); + return (rob); +} + +Tcl_Obj *plustob_evalob(t_plustob *tob, Tcl_Obj *ob) +{ + Tcl_Interp *interp = tob->tob_tin->tin_interp; + Tcl_Obj *rob; + Tcl_Preserve(interp); + if (Tcl_EvalObj(interp, ob) == TCL_OK) + rob = plustob_grabresult(tob); + else + { + plusloud_tclerror(plusbob_getowner((t_plusbob *)tob), interp, + "immediate command failed"); + rob = 0; + } + Tcl_Release(interp); + return (rob); +} + +/* Plusvar (aka +Tv) is a plustob with a one-way link to a tcl variable. + Whenever plusvar's value changes, the variable is set to it (the opposite + update requires explicitly calling the plusvar_pull() request). + This is different from one-way linking by passing TCL_LINK_READ_ONLY flag + to Tcl_LinkVar(): plusvar's variable is not forced to be read-only, + and its value's form and internal representation are not constrained. */ + +struct _plusvar +{ + t_plustob var_tob; + char *var_name; + char *var_index; + Tcl_Obj *var_part1; + Tcl_Obj *var_part2; +}; + +static t_plustype *plusvar_type; + +/* Since tcl always uses a hash table of string indices for array element + lookup, there are never any gains when using integer indices. */ + +/* To be called from derived constructors. + Preserving is caller's responsibility. */ +t_plusvar *plusvar_create(t_plustype *tp, t_plustin *tin, Tcl_Obj *ob, + char *name, char *index) +{ + t_plusvar *var = 0; + Tcl_Obj *ntob = 0; + Tcl_Obj *itob = 0; + if (name && *name) + { + if (ntob = Tcl_NewStringObj(name, -1)) + { + PLUSDEBUG_INCRREFCOUNT(ntob, "plusvar_create"); + } + else goto varfailed1; + } + else + { + bug("plusvar_create"); + goto varfailed2; + } + if (index) + { + if (itob = Tcl_NewStringObj(index, -1)) + { + PLUSDEBUG_INCRREFCOUNT(itob, "plusvar_create"); + } + else goto varfailed1; + } + if (var = (t_plusvar *)plustob_create(tp, tin, ob)) + { + var->var_name = getbytes(strlen(name) + 1); + strcpy(var->var_name, name); + if (index) + { + var->var_index = getbytes(strlen(index) + 1); + strcpy(var->var_index, index); + } + else var->var_index = 0; + var->var_part1 = ntob; + var->var_part2 = itob; + } + else goto varfailed2; + return (var); +varfailed1: + plusloud_tcldirty(0, "plusvar_create"); +varfailed2: + if (ntob) PLUSDEBUG_DECRREFCOUNT(ntob, "plusvar_create"); + if (itob) PLUSDEBUG_DECRREFCOUNT(itob, "plusvar_create"); + return (0); +} + +/* To be registered for calling from plusbob_release(). + Should never be called explicitly. */ +static void plusvar_delete(t_plusvar *var) +{ + freebytes(var->var_name, strlen(var->var_name) + 1); + if (var->var_index) + freebytes(var->var_index, strlen(var->var_index) + 1); + PLUSDEBUG_DECRREFCOUNT(var->var_part1, "plusvar_delete"); + if (var->var_part2) + PLUSDEBUG_DECRREFCOUNT(var->var_part2, "plusvar_delete"); +} + +/* To be called from client code. + Preserving is caller's responsibility */ +t_plusvar *plusvar_new(char *name, char *index, t_plustin *tin) +{ + return (plusvar_create(plusvar_type, tin, 0, name, index)); +} + +/* not used yet */ +static int plusvar_ifshared(t_plusbob *bob, Tcl_Obj *ob) +{ + /* Shared means either the variable still holds our value, or the value + is referenced by a third party, or both. In either case, we have to + pick a new object. + LATER consider testing for illegal use of a pseudo-variable. */ + return (1); +} + +/* LATER try making it more efficient */ +static Tcl_Obj *plusvar_postset(t_plusvar *var) +{ + Tcl_Obj *rob; + t_plustob *tob = (t_plustob *)var; + Tcl_Interp *interp = tob->tob_tin->tin_interp; + Tcl_Preserve(interp); + if (tob->tob_value) + { + rob = Tcl_ObjSetVar2(interp, var->var_part1, var->var_part2, + tob->tob_value, 0); + if (!rob) + { + if (Tcl_UnsetVar2(interp, var->var_name, 0, + TCL_LEAVE_ERR_MSG) == TCL_OK) + rob = Tcl_ObjSetVar2(interp, var->var_part1, var->var_part2, + tob->tob_value, TCL_LEAVE_ERR_MSG); + } + if (rob) + { +#ifdef PLUSTOT_DEBUGREFCOUNTS + if (var->var_index) + post("vv %x plusvar_postset [%s(%s)]", + (int)tob->tob_value, var->var_name, var->var_index); + else + post("vv %x plusvar_postset [%s]", + (int)tob->tob_value, var->var_name); +#endif + } + else plusloud_tclerror(0, interp, "cannot set variable"); + } + else + { + if (Tcl_UnsetVar2(interp, var->var_name, 0, + TCL_LEAVE_ERR_MSG) != TCL_OK) + plusloud_tclerror(0, interp, "cannot unset variable"); + rob = 0; + } + Tcl_Release(interp); + return (rob); +} + +Tcl_Obj *plusvar_push(t_plusvar *var) +{ + if (((t_plustob *)var)->tob_value) + return (plusvar_postset(var)); + else + return (0); +} + +Tcl_Obj *plusvar_pull(t_plusvar *var) +{ + Tcl_Obj *rob; + t_plustob *tob = (t_plustob *)var; + Tcl_Interp *interp = tob->tob_tin->tin_interp; + Tcl_Preserve(interp); + if (rob = Tcl_ObjGetVar2(interp, var->var_part1, var->var_part2, + TCL_LEAVE_ERR_MSG)) + plustob_set(tob, tob->tob_tin, rob); + else + plusloud_tclerror(0, interp, "cannot read variable"); + Tcl_Release(interp); + return (rob); +} + +Tcl_Obj *plusvar_set(t_plusvar *var, Tcl_Obj *ob, int doit) +{ + t_plustob *tob = (t_plustob *)var; + if (plustob_set(tob, tob->tob_tin, ob)) + return (doit ? plusvar_postset(var) : tob->tob_value); + else + return (0); +} + +Tcl_Obj *plusvar_setfloat(t_plusvar *var, t_float f, int doit) +{ + t_plustob *tob = (t_plustob *)var; + if (plustob_setfloat(tob, f)) + return (doit ? plusvar_postset(var) : tob->tob_value); + else + return (0); +} + +Tcl_Obj *plusvar_setsymbol(t_plusvar *var, t_symbol *s, int doit) +{ + t_plustob *tob = (t_plustob *)var; + if (plustob_setsymbol(tob, s)) + return (doit ? plusvar_postset(var) : tob->tob_value); + else + return (0); +} + +Tcl_Obj *plusvar_setlist(t_plusvar *var, int ac, t_atom *av, int doit) +{ + t_plustob *tob = (t_plustob *)var; + if (plustob_setlist(tob, ac, av)) + return (doit ? plusvar_postset(var) : tob->tob_value); + else + return (0); +} + +/* LATER derive +string from +bob */ + +typedef struct _plusstring +{ + int ps_len; + char *ps_buf; + int ps_refcount; +} t_plusstring; + +/* Resolving dot-separators, unless script is empty. */ +t_plusstring *plusstring_fromatoms(int ac, t_atom *av, t_scriptlet *script) +{ + t_plusstring *ps = 0; + char *buf; + int length; + if (script) + { + char *start; + scriptlet_reset(script); + scriptlet_add(script, 1, 1, ac, av); + start = scriptlet_getcontents(script, &length); + buf = copybytes(start, length); + } + else + { + char *newbuf; + buf = getbytes(0); + length = 0; + while (ac--) + { + char string[MAXPDSTRING]; + int newlength; + if ((av->a_type == A_SEMI || av->a_type == A_COMMA) && + length && buf[length-1] == ' ') length--; + atom_string(av, string, MAXPDSTRING); + newlength = length + strlen(string) + 1; + if (!(newbuf = resizebytes(buf, length, newlength))) break; + buf = newbuf; + strcpy(buf + length, string); + length = newlength; + if (av->a_type == A_SEMI) buf[length-1] = '\n'; + else buf[length-1] = ' '; + av++; + } + if (length && buf[length-1] == ' ') + { + if (newbuf = resizebytes(buf, length, length-1)) + { + buf = newbuf; + length--; + } + } + } + ps = getbytes(sizeof(*ps)); + ps->ps_len = length; + ps->ps_buf = buf; + ps->ps_refcount = 0; + return (ps); +} + +void plusstring_preserve(t_plusstring *ps) +{ + ps->ps_refcount++; +} + +void plusstring_release(t_plusstring *ps) +{ + if (--ps->ps_refcount <= 0) + { + if (ps->ps_refcount == 0) + { + if (ps->ps_buf) freebytes(ps->ps_buf, ps->ps_len); + freebytes(ps, sizeof(*ps)); + } + else bug("plusstring_release"); + } +} + +typedef struct _plusword +{ + int pw_type; + Tcl_Obj *pw_ob; + Tcl_Token *pw_ndxv; /* index part of this word (if array variable) */ + int pw_ndxc; /* numComponents of the above */ +} t_plusword; + +#define PLUSTOT_MAXINLETS 256 /* LATER rethink */ +#define PLUSTOT_INIMAXWORDS 16 + +/* LATER elaborate */ +#define PLUSTOT_ERRUNKNOWN -1 +#define PLUSTOT_ERROTHER -2 + +typedef struct _plusproxy +{ + t_pd pp_pd; + t_pd *pp_master; + t_plusvar *pp_var; + int pp_ndx; + int pp_doit; + int pp_warned; +} t_plusproxy; + +typedef struct _plustot +{ + t_object x_ob; + t_glist *x_glist; + t_plustob *x_tob; /* interpreter's result (after invocation) */ + t_scriptlet *x_script; + Tcl_Obj *x_cname; /* command name, main validation flag */ + Tcl_CmdInfo x_cinfo; + t_plusstring *x_ctail; /* command arguments, parse validation flag */ + Tcl_Parse x_tailparse; + int x_maxwords; /* as allocated */ + int x_nwords; /* as used, including command name */ + t_plusword *x_words; /* arguments, not evaluated */ + t_plusword x_wordsini[PLUSTOT_INIMAXWORDS]; + int x_maxargs; /* == maxwords, except during growing */ + int x_argc; /* 0 or nwords, except during evaluation */ + Tcl_Obj **x_argv; /* command name and evaluated arguments */ + Tcl_Obj *x_argvini[PLUSTOT_INIMAXWORDS]; + int x_pseudoscalar; + int x_nproxies; + t_plusproxy **x_proxies; + t_plusproxy *x_mainproxy; /* == x_proxies[0], unless pseudo-scalar */ + int x_grabwarned; +} t_plustot; + +static t_class *plusproxy_class; +static t_class *plustot_class; + +/* Create a variable here only for the main slot. Other slots are to be + filled during the second parsing pass, in order to fill only the slots + that are actually referenced. If ndx is negative, then create + a pseudo-scalar, otherwise this is a pseudo-array element. */ +static t_plusproxy *plusproxy_new(t_pd *master, int ndx, t_plustin *tin) +{ + t_plusproxy *pp = (t_plusproxy *)pd_new(plusproxy_class); + pp->pp_master = master; + pp->pp_var = (ndx > 0 ? 0 : plusvar_new("in", (ndx ? 0 : "0"), tin)); + if (pp->pp_var) + { + plusbob_preserve((t_plusbob *)pp->pp_var); + plusbob_setowner((t_plusbob *)pp->pp_var, master); + } + pp->pp_ndx = ndx; + pp->pp_doit = (ndx < 1); + pp->pp_warned = 0; + return (pp); +} + +static void plusproxy_free(t_plusproxy *pp) +{ +#ifdef PLUSTOT_DEBUG + post("plusproxy_free (%s %d)", + (pp->pp_var ? pp->pp_var->var_name : "empty"), pp->pp_ndx); +#endif + if (pp->pp_var) + plusbob_release((t_plusbob *)pp->pp_var); +} + +static void plusproxy_emptyhit(t_plusproxy *pp) +{ + if (!pp->pp_warned) + { + loud_error(pp->pp_master, "empty slot hit"); + pp->pp_warned = 1; + } +} + +static void plusproxy_bang(t_plusproxy *pp) +{ + if (pp->pp_var) + plusvar_push(pp->pp_var); + else + plusproxy_emptyhit(pp); +} + +static void plusproxy_float(t_plusproxy *pp, t_float f) +{ + if (pp->pp_var) + plusvar_setfloat(pp->pp_var, f, pp->pp_doit); + else + plusproxy_emptyhit(pp); +} + +static void plusproxy_symbol(t_plusproxy *pp, t_symbol *s) +{ + if (pp->pp_var) + plusvar_setsymbol(pp->pp_var, s, pp->pp_doit); + else + plusproxy_emptyhit(pp); +} + +static void plusproxy_list(t_plusproxy *pp, t_symbol *s, int ac, t_atom *av) +{ + if (pp->pp_var) + plusvar_setlist(pp->pp_var, ac, av, pp->pp_doit); + else + plusproxy_emptyhit(pp); +} + +#ifdef PLUSTOT_DEBUG +static void plusproxy_debug(t_plusproxy *pp) +{ + t_plustin *tin = ((t_plustob *)pp->pp_var)->tob_tin; + t_symbol *id = plusenv_getid((t_plusenv *)tin); + t_symbol *glname = plustin_getglistname(tin); + post("+proxy %d, glist %x", + pp->pp_ndx, (int)((t_plustot *)pp->pp_master)->x_glist); + post(" plustin '%s' (%s) over %x", (id ? id->s_name : "default"), + (glname ? glname->s_name : "<anonymous>"), (int)tin->tin_interp); +} +#endif + +/* First pass (!doit): determine number of slots. + Second pass (doit): create variables for non-empty slots. */ +static int plustot_usevariable(t_plustot *x, Tcl_Token *tp, int doit) +{ + int nc = tp->numComponents; + char *errmess = 0; + int errcode = PLUSTOT_ERRUNKNOWN; +#ifdef PLUSTOT_DEBUG + if (!doit) + { + char buf[MAXPDSTRING]; + int size = tp->size; + if (size > (MAXPDSTRING-2)) + { + size = (MAXPDSTRING-2); + buf[MAXPDSTRING-2] = '*'; + buf[MAXPDSTRING-1] = 0; + } + else buf[size] = 0; + strncpy(buf, tp->start, size); + startpost("%s ", buf); + } +#endif + tp++; + if (nc && tp->type == TCL_TOKEN_TEXT) + { + if (strncmp(tp->start, "in", tp->size)) + { + /* regular variable */ + /* LATER consider tracing it (2nd pass) */ + } + else + { + /* pseudo-variable */ + int inno = -1; + tp++; + if (nc == 1) + { + if (x->x_nproxies && !x->x_pseudoscalar) + { + errmess = "mixed scalar and array forms of pseudo-variable"; + errcode = PLUSTOT_ERROTHER; + goto badvariable; + } + inno = 0; + x->x_pseudoscalar = 1; + } + else if (nc == 2 && tp->type == TCL_TOKEN_TEXT) + { + int i; + char *p; + if (x->x_pseudoscalar) + { + errmess = "mixed scalar and array forms of pseudo-variable"; + errcode = PLUSTOT_ERROTHER; + goto badvariable; + } + inno = 0; + for (i = 0, p = (char *)tp->start; i < tp->size; i++, p++) + { + if (*p < '0' || *p > '9') + { + errmess = "invalid inlet number in pseudo-variable"; + errcode = PLUSTOT_ERROTHER; + goto badvariable; + } + inno = inno * 10 + (int)(*p - '0'); + } + if (inno > PLUSTOT_MAXINLETS) + { + errmess = "inlet number too large in pseudo-variable"; + errcode = PLUSTOT_ERROTHER; + goto badvariable; + } + } + else + { + errmess = "invalid index format in pseudo-variable"; + errcode = PLUSTOT_ERROTHER; + goto badvariable; + } + if (inno >= 0) + { + if (!doit) + { +#ifdef PLUSTOT_DEBUG + startpost("(inlet %d) ", inno); +#endif + if (inno >= x->x_nproxies) + x->x_nproxies = inno + 1; + } + else if (inno < x->x_nproxies) + { + if (inno > 0 && !x->x_proxies[inno]->pp_var) + { + t_plusvar *var; + char buf[8]; + sprintf(buf, "%d", inno); + var = plusvar_new("in", buf, x->x_tob->tob_tin); + plusbob_preserve((t_plusbob *)var); + plusbob_setowner((t_plusbob *)var, (t_pd *)x); + x->x_proxies[inno]->pp_var = var; + } + } + else + { + PLUSDEBUG_ENDPOST("plustot_usevariable"); + bug("plustot_usevariable"); + goto badvariable; + } + } + else + { + errmess = "invalid pseudo-variable"; + errcode = PLUSTOT_ERROTHER; + goto badvariable; + } + } + return (1); + } + else plusloud_tcldirty((t_pd *)x, "plustot_usevariable"); +badvariable: + if (errmess) + { + PLUSDEBUG_ENDPOST("plustot_usevariable"); + loud_error((t_pd *)x, errmess); + } + return (errcode); +} + +static int plustot_doparsevariables(t_plustot *x, Tcl_Interp *interp, + const char *buf, int len, + Tcl_Parse *parsep, int doit) +{ + int nvars = 0; + int errcode = PLUSTOT_ERRUNKNOWN; + if (Tcl_ParseCommand(interp, buf, len, 0, parsep) == TCL_OK) + { + int ntok = parsep->numTokens; + Tcl_Token *tp = parsep->tokenPtr; + while (ntok--) + { + if (tp->type == TCL_TOKEN_VARIABLE) + { + int res = plustot_usevariable(x, tp, doit); + if (res > 0) + nvars++; + else + { + errcode = res; + goto parsefailed; + } + } + else if (tp->type == TCL_TOKEN_COMMAND) + { + if (tp->size > 2) + { + Tcl_Parse parse; + int res = + plustot_doparsevariables(x, interp, tp->start + 1, + tp->size - 2, &parse, doit); + if (res != PLUSTOT_ERRUNKNOWN) + Tcl_FreeParse(&parse); + if (res >= 0) + nvars += res; + else + { + errcode = res; + goto parsefailed; + } + } + } + else if (tp->type == TCL_TOKEN_SIMPLE_WORD + && tp->size > 2 && *tp->start == '{') + { + tp++; +#if 0 && defined(PLUSTOT_DEBUG) + if (doit && tp->size > 0) + { + char buf[MAXPDSTRING+1]; + int sz = (tp->size < MAXPDSTRING ? tp->size : MAXPDSTRING); + strncpy(buf, tp->start, sz); + buf[sz] = 0; + post("simple word's text: %s", buf); + } +#endif + if (ntok-- && tp->type == TCL_TOKEN_TEXT && tp->size > 0) + { + Tcl_Parse parse; + int res = + plustot_doparsevariables(x, interp, tp->start, + tp->size, &parse, doit); + if (res != PLUSTOT_ERRUNKNOWN) + Tcl_FreeParse(&parse); + if (res >= 0) + nvars += res; + else + { + errcode = res; + goto parsefailed; + } + } + else + { + plusloud_tcldirty((t_pd *)x, "plustot_doparsevariables"); + goto parsefailed; + } + } +#if 0 && defined(PLUSTOT_DEBUG) + else if (doit && tp->size > 0) + { + char buf[MAXPDSTRING+1]; + int sz = (tp->size < MAXPDSTRING ? tp->size : MAXPDSTRING); + strncpy(buf, tp->start, sz); + buf[sz] = 0; + post("other type (%d): %s", tp->type, buf); + } +#endif + tp++; + } + } + else goto parsefailed; + return (nvars); +parsefailed: + return (errcode); +} + +static int plustot_parsevariables(t_plustot *x, Tcl_Interp *interp, + const char *buf, int len, + Tcl_Parse *parsep, int doit) +{ + int nvars; +#ifdef PLUSTOT_DEBUG + if (!doit) startpost("variables: "); +#endif + nvars = plustot_doparsevariables(x, interp, buf, len, parsep, doit); +#ifdef PLUSTOT_DEBUG + if (!doit) + { + if (nvars > 0) + { + post("\n%d variable substitutions", nvars); + post("%d inlets requested", x->x_nproxies); + } + else if (nvars == 0) post("none"); + } +#endif + return (nvars); +} + +static int plustot_makeproxies(t_plustot *x) +{ + Tcl_Interp *interp = x->x_tob->tob_tin->tin_interp; + if (interp) + { + if (x->x_nproxies == 1) + { + x->x_mainproxy = + plusproxy_new((t_pd *)x, (x->x_pseudoscalar ? -1 : 0), + x->x_tob->tob_tin); + } + else if (x->x_nproxies > 1 && !x->x_pseudoscalar) + { + if (x->x_proxies = getbytes(x->x_nproxies * sizeof(*x->x_proxies))) + { + int i; + for (i = 0; i < x->x_nproxies; i++) + x->x_proxies[i] = + plusproxy_new((t_pd *)x, i, x->x_tob->tob_tin); + for (i = 1; i < x->x_nproxies; i++) + inlet_new((t_object *)x, (t_pd *)x->x_proxies[i], 0, 0); + x->x_mainproxy = x->x_proxies[0]; + /* second pass: traverse non-empty slots, create variables */ + plustot_parsevariables(x, interp, + x->x_ctail->ps_buf, x->x_ctail->ps_len, + &x->x_tailparse, 1); + } + else goto proxiesfailed; + } + else + { + bug("plustot_makeproxies"); + goto proxiesfailed; + } + return (1); + } +proxiesfailed: + return (0); +} + +static void plustot_initwords(t_plustot *x) +{ + if (x->x_words != x->x_wordsini) + freebytes(x->x_words, x->x_maxwords * sizeof(*x->x_words)); + x->x_maxwords = PLUSTOT_INIMAXWORDS; + x->x_nwords = 0; + x->x_words = x->x_wordsini; +} + +static void plustot_initargs(t_plustot *x) +{ + if (x->x_argv != x->x_argvini) + freebytes(x->x_argv, x->x_maxargs * sizeof(*x->x_argv)); + x->x_maxargs = PLUSTOT_INIMAXWORDS; + x->x_argc = 0; + x->x_argv = x->x_argvini; + x->x_argv[0] = x->x_cname; +} + +static int plustot_resetwords(t_plustot *x) +{ + int i; + for (i = 1; i < x->x_nwords; i++) + PLUSDEBUG_DECRREFCOUNT(x->x_words[i].pw_ob, "plustot_resetwords"); + x->x_nwords = 0; + if (x->x_ctail) + { + int nwords = x->x_tailparse.numWords + 1; + if (nwords > x->x_maxwords) + { + int n = nwords; +#ifdef PLUSTOT_DEBUG + post("growing words %d -> %d", x->x_maxwords, nwords); +#endif + x->x_words = grow_nodata(&n, &x->x_maxwords, x->x_words, + PLUSTOT_INIMAXWORDS, x->x_wordsini, + sizeof(*x->x_words)); + if (n != nwords) + return (0); + } + return (1); + } + else return (0); +} + +static int plustot_resetargs(t_plustot *x) +{ + int i; + for (i = 1; i < x->x_argc; i++) + PLUSDEBUG_DECRREFCOUNT(x->x_argv[i], "plustot_resetargs"); + x->x_argc = 0; + x->x_argv[0] = x->x_cname; + if (x->x_ctail) + { + int nargs = x->x_maxwords; + if (nargs > x->x_maxargs) + { + int n = nargs; +#ifdef PLUSTOT_DEBUG + post("growing argv %d -> %d", x->x_maxargs, nargs); +#endif + x->x_argv = grow_nodata(&n, &x->x_maxargs, x->x_argv, + PLUSTOT_INIMAXWORDS, x->x_argvini, + sizeof(*x->x_argv)); + x->x_argv[0] = x->x_cname; + if (n != nargs) + { + plustot_initwords(x); + plustot_initargs(x); + return (0); + } + } + else if (nargs < x->x_maxargs) + { + bug("plustot_resetargs"); /* LATER rethink */ + plustot_initwords(x); + plustot_initargs(x); + return (0); + } + return (1); + } + else return (0); +} + +static int plustot_makewords(t_plustot *x) +{ + if (plustot_resetwords(x)) + { + int i, ncomponents = 0, nwords = x->x_tailparse.numWords + 1; + Tcl_Token *tp; + int len; + char buf[TCL_UTF_MAX]; +#ifdef PLUSTOT_DEBUG + post("arguments:"); +#endif + for (i = 1, tp = x->x_tailparse.tokenPtr; + i < nwords; i++, tp += ncomponents) + { +#ifdef PLUSTOT_DEBUG + post(" %s token: type %d[%d], having %d[%d] component%s", + loud_ordinal(i), tp->type, tp[1].type, + tp->numComponents, tp[1].numComponents, + (tp->numComponents > 1 ? "s" : "")); +#endif + ncomponents = tp->numComponents; + tp++; + switch (x->x_words[i].pw_type = tp->type) + { + case TCL_TOKEN_TEXT: + x->x_words[i].pw_ob = Tcl_NewStringObj(tp->start, tp->size); + break; + + case TCL_TOKEN_BS: + len = Tcl_UtfBackslash(tp->start, 0, buf); + x->x_words[i].pw_ob = Tcl_NewStringObj(buf, len); + break; + + case TCL_TOKEN_COMMAND: + x->x_words[i].pw_ob = Tcl_NewStringObj(tp->start + 1, + tp->size - 2); + break; + + case TCL_TOKEN_VARIABLE: + if (tp->numComponents > 1) + { + x->x_words[i].pw_ndxv = tp + 2; + x->x_words[i].pw_ndxc = tp->numComponents - 1; + } + else x->x_words[i].pw_ndxv = 0; + x->x_words[i].pw_ob = Tcl_NewStringObj(tp[1].start, tp[1].size); + break; + + default: + plusloud_tcldirty((t_pd *)x, + "plustot_makewords (unexpected token type)"); + goto wordsfailed; + } + PLUSDEBUG_INCRREFCOUNT(x->x_words[i].pw_ob, "plustot_makewords"); + } + x->x_nwords = nwords; + return (1); +wordsfailed: + x->x_nwords = i; + plustot_resetwords(x); + } + return (0); +} + +static int plustot_argsfromwords(t_plustot *x, Tcl_Interp *interp) +{ + if (plustot_resetargs(x)) + { + t_plusword *pw; + int i; + for (i = 1, pw = &x->x_words[1]; i < x->x_nwords; i++, pw++) + { + int result; + if (pw->pw_type == TCL_TOKEN_COMMAND) + { + result = Tcl_EvalObjEx(interp, pw->pw_ob, 0); + if (result == TCL_OK) + { + if (x->x_argv[i] = Tcl_GetObjResult(interp)) + { + PLUSDEBUG_INCRREFCOUNT(x->x_argv[i], + "plustot_argsfromwords"); + Tcl_ResetResult(interp); + } + else + { + plusloud_tcldirty((t_pd *)x, "plustot_argsfromwords"); + goto evalfailed; + } + } + else + { + plusloud_tclerror((t_pd *)x, interp, "bad word (command)"); + goto evalfailed; + } + } + else if (pw->pw_type == TCL_TOKEN_VARIABLE) + { + Tcl_Obj *indexp; + if (x->x_words[i].pw_ndxv) + { + /* FIXME */ + int res = Tcl_EvalTokensStandard(interp, + x->x_words[i].pw_ndxv, + x->x_words[i].pw_ndxc); + if (res == TCL_OK) + { + indexp = Tcl_GetObjResult(interp); + PLUSDEBUG_INCRREFCOUNT(indexp, + "plustot_argsfromwords"); + Tcl_ResetResult(interp); + } + else + { + plusloud_tclerror((t_pd *)x, interp, "bad index"); + goto evalfailed; + } + } + else indexp = 0; + if (x->x_argv[i] = Tcl_ObjGetVar2(interp, pw->pw_ob, indexp, + TCL_LEAVE_ERR_MSG)) + { + PLUSDEBUG_INCRREFCOUNT(x->x_argv[i], + "plustot_argsfromwords"); + Tcl_ResetResult(interp); + } + else + { + plusloud_tclerror((t_pd *)x, interp, "bad word (variable)"); + goto evalfailed; + } + } + else + { + x->x_argv[i] = pw->pw_ob; + /* refcount is 1 already (makewords), but we need to comply to + a general rule: args are decremented after use (resetargs) */ + PLUSDEBUG_INCRREFCOUNT(x->x_argv[i], "plustot_argsfromwords"); + } + } + x->x_argc = x->x_nwords; + return (1); +evalfailed: + x->x_argc = i; + plustot_resetargs(x); + } + return (0); /* LATER find a proper way for passing a result */ +} + +static int plustot_argsfromtokens(t_plustot *x, Tcl_Interp *interp) +{ + if (plustot_resetargs(x)) + { + int i, nwords = x->x_tailparse.numWords + 1; + Tcl_Token *tp; +#ifdef PLUSTOT_DEBUG + post("arguments:"); +#endif + for (i = 1, tp = x->x_tailparse.tokenPtr; + i < nwords; i++, tp += (tp->numComponents + 1)) + { + int result; +#ifdef PLUSTOT_DEBUG + startpost(" %s token: type %d[%d], having %d component%s", + loud_ordinal(i), tp->type, tp[1].type, + tp->numComponents, (tp->numComponents > 1 ? "s" : "")); +#endif + result = Tcl_EvalTokensStandard(interp, tp + 1, tp->numComponents); + if (result == TCL_OK) + { + if (x->x_argv[i] = Tcl_GetObjResult(interp)) + { + PLUSDEBUG_INCRREFCOUNT(x->x_argv[i], + "plustot_argsfromwords"); + Tcl_ResetResult(interp); +#ifdef PLUSTOT_DEBUG + post(", %sshared: '%s'", + (Tcl_IsShared(x->x_argv[i]) ? "" : "not "), + Tcl_GetString(x->x_argv[i])); +#endif + } + else + { + PLUSDEBUG_ENDPOST("plustot_argsfromtokens"); + plusloud_tcldirty((t_pd *)x, "plustot_argsfromtokens"); + } + } + else + { + PLUSDEBUG_ENDPOST("plustot_argsfromtokens"); + plusloud_tclerror((t_pd *)x, interp, "bad token"); + while (--i) + PLUSDEBUG_DECRREFCOUNT(x->x_argv[i], + "plustot_argsfromtokens"); + return (0); /* LATER find a proper way for passing a result */ + } + } + x->x_argc = nwords; + return (1); + } + else return (0); +} + +/* not used yet */ +static int plustot_ifgrabshared(t_plustot *x, Tcl_Obj *ob) +{ + if (!x->x_grabwarned) + { + x->x_grabwarned = 1; + loud_warning((t_pd *)x, "shared result of a command '%s'", + (x->x_cname ? Tcl_GetString(x->x_cname) : "???")); + } + return (1); +} + +static int plustot_push(t_plustot *x) +{ + if (x->x_proxies) + { + int i; + for (i = 1; i < x->x_nproxies; i++) + if (x->x_proxies[i]->pp_var) + if (!plusvar_push(x->x_proxies[i]->pp_var)) + return (0); + } + return (1); +} + +static int plustot_doit(t_plustot *x) +{ + int result = 0; + Tcl_Interp *interp = x->x_tob->tob_tin->tin_interp; + if (x->x_cname && plustot_push(x) && + plustot_argsfromwords(x, interp)) + { + if ((*x->x_cinfo.objProc)(x->x_cinfo.objClientData, interp, + x->x_argc, x->x_argv) == TCL_OK) + { + if (plustob_grabresult(x->x_tob)) + result = 1; + } + else plusloud_tclerror((t_pd *)x, interp, "command failed"); + /* Although args are to be reset in the next call to + plustot_argsfromwords(), however, plusvar_preset() will be called + first, so, unless reset is done here, $ins would be shared there. + LATER rethink. */ + plustot_resetargs(x); + } + return (result); +} + +static void plustot_eval(t_plustot *x) +{ + plustot_doit(x); +} + +static void plustot_get(t_plustot *x) +{ + if (x->x_tob->tob_value) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob); +} + +/* set in(0), no evaluation */ +static void plustot_set(t_plustot *x, t_symbol *s, int ac, t_atom *av) +{ + if (x->x_mainproxy) + { + if (ac == 1) + { + if (av->a_type == A_FLOAT) + plusproxy_float(x->x_mainproxy, av->a_w.w_float); + else if (av->a_type == A_SYMBOL) + plusproxy_symbol(x->x_mainproxy, av->a_w.w_symbol); + } + else plusproxy_list(x->x_mainproxy, s, ac, av); + } +} + +static void plustot_bang(t_plustot *x) +{ + if (x->x_mainproxy) + plusproxy_bang(x->x_mainproxy); + if (plustot_doit(x)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob); +} + +static void plustot_float(t_plustot *x, t_float f) +{ + if (x->x_mainproxy) + plusproxy_float(x->x_mainproxy, f); + if (plustot_doit(x)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob); +} + +static void plustot_symbol(t_plustot *x, t_symbol *s) +{ + if (x->x_mainproxy) + plusproxy_symbol(x->x_mainproxy, s); + if (plustot_doit(x)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob); +} + +static void plustot_list(t_plustot *x, t_symbol *s, int ac, t_atom *av) +{ + if (x->x_mainproxy) + plusproxy_list(x->x_mainproxy, s, ac, av); + if (plustot_doit(x)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob); +} + +static void plustot_tot(t_plustot *x, t_symbol *s, int ac, t_atom *av) +{ + if (ac) + { + Tcl_Obj *ob; + char *start; + int len; + scriptlet_reset(x->x_script); + scriptlet_add(x->x_script, 1, 1, ac, av); + start = scriptlet_getcontents(x->x_script, &len); + if (len > 0 && (ob = Tcl_NewStringObj(start, len))) + { + /* LATER set a persistent ob, rather than create a new one */ + PLUSDEBUG_INCRREFCOUNT(ob, "plustot_tot"); + if (plustob_evalob(x->x_tob, ob) && s == totps_query) + outlet_plusbob(((t_object *)x)->ob_outlet, + (t_plusbob *)x->x_tob); + PLUSDEBUG_DECRREFCOUNT(ob, "plustot_tot"); + } + } +} + +#ifdef PLUSTOT_DEBUG +static void plustot_debug(t_plustot *x) +{ + t_plustin *tin = x->x_tob->tob_tin; + t_symbol *id = plusenv_getid((t_plusenv *)tin); + t_symbol *glname = plustin_getglistname(tin); + post("+tot, glist %x", (int)x->x_glist); + post(" plustin '%s' (%s) over %x", (id ? id->s_name : "default"), + (glname ? glname->s_name : "<anonymous>"), (int)tin->tin_interp); + if (x->x_mainproxy) + plusproxy_debug(x->x_mainproxy); +} +#endif + +static void plustot_free(t_plustot *x) +{ + int i; + plusbob_release((t_plusbob *)x->x_tob); + if (x->x_cname) PLUSDEBUG_DECRREFCOUNT(x->x_cname, "plustot_free"); + if (x->x_ctail) + { + for (i = 1; i < x->x_nwords; i++) + PLUSDEBUG_DECRREFCOUNT(x->x_words[i].pw_ob, "plustot_free"); + for (i = 1; i < x->x_argc; i++) + PLUSDEBUG_DECRREFCOUNT(x->x_argv[i], "plustot_free"); + if (x->x_words != x->x_wordsini) + freebytes(x->x_words, x->x_maxwords * sizeof(*x->x_words)); + if (x->x_argv != x->x_argvini) + freebytes(x->x_argv, x->x_maxwords * sizeof(*x->x_argv)); + Tcl_FreeParse(&x->x_tailparse); + plusstring_release(x->x_ctail); + } + if (x->x_mainproxy) pd_free((t_pd *)x->x_mainproxy); + if (x->x_proxies) + { + for (i = 1; i < x->x_nproxies; i++) + pd_free((t_pd *)x->x_proxies[i]); + freebytes(x->x_proxies, x->x_nproxies * sizeof(*x->x_proxies)); + } + if (x->x_script) scriptlet_free(x->x_script); +} + +static void *plustot_new(t_symbol *s, int ac, t_atom *av) +{ + t_plustot *x = 0; + t_plusstring *ctail = 0; + t_symbol *cmdname = 0; /* command name or +selector */ + t_glist *glist = canvas_getcurrent(); + t_plustin *tin = 0; + t_plustob *tob = 0; + t_scriptlet *script = scriptlet_new(0, 0, 0, 0, glist, 0); + if (ac && av->a_type == A_SYMBOL) + { + cmdname = av->a_w.w_symbol; + ac--; av++; + if (*cmdname->s_name == '+') + { + if (cmdname == plusps_env) + return (plustot_env_new(cmdname, ac, av)); + else if (cmdname == plusps_in) + return (plustot_in_new(cmdname, ac, av)); + else if (cmdname == plusps_var) + return (plustot_var_new(cmdname, ac, av)); + else if (cmdname == plusps_out) + return (plustot_out_new(cmdname, ac, av)); + else if (cmdname == plusps_qlist) + return (plustot_qlist_new(cmdname, ac, av)); + else if (cmdname == plusps_print) + return (plustot_print_new(cmdname, ac, av)); + else + { + loud_error(0, "unknown +tot's subclass"); + return (0); + } + } + if (ac) + { + ctail = plusstring_fromatoms(ac, av, script); + plusstring_preserve(ctail); + } + } + if ((tin = plustin_glistprovide(glist, PLUSTIN_GLIST_ANY, 0)) && + (tob = plustob_new(tin, 0))) + { + x = (t_plustot *)pd_new(plustot_class); + /* tin already preserved (plustob_new() did it) */ + plusbob_preserve((t_plusbob *)tob); + plusbob_setowner((t_plusbob *)tob, (t_pd *)x); + x->x_glist = glist; + x->x_tob = tob; + scriptlet_setowner(script, (t_pd *)x); + x->x_script = script; + x->x_cname = 0; + x->x_ctail = 0; + x->x_words = x->x_wordsini; + plustot_initwords(x); + x->x_argv = x->x_argvini; + plustot_initargs(x); + x->x_pseudoscalar = 0; + x->x_nproxies = 0; + x->x_proxies = 0; + x->x_mainproxy = 0; + x->x_grabwarned = 0; + if (cmdname && *cmdname->s_name) + { + Tcl_Interp *interp = tin->tin_interp; + if (interp) + { + if (Tcl_GetCommandInfo(interp, cmdname->s_name, &x->x_cinfo)) + { + if (x->x_cinfo.isNativeObjectProc) + { + x->x_cname = Tcl_NewStringObj(cmdname->s_name, -1); + PLUSDEBUG_INCRREFCOUNT(x->x_cname, "plustot_new"); + x->x_argv[0] = x->x_cname; + } + else loud_error((t_pd *)x, "'%s' is not an object command", + cmdname->s_name); + } + else loud_error((t_pd *)x, "command '%s' does not exist", + cmdname->s_name); + if (x->x_cname && ctail) + { + int nvars = + plustot_parsevariables(x, interp, + ctail->ps_buf, ctail->ps_len, + &x->x_tailparse, 0); + if (nvars >= 0) + { + int res = 1; + x->x_ctail = ctail; + if (x->x_nproxies) + res = plustot_makeproxies(x); + if (res) + res = plustot_makewords(x); + if (!res) + x->x_ctail = 0; + Tcl_FreeParse(&x->x_tailparse); + } + else + { + if (nvars == PLUSTOT_ERRUNKNOWN) + plusloud_tclerror((t_pd *)x, interp, + "parsing command arguments failed"); + else + Tcl_FreeParse(&x->x_tailparse); + PLUSDEBUG_DECRREFCOUNT(x->x_cname, "plustot_new"); + x->x_cname = 0; + } + } + } + } + outlet_new((t_object *)x, &s_symbol); + } + else + { + loud_error(0, "+tot: cannot initialize"); + if (tin) + { + plusbob_preserve((t_plusbob *)tin); + plusbob_release((t_plusbob *)tin); + } + if (script) scriptlet_free(script); + } + if (ctail && !(x && x->x_ctail)) + plusstring_release(ctail); + return (x); +} + +void plustot_setup(void) +{ + post("beware! this is plustot %s, %s %s build...", + TOXY_VERSION, loud_ordinal(TOXY_BUILD), TOXY_RELEASE); + plustot_class = class_new(gensym("+tot"), + (t_newmethod)plustot_new, + (t_method)plustot_free, + sizeof(t_plustot), 0, A_GIMME, 0); + class_addcreator((t_newmethod)plustot_new, + gensym("plustot"), A_GIMME, 0); + class_addbang(plustot_class, plustot_bang); + class_addfloat(plustot_class, plustot_float); + class_addsymbol(plustot_class, plustot_symbol); + class_addlist(plustot_class, plustot_list); + class_addmethod(plustot_class, (t_method)plustot_eval, + gensym("eval"), 0); + class_addmethod(plustot_class, (t_method)plustot_set, + gensym("set"), A_GIMME, 0); + class_addmethod(plustot_class, (t_method)plustot_get, + gensym("get"), 0); + class_addmethod(plustot_class, (t_method)plustot_tot, + gensym("tot"), A_GIMME, 0); + class_addmethod(plustot_class, (t_method)plustot_tot, + gensym("query"), A_GIMME, 0); +#ifdef PLUSTOT_DEBUG + class_addmethod(plustot_class, (t_method)plustot_debug, + gensym("debug"), 0); +#endif + + plusproxy_class = class_new(gensym("+tot proxy"), 0, + (t_method)plusproxy_free, + sizeof(t_plusproxy), CLASS_PD, 0); + class_addfloat(plusproxy_class, plusproxy_float); + class_addsymbol(plusproxy_class, plusproxy_symbol); + class_addlist(plusproxy_class, plusproxy_list); +#ifdef PLUSTOT_DEBUG + class_addmethod(plusproxy_class, (t_method)plusproxy_debug, + gensym("debug"), 0); +#endif + + plusps_tot = gensym("+tot"); + plusps_env = gensym("+env"); + plusps_in = gensym("+in"); + plusps_var = gensym("+var"); + plusps_out = gensym("+out"); + plusps_qlist = gensym("+qlist"); + plusps_print = gensym("+print"); + plusps_Ti = gensym("+Ti"); + plusps_To = gensym("+To"); + plusps_Tv = gensym("+Tv"); + totps_query = gensym("query"); + + plustin_basetype = plusenv_setup(); + plustin_type = plustype_new(plustin_basetype, plusps_Ti, + sizeof(t_plustin), + (t_plustypefn)plustin_delete, 0, 0, 0); + plustob_type = plustype_new(0, plusps_To, + sizeof(t_plustob), + (t_plustypefn)plustob_delete, 0, 0, + (t_plustypefn)plustob_attach); + plusvar_type = plustype_new(plustob_type, plusps_Tv, + sizeof(t_plusvar), + (t_plustypefn)plusvar_delete, 0, 0, 0); + + plustot_env_setup(); + plustot_in_setup(); + plustot_var_setup(); + plustot_out_setup(); + plustot_qlist_setup(); + plustot_print_setup(); +} diff --git a/toxy/plustot.env.c b/toxy/plustot.env.c new file mode 100644 index 0000000..c1dbfe2 --- /dev/null +++ b/toxy/plustot.env.c @@ -0,0 +1,150 @@ +/* Copyright (c) 2003 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +#include <stdio.h> +#include <string.h> +#ifdef UNIX +#include <unistd.h> +#endif +#ifdef NT +#include <io.h> +#endif +#include "m_pd.h" +#include "g_canvas.h" +#include "common/loud.h" +#include "hammer/file.h" +#include "toxy/plusbob.h" +#include "plustot.h" + +typedef struct _plustot_env +{ + t_object x_ob; + t_plustin *x_tin; + t_glist *x_glist; + t_hammerfile *x_filehandle; +} t_plustot_env; + +static t_class *plustot_env_class; + +static void plustot_env_takeover(t_glist *glist, t_plusbob *defparent, + t_plusbob *newparent) +{ + t_gobj *g; + for (g = glist->gl_list; g; g = g->g_next) + { + if (pd_class(&g->g_pd) == canvas_class) + { + if (!plustin_glistfind((t_glist *)g, PLUSTIN_GLIST_THIS)) + plustot_env_takeover((t_glist *)g, defparent, newparent); + } + else plusbob_detachownedchildren(defparent, newparent, (t_pd *)g); + } +} + +static void plustot_env_evalfile(t_plustot_env *x, t_symbol *fname) +{ + char buf1[MAXPDSTRING], buf2[MAXPDSTRING], *nameptr, *dir; + int fd; + dir = canvas_getdir(x->x_glist)->s_name; + if ((fd = open_via_path(dir, fname->s_name, "", + buf1, &nameptr, MAXPDSTRING, 0)) < 0) + { + loud_error((t_pd *)x, "file '%s' not found", fname->s_name); + } + else + { + Tcl_Interp *interp = plustin_getinterp(x->x_tin); + FILE *fp; + close(fd); + strcpy(buf2, buf1); + strcat(buf2, "/"); + strcat(buf2, nameptr); + sys_bashfilename(buf2, buf2); + Tcl_Preserve(interp); + if (Tcl_EvalFile(interp, buf2) != TCL_OK) + { + strcpy(buf1, "evaluation failed ("); + strncat(buf1, buf2, MAXPDSTRING - strlen(buf1) - 2); + strcat(buf1, ")"); + plusloud_tclerror((t_pd *)x, interp, buf1); + } + Tcl_Release(interp); + } +} + +static void plustot_env_evalfilehook(t_pd *z, t_symbol *fn, int ac, t_atom *av) +{ + plustot_env_evalfile((t_plustot_env *)z, fn); +} + +static void plustot_env_bang(t_plustot_env *x) +{ + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tin); +} + +static void plustot_env_source(t_plustot_env *x, t_symbol *s) +{ + if (s && s != &s_) + plustot_env_evalfile(x, s); + else + hammerpanel_open(x->x_filehandle, 0); +} + +static void plustot_env_free(t_plustot_env *x) +{ + t_plustin *tin = plustin_glistprovide(x->x_glist, PLUSTIN_GLIST_UP, 0); + plusbob_detachchildren((t_plusbob *)x->x_tin, (t_plusbob *)tin); + plusbob_release((t_plusbob *)x->x_tin); + hammerfile_free(x->x_filehandle); +} + +void *plustot_env_new(t_symbol *s, int ac, t_atom *av) +{ + t_plustot_env *x = 0; + t_glist *gl = canvas_getcurrent(); + t_plustin *oldtin = plustin_glistfind(gl, PLUSTIN_GLIST_THIS); + t_plustin *deftin = (oldtin ? 0 : plustin_glistfind(gl, PLUSTIN_GLIST_ANY)); + t_plustin *tin = 0; + if ((tin = oldtin) + || (tin = plustin_glistprovide(gl, PLUSTIN_GLIST_THIS, 1))) + { + int warned = 0; + x = (t_plustot_env *)pd_new(plustot_env_class); + x->x_tin = tin; + plusbob_preserve((t_plusbob *)tin); + x->x_glist = gl; + outlet_new((t_object *)x, &s_symbol); + if (deftin) + /* true if both oldtin == 0 (we are first in this glist) + and plustin_default != 0 (bobs exist already) */ + plustot_env_takeover(x->x_glist, + (t_plusbob *)deftin, (t_plusbob *)tin); + x->x_filehandle = hammerfile_new((t_pd *)x, 0, + plustot_env_evalfilehook, 0, 0); + while (ac--) + { + if (av->a_type == A_SYMBOL) + plustot_env_evalfile(x, av->a_w.w_symbol); + else if (!warned) + { + loud_warning((t_pd *)x, "bad atom"); + warned = 1; + } + av++; + } + } + else loud_error(0, "+env: cannot initialize"); + return (x); +} + +void plustot_env_setup(void) +{ + plustot_env_class = class_new(gensym("+env"), 0, + (t_method)plustot_env_free, + sizeof(t_plustot_env), 0, 0); + class_addbang(plustot_env_class, plustot_env_bang); + class_addmethod(plustot_env_class, (t_method)plustot_env_source, + gensym("source"), A_DEFSYM, 0); + hammerfile_setup(plustot_env_class, 0); +} diff --git a/toxy/plustot.h b/toxy/plustot.h new file mode 100644 index 0000000..e08e7b0 --- /dev/null +++ b/toxy/plustot.h @@ -0,0 +1,81 @@ +/* Copyright (c) 2003 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +#ifndef __PLUSTOT_H__ +#define __PLUSTOT_H__ + +#define PD_EXTERN EXTERN +#undef EXTERN +#include <tcl.h> +#undef EXTERN +#define EXTERN PD_EXTERN +#undef PD_EXTERN + +EXTERN_STRUCT _plustin; +#define t_plustin struct _plustin +EXTERN_STRUCT _plustob; +#define t_plustob struct _plustob +EXTERN_STRUCT _plusvar; +#define t_plusvar struct _plusvar + +t_symbol *plusps_Ti; +t_symbol *plusps_To; +t_symbol *plusps_Tv; + +#define PLUSTOB_MAKEIT ((Tcl_Obj *)-1) + +typedef int (*t_plusifsharedfn)(t_plusbob *, Tcl_Obj *); + +enum { PLUSTIN_GLIST_THIS, PLUSTIN_GLIST_ANY, PLUSTIN_GLIST_UP }; + +void plusloud_tclerror(t_pd *caller, Tcl_Interp *interp, char *msg); + +t_plustin *plustin_create(t_plustype *tp, t_plusbob *parent, t_symbol *id); +Tcl_Interp *plustin_getinterp(t_plustin *tin); +t_symbol *plustin_glistid(t_glist *gl); +t_plustin *plustin_glistfind(t_glist *gl, int mode); +t_plustin *plustin_glistprovide(t_glist *gl, int mode, int create); +t_symbol *plustin_getglistname(t_plustin *tin); + +t_plustob *plustob_create(t_plustype *tp, t_plustin *tin, Tcl_Obj *ob); +t_plustob *plustob_new(t_plustin *tin, Tcl_Obj *ob); +void plustob_setifshared(t_plustob *tob, t_plusifsharedfn ifsharedfn); +int plustob_isshared(t_plustob *tob); +Tcl_Obj *plustob_getvalue(t_plustob *tob); +t_plustin *plustag_tobtin(t_symbol *s, t_pd *caller); +Tcl_Obj *plustag_tobvalue(t_symbol *s, t_pd *caller); +Tcl_Obj *plusatom_tobvalue(t_atom *ap, t_pd *caller); +Tcl_Obj *plustob_set(t_plustob *tob, t_plustin *tin, Tcl_Obj *ob); +Tcl_Obj *plustob_setfloat(t_plustob *tob, t_float f); +Tcl_Obj *plustob_setsymbol(t_plustob *tob, t_symbol *s); +Tcl_Obj *plustob_setlist(t_plustob *tob, int ac, t_atom *av); +Tcl_Obj *plustob_setbinbuf(t_plustob *tob, t_binbuf *bb); +Tcl_Obj *plustob_grabresult(t_plustob *tob); +Tcl_Obj *plustob_evalob(t_plustob *tob, Tcl_Obj *ob); + +t_plusvar *plusvar_create(t_plustype *tp, t_plustin *tin, Tcl_Obj *ob, + char *name, char *index); +t_plusvar *plusvar_new(char *name, char *index, t_plustin *tin); +Tcl_Obj *plusvar_push(t_plusvar *var); +Tcl_Obj *plusvar_pull(t_plusvar *var); +Tcl_Obj *plusvar_set(t_plusvar *var, Tcl_Obj *ob, int doit); +Tcl_Obj *plusvar_setfloat(t_plusvar *var, t_float f, int doit); +Tcl_Obj *plusvar_setsymbol(t_plusvar *var, t_symbol *s, int doit); +Tcl_Obj *plusvar_setlist(t_plusvar *var, int ac, t_atom *av, int doit); + +void plustot_env_setup(void); +void plustot_in_setup(void); +void plustot_var_setup(void); +void plustot_out_setup(void); +void plustot_qlist_setup(void); +void plustot_print_setup(void); + +void *plustot_env_new(t_symbol *s, int ac, t_atom *av); +void *plustot_in_new(t_symbol *s, int ac, t_atom *av); +void *plustot_var_new(t_symbol *s, int ac, t_atom *av); +void *plustot_out_new(t_symbol *s, int ac, t_atom *av); +void *plustot_qlist_new(t_symbol *s, int ac, t_atom *av); +void *plustot_print_new(t_symbol *s, int ac, t_atom *av); + +#endif diff --git a/toxy/plustot.in.c b/toxy/plustot.in.c new file mode 100644 index 0000000..206b8b0 --- /dev/null +++ b/toxy/plustot.in.c @@ -0,0 +1,126 @@ +/* Copyright (c) 2003 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +#include "m_pd.h" +#include "common/loud.h" +#include "toxy/plusbob.h" +#include "plustot.h" + +typedef struct _plusproxy_in +{ + t_pd pp_pd; + t_plustob *pp_tob; +} t_plusproxy_in; + +typedef struct _plustot_in +{ + t_object x_ob; + t_glist *x_glist; + t_plustob *x_tob; + t_plusproxy_in *x_proxy; +} t_plustot_in; + +static t_class *plusproxy_in_class; +static t_class *plustot_in_class; + +static t_plusproxy_in *plusproxy_in_new(t_pd *master) +{ + t_plusproxy_in *pp = (t_plusproxy_in *)pd_new(plusproxy_in_class); + pp->pp_tob = ((t_plustot_in *)master)->x_tob; + return (pp); +} + +static void plusproxy_in_float(t_plusproxy_in *pp, t_float f) +{ + plustob_setfloat(pp->pp_tob, f); +} + +static void plusproxy_in_symbol(t_plusproxy_in *pp, t_symbol *s) +{ + plustob_setsymbol(pp->pp_tob, s); +} + +static void plusproxy_in_list(t_plusproxy_in *pp, + t_symbol *s, int ac, t_atom *av) +{ + plustob_setlist(pp->pp_tob, ac, av); +} + +static void plustot_in_bang(t_plustot_in *x) +{ + if (plustob_getvalue(x->x_tob)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob); +} + +static void plustot_in_float(t_plustot_in *x, t_float f) +{ + if (plustob_setfloat(x->x_tob, f)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob); +} + +static void plustot_in_symbol(t_plustot_in *x, t_symbol *s) +{ + if (plustob_setsymbol(x->x_tob, s)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob); +} + +static void plustot_in_list(t_plustot_in *x, t_symbol *s, int ac, t_atom *av) +{ + if (plustob_setlist(x->x_tob, ac, av)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob); +} + +static void plustot_in_free(t_plustot_in *x) +{ + plusbob_release((t_plusbob *)x->x_tob); + if (x->x_proxy) pd_free((t_pd *)x->x_proxy); +} + +void *plustot_in_new(t_symbol *s, int ac, t_atom *av) +{ + t_plustot_in *x = 0; + t_glist *glist = canvas_getcurrent(); + t_plustin *tin = 0; + t_plustob *tob = 0; + if ((tin = plustin_glistprovide(glist, PLUSTIN_GLIST_ANY, 0)) && + (tob = plustob_new(tin, 0))) + { + x = (t_plustot_in *)pd_new(plustot_in_class); + plusbob_preserve((t_plusbob *)tob); + plusbob_setowner((t_plusbob *)tob, (t_pd *)x); + plustob_setlist(tob, ac, av); + x->x_glist = glist; + x->x_tob = tob; + x->x_proxy = plusproxy_in_new((t_pd *)x); + inlet_new((t_object *)x, (t_pd *)x->x_proxy, 0, 0); + outlet_new((t_object *)x, &s_symbol); + } + else + { + loud_error(0, "+in: cannot initialize"); + if (tin) + { + plusbob_preserve((t_plusbob *)tin); + plusbob_release((t_plusbob *)tin); + } + } + return (x); +} + +void plustot_in_setup(void) +{ + plustot_in_class = class_new(gensym("+in"), 0, + (t_method)plustot_in_free, + sizeof(t_plustot_in), 0, 0); + class_addbang(plustot_in_class, plustot_in_bang); + class_addfloat(plustot_in_class, plustot_in_float); + class_addsymbol(plustot_in_class, plustot_in_symbol); + class_addlist(plustot_in_class, plustot_in_list); + + plusproxy_in_class = class_new(gensym("+in proxy"), 0, 0, + sizeof(t_plusproxy_in), CLASS_PD, 0); + class_addfloat(plusproxy_in_class, plusproxy_in_float); + class_addsymbol(plusproxy_in_class, plusproxy_in_symbol); + class_addlist(plusproxy_in_class, plusproxy_in_list); +} diff --git a/toxy/plustot.out.c b/toxy/plustot.out.c new file mode 100644 index 0000000..9b70d55 --- /dev/null +++ b/toxy/plustot.out.c @@ -0,0 +1,71 @@ +/* Copyright (c) 2003 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +#include "m_pd.h" +#include "common/loud.h" +#include "toxy/plusbob.h" +#include "plustot.h" + +typedef struct _plustot_out +{ + t_object x_ob; + t_binbuf *x_bb; +} t_plustot_out; + +static t_class *plustot_out_class; + +static void plustot_out_symbol(t_plustot_out *x, t_symbol *s) +{ + Tcl_Obj *ob = plustag_tobvalue(s, (t_pd *)x); + if (ob) + { + int len; + char *ptr; + Tcl_IncrRefCount(ob); + ptr = Tcl_GetStringFromObj(ob, &len); + if (ptr && len) + { + int ac; + binbuf_text(x->x_bb, ptr, len); + if (ac = binbuf_getnatom(x->x_bb)) + { + t_atom *av = binbuf_getvec(x->x_bb); + if (av->a_type == A_SYMBOL) + outlet_anything(((t_object *)x)->ob_outlet, + av->a_w.w_symbol, ac - 1, av + 1); + else if (av->a_type == A_FLOAT) + { + if (ac > 1) + outlet_list(((t_object *)x)->ob_outlet, + &s_list, ac, av); + else + outlet_float(((t_object *)x)->ob_outlet, + av->a_w.w_float); + } + } + } + Tcl_DecrRefCount(ob); + } +} + +static void plustot_out_free(t_plustot_out *x) +{ + binbuf_free(x->x_bb); +} + +void *plustot_out_new(t_symbol *s, int ac, t_atom *av) +{ + t_plustot_out *x = (t_plustot_out *)pd_new(plustot_out_class); + x->x_bb = binbuf_new(); + outlet_new((t_object *)x, &s_anything); + return (x); +} + +void plustot_out_setup(void) +{ + plustot_out_class = class_new(gensym("+out"), 0, + (t_method)plustot_out_free, + sizeof(t_plustot_out), 0, 0); + class_addsymbol(plustot_out_class, plustot_out_symbol); +} diff --git a/toxy/plustot.print.c b/toxy/plustot.print.c new file mode 100644 index 0000000..42ef385 --- /dev/null +++ b/toxy/plustot.print.c @@ -0,0 +1,90 @@ +/* Copyright (c) 2003 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +#include "m_pd.h" +#include "common/loud.h" +#include "toxy/plusbob.h" +#include "plustot.h" + +typedef struct _plustot_print +{ + t_object x_ob; + t_symbol *x_label; + t_binbuf *x_bb; +} t_plustot_print; + +static t_class *plustot_print_class; + +static void plustot_print_symbol(t_plustot_print *x, t_symbol *s) +{ + Tcl_Obj *ob = plustag_tobvalue(s, (t_pd *)x); + if (ob) + { + int len; + char *ptr; + Tcl_IncrRefCount(ob); + ptr = Tcl_GetStringFromObj(ob, &len); + if (ptr && len) + { + int ac; + binbuf_text(x->x_bb, ptr, len); + if (ac = binbuf_getnatom(x->x_bb)) + { + t_plustin *tin = plustag_tobtin(s, (t_pd *)x); + t_symbol *glname = (tin ? plustin_getglistname(tin) : 0); + t_atom *av = binbuf_getvec(x->x_bb); + if (av->a_type == A_SYMBOL || av->a_type == A_FLOAT) + { + char *lstring = + (x->x_label ? x->x_label->s_name : + loud_symbolname(plustag_typename(s, 1, (t_pd *)x), + "???")); + if (glname) + startpost("%s (%s):", lstring, glname->s_name); + else + startpost("%s:", lstring); + } + /* FIXME {1.0, 1.0}, etc. */ + if (av->a_type == A_SYMBOL) + { + startpost(" %s", av->a_w.w_symbol->s_name); + postatom(ac - 1, av + 1); + endpost(); + } + else if (av->a_type == A_FLOAT) + { + if (ac > 1) + { + postatom(ac, av); + endpost(); + } + else post(" %g", av->a_w.w_float); + } + } + /* LATER consider printing empty list as 'bang' */ + } + Tcl_DecrRefCount(ob); + } +} + +static void plustot_print_free(t_plustot_print *x) +{ + binbuf_free(x->x_bb); +} + +void *plustot_print_new(t_symbol *s, int ac, t_atom *av) +{ + t_plustot_print *x = (t_plustot_print *)pd_new(plustot_print_class); + x->x_label = (ac && av->a_type == A_SYMBOL ? av->a_w.w_symbol : 0); + x->x_bb = binbuf_new(); + return (x); +} + +void plustot_print_setup(void) +{ + plustot_print_class = class_new(gensym("+print"), 0, + (t_method)plustot_print_free, + sizeof(t_plustot_print), 0, 0); + class_addsymbol(plustot_print_class, plustot_print_symbol); +} diff --git a/toxy/plustot.qlist.c b/toxy/plustot.qlist.c new file mode 100644 index 0000000..b49aeb1 --- /dev/null +++ b/toxy/plustot.qlist.c @@ -0,0 +1,212 @@ +/* Copyright (c) 2003 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +#include <string.h> +#include "m_pd.h" +#include "unstable/fragile.h" +#include "common/loud.h" +#include "toxy/plusbob.h" +#include "plustot.h" + +#define PLUSTOT_QLIST_DEBUG + +/* Need only an access to x_binbuf field. */ +typedef struct _qlist +{ + t_object x_ob; + t_outlet *x_bangout; + void *x_binbuf; +} t_qlist; + +typedef struct _plusproxy_qlist +{ + t_pd pp_pd; + struct _plustot_qlist *pp_master; +} t_plusproxy_qlist; + +typedef struct _plustot_qlist +{ + t_object x_ob; + t_glist *x_glist; + t_plustob *x_tob; + t_outlet *x_rightout; + t_plusproxy_qlist *x_proxy; +} t_plustot_qlist; + +static t_class *plusproxy_qlist_class; +static t_class *plustot_qlist_class; + +static t_binbuf *plustot_qlist_usurp(t_plustot_qlist *x) +{ + static t_symbol *types[2]; + static int ntypes = 0; + t_object *booty; + if (ntypes == 0) + { + types[0] = gensym("qlist"); + types[1] = gensym("textfile"); + ntypes = 2; + } + if (booty = fragile_outlet_destination( + ((t_object *)x)->ob_outlet, ntypes, types, + (t_pd *)x, "(connect left outlet to a qlist or textfile)")) + { + t_binbuf *bb = ((t_qlist *)booty)->x_binbuf; +#ifdef PLUSTOT_QLIST_DEBUG + post("booty '%s' at %x:", class_getname(*(t_pd *)booty), (int)booty); + binbuf_print(bb); +#endif + return (bb); + } + else return (0); +} + +static t_plusproxy_qlist *plusproxy_qlist_new(t_plustot_qlist *master) +{ + t_plusproxy_qlist *pp = (t_plusproxy_qlist *)pd_new(plusproxy_qlist_class); + pp->pp_master = master; + return (pp); +} + +static void plusproxy_qlist_symbol(t_plusproxy_qlist *pp, t_symbol *s) +{ + t_plustot_qlist *x = pp->pp_master; + Tcl_Interp *interp = 0; + if (plustag_isvalid(s, 0)) + { + t_plustin *tin; + Tcl_Obj *ob; + if ((tin = plustag_tobtin(s, PLUSBOB_OWNER)) && + (ob = plustob_getvalue((t_plustob *)s))) + { + t_binbuf *bb; + if (bb = plustot_qlist_usurp(x)) + { + int nlists; + Tcl_Obj **lists; + interp = plustin_getinterp(tin); + if (Tcl_ListObjGetElements(interp, ob, + &nlists, &lists) == TCL_OK) + { + int lc; + Tcl_Obj **lp; + binbuf_clear(bb); + for (lc = 0, lp = lists; lc < nlists; lc++, lp++) + { + int natoms; + Tcl_Obj **atoms; + if (Tcl_ListObjGetElements(interp, *lp, + &natoms, &atoms) == TCL_OK) + { + int ac; + Tcl_Obj **ap; + for (ac = 0, ap = atoms; ac < natoms; ac++, ap++) + { + double d; + int len; + char *ptr; + Tcl_IncrRefCount(*ap); + if (Tcl_GetDoubleFromObj(interp, + *ap, &d) == TCL_OK) + { + t_atom at; + SETFLOAT(&at, (float)d); + binbuf_add(bb, 1, &at); + } + else if ((ptr = Tcl_GetStringFromObj(*ap, &len)) + && len) + { + t_atom at; + if (ptr[len - 1]) + { + char buf[MAXPDSTRING]; + if (len > MAXPDSTRING - 1) + len = MAXPDSTRING - 1; + strncpy(buf, ptr, len); + buf[len] = 0; + ptr = buf; + } + SETSYMBOL(&at, gensym(ptr)); + binbuf_add(bb, 1, &at); + } + /* FIXME else */ + Tcl_DecrRefCount(*ap); + } + binbuf_addsemi(bb); + } + else + { + binbuf_clear(bb); + goto notalist; + } + } + } + else goto notalist; + } + } + } + return; +notalist: + if (interp) plusloud_tclerror((t_pd *)x, interp, "not a list"); +} + +static void plustot_qlist_bang(t_plustot_qlist *x) +{ + t_binbuf *bb; + if (bb = plustot_qlist_usurp(x)) + { + if (plustob_setbinbuf(x->x_tob, bb)) + outlet_plusbob(x->x_rightout, (t_plusbob *)x->x_tob); + } +} + +static void plustot_qlist_free(t_plustot_qlist *x) +{ + plusbob_release((t_plusbob *)x->x_tob); + if (x->x_proxy) pd_free((t_pd *)x->x_proxy); +} + +void *plustot_qlist_new(t_symbol *s, int ac, t_atom *av) +{ + t_plustot_qlist *x = 0; + t_glist *glist = canvas_getcurrent(); + t_plustin *tin = 0; + t_plustob *tob = 0; + if ((tin = plustin_glistprovide(glist, PLUSTIN_GLIST_ANY, 0)) && + (tob = plustob_new(tin, 0))) + { + x = (t_plustot_qlist *)pd_new(plustot_qlist_class); + plusbob_preserve((t_plusbob *)tob); + plusbob_setowner((t_plusbob *)tob, (t_pd *)x); + plustob_setlist(tob, ac, av); + x->x_glist = glist; + x->x_tob = tob; + x->x_proxy = plusproxy_qlist_new(x); + inlet_new((t_object *)x, (t_pd *)x->x_proxy, 0, 0); + outlet_new((t_object *)x, &s_anything); + x->x_rightout = outlet_new((t_object *)x, &s_symbol); + } + else + { + loud_error(0, "+qlist: cannot initialize"); + if (tin) + { + plusbob_preserve((t_plusbob *)tin); + plusbob_release((t_plusbob *)tin); + } + } + return (x); +} + +void plustot_qlist_setup(void) +{ + plustot_qlist_class = class_new(gensym("+qlist"), 0, + (t_method)plustot_qlist_free, + sizeof(t_plustot_qlist), 0, 0); + class_addbang(plustot_qlist_class, plustot_qlist_bang); + + plusproxy_qlist_class = class_new(gensym("+qlist proxy"), 0, 0, + sizeof(t_plusproxy_qlist), CLASS_PD, 0); + class_addsymbol(plusproxy_qlist_class, plusproxy_qlist_symbol); +} diff --git a/toxy/plustot.var.c b/toxy/plustot.var.c new file mode 100644 index 0000000..a5f36a7 --- /dev/null +++ b/toxy/plustot.var.c @@ -0,0 +1,130 @@ +/* Copyright (c) 2003 krzYszcz and others. + * For information on usage and redistribution, and for a DISCLAIMER OF ALL + * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ + +#include "m_pd.h" +#include "common/loud.h" +#include "toxy/plusbob.h" +#include "plustot.h" + +typedef struct _plusproxy_var +{ + t_pd pp_pd; + t_plusvar *pp_var; +} t_plusproxy_var; + +typedef struct _plustot_var +{ + t_object x_ob; + t_glist *x_glist; + t_plusvar *x_var; + t_plusproxy_var *x_proxy; +} t_plustot_var; + +static t_class *plusproxy_var_class; +static t_class *plustot_var_class; + +static t_plusproxy_var *plusproxy_var_new(t_pd *master) +{ + t_plusproxy_var *pp = (t_plusproxy_var *)pd_new(plusproxy_var_class); + pp->pp_var = ((t_plustot_var *)master)->x_var; + return (pp); +} + +static void plusproxy_var_float(t_plusproxy_var *pp, t_float f) +{ + plusvar_setfloat(pp->pp_var, f, 1); +} + +static void plusproxy_var_symbol(t_plusproxy_var *pp, t_symbol *s) +{ + plusvar_setsymbol(pp->pp_var, s, 1); +} + +static void plusproxy_var_list(t_plusproxy_var *pp, + t_symbol *s, int ac, t_atom *av) +{ + plusvar_setlist(pp->pp_var, ac, av, 1); +} + +static void plustot_var_bang(t_plustot_var *x) +{ + if (plusvar_pull(x->x_var)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_var); +} + +static void plustot_var_float(t_plustot_var *x, t_float f) +{ + if (plusvar_setfloat(x->x_var, f, 1)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_var); +} + +static void plustot_var_symbol(t_plustot_var *x, t_symbol *s) +{ + if (plusvar_setsymbol(x->x_var, s, 1)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_var); +} + +static void plustot_var_list(t_plustot_var *x, t_symbol *s, int ac, t_atom *av) +{ + if (plusvar_setlist(x->x_var, ac, av, 1)) + outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_var); +} + +static void plustot_var_free(t_plustot_var *x) +{ + plusbob_release((t_plusbob *)x->x_var); + if (x->x_proxy) pd_free((t_pd *)x->x_proxy); +} + +void *plustot_var_new(t_symbol *s, int ac, t_atom *av) +{ + t_plustot_var *x = 0; + t_glist *glist = canvas_getcurrent(); + t_plustin *tin = 0; + t_plusvar *var = 0; + if (ac && av->a_type == A_SYMBOL && + (tin = plustin_glistprovide(glist, PLUSTIN_GLIST_ANY, 0)) && + (var = plusvar_new(av->a_w.w_symbol->s_name, 0, tin))) + { + x = (t_plustot_var *)pd_new(plustot_var_class); + plusbob_preserve((t_plusbob *)var); + plusbob_setowner((t_plusbob *)var, (t_pd *)x); + plusvar_setlist(var, ac - 1, av + 1, 1); + x->x_glist = glist; + x->x_var = var; + x->x_proxy = plusproxy_var_new((t_pd *)x); + inlet_new((t_object *)x, (t_pd *)x->x_proxy, 0, 0); + outlet_new((t_object *)x, &s_symbol); + } + else + { + if (!ac || av->a_type != A_SYMBOL) + loud_error(0, "+var: missing name of a variable"); + else + loud_error(0, "+var: cannot initialize"); + if (tin) + { + plusbob_preserve((t_plusbob *)tin); + plusbob_release((t_plusbob *)tin); + } + } + return (x); +} + +void plustot_var_setup(void) +{ + plustot_var_class = class_new(gensym("+var"), 0, + (t_method)plustot_var_free, + sizeof(t_plustot_var), 0, 0); + class_addbang(plustot_var_class, plustot_var_bang); + class_addfloat(plustot_var_class, plustot_var_float); + class_addsymbol(plustot_var_class, plustot_var_symbol); + class_addlist(plustot_var_class, plustot_var_list); + + plusproxy_var_class = class_new(gensym("+var proxy"), 0, 0, + sizeof(t_plusproxy_var), CLASS_PD, 0); + class_addfloat(plusproxy_var_class, plusproxy_var_float); + class_addsymbol(plusproxy_var_class, plusproxy_var_symbol); + class_addlist(plusproxy_var_class, plusproxy_var_list); +} @@ -456,11 +456,11 @@ static void *tot_new(t_symbol *s1, t_symbol *s2) char buf[64]; sprintf(buf, "tot%x", (int)x); pd_bind((t_pd *)x, x->x_target = gensym(buf)); - x->x_transient = - scriptlet_new((t_pd *)x, x->x_target, x->x_target, 0, tot_cvhook); - x->x_persistent = - scriptlet_new((t_pd *)x, x->x_target, x->x_target, 0, tot_cvhook); x->x_glist = canvas_getcurrent(); + x->x_transient = scriptlet_new((t_pd *)x, x->x_target, x->x_target, + 0, x->x_glist, tot_cvhook); + x->x_persistent = scriptlet_new((t_pd *)x, x->x_target, x->x_target, + 0, x->x_glist, tot_cvhook); if (s1 && s1 != &s_ && strcmp(s1->s_name, ".")) { x->x_cvremote = canvas_makebindsym(x->x_cvname = s1); diff --git a/toxy/toxy-shared.include b/toxy/toxy-shared.include index e831217..ec6c42c 100644 --- a/toxy/toxy-shared.include +++ b/toxy/toxy-shared.include @@ -9,6 +9,8 @@ shared/hammer/file.c shared/hammer/file.h shared/hammer/gui.c shared/hammer/gui.h +shared/unstable/fragile.c +shared/unstable/fragile.h shared/unstable/forky.c shared/unstable/forky.h shared/unstable/loader.c @@ -16,5 +18,7 @@ shared/unstable/loader.h shared/unstable/pd_imp.h shared/common/props.c shared/common/props.h +shared/toxy/plusbob.c +shared/toxy/plusbob.h shared/toxy/scriptlet.c shared/toxy/scriptlet.h diff --git a/toxy/widget.c b/toxy/widget.c index 253b649..a7a983a 100644 --- a/toxy/widget.c +++ b/toxy/widget.c @@ -23,7 +23,7 @@ static t_class *makeshift_class; //#define WIDGET_DEBUG //#define TOW_DEBUG -enum { WIDGET_NOUPDATE = 0, WIDGET_RECONFIG, WIDGET_REVIS }; +enum { WIDGET_NOVIS = 0, WIDGET_PUSHVIS, WIDGET_REVIS }; typedef struct _towentry { @@ -62,9 +62,9 @@ typedef struct _widget int x_height; t_symbol *x_background; int x_hasstate; - int x_update; /* see widget_update() */ - int x_selected; int x_disabled; + int x_selected; + int x_update; /* see widget_update() */ int x_vised; t_clock *x_transclock; t_towentry *x_towlist; @@ -95,10 +95,12 @@ static t_symbol *widgetps_motion; static t_symbol *widgetps_atbang; static t_symbol *widgetps_atfloat; static t_symbol *widgetps_atsymbol; +static t_symbol *widgetps_atstore; +static t_symbol *widgetps_atrestore; -static char *widget_propsresolver(t_pd *z, int ac, t_atom *av) +static char *widget_propsresolver(t_pd *owner, int ac, t_atom *av) { - t_widget *x = (t_widget *)z; + t_widget *x = (t_widget *)owner; int len; scriptlet_reset(x->x_auxscript); if (scriptlet_add(x->x_auxscript, 1, 0, ac, av)) @@ -107,9 +109,9 @@ static char *widget_propsresolver(t_pd *z, int ac, t_atom *av) return (0); } -static t_canvas *widget_cvhook(t_pd *z) +static t_canvas *widget_cvhook(t_pd *caller) { - return (glist_getcanvas(((t_widget *)z)->x_glist)); + return (glist_getcanvas(((t_widget *)caller)->x_glist)); } /* LATER move to scriptlet.c, use the scriptlet interface (.^) */ @@ -165,14 +167,14 @@ static void widget_transedit(t_widget *x) { t_text *newt, *oldt = (t_text *)x; t_binbuf *bb = binbuf_new(); - int nopt, nbnd, narg; + int nopt, nhnd, narg; t_atom *opt = props_getall(x->x_options, &nopt); - t_atom *bnd = props_getall(x->x_handlers, &nbnd); + t_atom *hnd = props_getall(x->x_handlers, &nhnd); t_atom *arg = props_getall(x->x_arguments, &narg); binbuf_addv(bb, "sss", gensym("widget"), x->x_type, x->x_name); if (narg) binbuf_add(bb, narg, arg); if (nopt) binbuf_add(bb, nopt, opt); - if (nbnd) binbuf_add(bb, nbnd, bnd); + if (nhnd) binbuf_add(bb, nhnd, hnd); canvas_setcurrent(x->x_glist); newt = (t_text *)pd_new(makeshift_class); newt->te_width = 0; @@ -211,6 +213,10 @@ static void widget_displace(t_gobj *z, t_glist *glist, int dx, int dy) { t_widget *x = (t_widget *)z; t_text *t = (t_text *)z; +#if 0 + post("displace %d %d (%d %d -> %d %d)", + dx, dy, t->te_xpix, t->te_ypix, t->te_xpix + dx, t->te_ypix + dy); +#endif t->te_xpix += dx; t->te_ypix += dy; if (glist_isvisible(glist)) @@ -219,11 +225,11 @@ static void widget_displace(t_gobj *z, t_glist *glist, int dx, int dy) canvas_fixlinesfor(glist_getcanvas(glist), t); } -static void widget_select(t_gobj *z, t_glist *glist, int state) +static void widget_select(t_gobj *z, t_glist *glist, int flag) { t_widget *x = (t_widget *)z; char *mypathname = widget_getmypathname(x, glist)->s_name; - if (state) + if (flag) { sys_vgui("%s config -bg blue %s\n", mypathname, (x->x_hasstate ? "-state disabled" : "")); @@ -235,7 +241,7 @@ static void widget_select(t_gobj *z, t_glist *glist, int state) sys_vgui("%s config -bg %s\n", mypathname, (x->x_background ? x->x_background->s_name : "gray")); else - sys_vgui("%s config -bg %s\n", mypathname, + sys_vgui("%s config -bg %s %s\n", mypathname, (x->x_background ? x->x_background->s_name : "gray"), (x->x_hasstate ? "-state normal" : "")); x->x_selected = 0; @@ -290,13 +296,20 @@ static void widget_pushinits(t_widget *x) bug("widget_pushinits (instance)"); } +static void widget_getconfig(t_widget *x) +{ + sys_vgui("::toxy::itemgetconfig %s %s\n", + widget_getmypathname(x, x->x_glist)->s_name, + x->x_cbtarget->s_name); +} + static void widget_vis(t_gobj *z, t_glist *glist, int vis) { t_widget *x = (t_widget *)z; t_text *t = (t_text *)z; char *cvpathname = widget_getcvpathname(x, glist)->s_name; char *mypathname = widget_getmypathname(x, glist)->s_name; - x->x_update = WIDGET_NOUPDATE; + x->x_update = WIDGET_NOVIS; if (vis) { float px1 = text_xpix((t_text *)x, glist); @@ -318,11 +331,7 @@ static void widget_vis(t_gobj *z, t_glist *glist, int vis) t_rtext *rt = glist_findrtext(glist, t); if (rt) rtext_free(rt); #endif - if (x->x_vised) - { - sys_vgui("destroy %s\n", mypathname); - x->x_vised = 0; - } + x->x_vised = 0; } } @@ -330,16 +339,16 @@ static void widget_save(t_gobj *z, t_binbuf *bb) { t_widget *x = (t_widget *)z; t_text *t = (t_text *)x; - int nopt, nbnd, narg; + int nopt, nhnd, narg; t_atom *opt = props_getall(x->x_options, &nopt); - t_atom *bnd = props_getall(x->x_handlers, &nbnd); + t_atom *hnd = props_getall(x->x_handlers, &nhnd); t_atom *arg = props_getall(x->x_arguments, &narg); binbuf_addv(bb, "ssiisss", gensym("#X"), gensym("obj"), (int)t->te_xpix, (int)t->te_ypix, gensym("widget"), x->x_type, x->x_name); if (narg) binbuf_add(bb, narg, arg); if (nopt) binbuf_add(bb, nopt, opt); - if (nbnd) binbuf_add(bb, nbnd, bnd); + if (nhnd) binbuf_add(bb, nhnd, hnd); binbuf_addsemi(bb); } @@ -405,27 +414,37 @@ static t_widgetbehavior widget_behavior = FORKY_WIDGETPADDING }; -static void widget_update(t_widget *x) +static void widget_update(t_widget *x, t_props *op) { - t_atom *ap; - int ac; - scriptlet_reset(x->x_optscript); - ap = props_getall(widgettype_getoptions(x->x_typedef), &ac); - if (ac) scriptlet_add(x->x_optscript, 0, 0, ac, ap); - ap = props_getall(x->x_options, &ac); - if (ac) scriptlet_add(x->x_optscript, 0, 0, ac, ap); - if (x->x_update && - glist_isvisible(x->x_glist)) /* FIXME the condition */ + if (op == x->x_options) { - if (x->x_update == WIDGET_REVIS) + t_atom *ap; + int ac; + scriptlet_reset(x->x_optscript); + ap = props_getall(widgettype_getoptions(x->x_typedef), &ac); + if (ac) scriptlet_add(x->x_optscript, 0, 0, ac, ap); + ap = props_getall(x->x_options, &ac); + if (ac) scriptlet_add(x->x_optscript, 0, 0, ac, ap); + if (x->x_update && + glist_isvisible(x->x_glist)) /* FIXME the condition */ { - widget_vis((t_gobj *)x, x->x_glist, 0); - widget_vis((t_gobj *)x, x->x_glist, 1); + if (x->x_update == WIDGET_REVIS) + { + widget_vis((t_gobj *)x, x->x_glist, 0); + widget_vis((t_gobj *)x, x->x_glist, 1); + } + else if (x->x_update == WIDGET_PUSHVIS) + { + widget_pushoptions(x, 1); + widget_getconfig(x); + } + x->x_update = WIDGET_NOVIS; } - else widget_pushoptions(x, 1); - x->x_update = WIDGET_NOUPDATE; } - /* LATER cache handlers */ + else + { + /* LATER cache handlers */ + } } static t_symbol *widget_addprops(t_widget *x, t_props *op, int single, @@ -438,7 +457,7 @@ static t_symbol *widget_addprops(t_widget *x, t_props *op, int single, if (empty) loud_error((t_pd *)x, "no value given for %s '%s'", props_getname(op), empty->s_name); - widget_update(x); + widget_update(x, op); return (empty); } else @@ -464,7 +483,7 @@ static void widget_anything(t_widget *x, t_symbol *s, int ac, t_atom *av) if (*s->s_name == '-' || *s->s_name == '@' || *s->s_name == '#') { t_symbol *empty; - x->x_update = WIDGET_RECONFIG; + x->x_update = WIDGET_PUSHVIS; if (empty = widget_addmessage(x, s, ac, av)) loud_errand((t_pd *)x, "(use 'remove %s' if that is what you want).", @@ -558,16 +577,32 @@ static void widget_symbol(t_widget *x, t_symbol *s) } } +static void widget_store(t_widget *x, t_symbol *s) +{ + if (s == &s_) + s = x->x_varname; + /* FIXME */ +} + +static void widget_restore(t_widget *x, t_symbol *s) +{ + if (s == &s_) + s = x->x_varname; + /* FIXME */ +} + static void widget_set(t_widget *x, t_symbol *s, int ac, t_atom *av) { t_symbol *prp; if (ac && av->a_type == A_SYMBOL && (prp = av->a_w.w_symbol)) { t_symbol *empty = 0; - x->x_update = WIDGET_RECONFIG; ac--; av++; if (*prp->s_name == '-') + { + x->x_update = WIDGET_PUSHVIS; empty = widget_addprops(x, x->x_options, 1, prp, ac, av); + } else if (*prp->s_name == '@') empty = widget_addprops(x, x->x_handlers, 1, prp, ac, av); else if (*prp->s_name == '#') @@ -595,8 +630,8 @@ static void widget_remove(t_widget *x, t_symbol *s) op = 0; if (op && props_remove(op, s)) { - x->x_update = WIDGET_REVIS; - widget_update(x); + if (op == x->x_options) x->x_update = WIDGET_REVIS; + widget_update(x, op); } else loud_warning((t_pd *)x, "%s %s has not been specified", props_getname(op), s->s_name); @@ -625,7 +660,9 @@ static void widget_tot(t_widget *x, t_symbol *s, int ac, t_atom *av) static void widget_refresh(t_widget *x) { x->x_update = WIDGET_REVIS; - widget_update(x); + widget_update(x, x->x_options); + widget_update(x, x->x_handlers); + widget_update(x, x->x_arguments); } static void widget__failure(t_widget *x, t_symbol *s, int ac, t_atom *av) @@ -682,13 +719,13 @@ static void widget__callback(t_widget *x, t_symbol *s, int ac, t_atom *av) else outlet_bang(((t_object *)x)->ob_outlet); } -/* FIXME this is a hack (see also widget_select) */ -/* FIXME why <Leave> is being issued on button press? */ +/* see also widget_select() */ static void widget__inout(t_widget *x, t_floatarg f) { + int disable = (int)f && x->x_glist->gl_edit; if (x->x_disabled) { - if (!x->x_glist->gl_edit) + if (!disable) { if (!x->x_selected) { @@ -699,54 +736,54 @@ static void widget__inout(t_widget *x, t_floatarg f) x->x_disabled = 0; } } - else if ((int)f && x->x_glist->gl_edit) + else if (disable) { - char *mypathname = widget_getmypathname(x, x->x_glist)->s_name; - if (x->x_hasstate) - sys_vgui("%s config -state disabled\n", mypathname); + if (!x->x_selected) + { + char *mypathname = widget_getmypathname(x, x->x_glist)->s_name; + if (x->x_hasstate) + sys_vgui("%s config -state disabled\n", mypathname); + } x->x_disabled = 1; } } -static void widget__click(t_widget *x, t_floatarg fx, t_floatarg fy, - t_floatarg fb, t_floatarg fm) +static void widget__click(t_widget *x, t_symbol *s, int ac, t_atom *av) { + if (ac != 4) + { + loud_error((t_pd *)x, "bad arguments to the '%s' method", s->s_name); + return; + } if (x->x_glist->gl_havewindow) /* LATER calculate on-parent coords */ { - t_text *t = (t_text *)x; - t_atom at[4]; - fx += t->te_xpix; - fy += t->te_ypix; - SETFLOAT(&at[0], fx); - SETFLOAT(&at[1], fy); - SETFLOAT(&at[2], fb); - SETFLOAT(&at[3], fm); if (x->x_cvtarget->s_thing) /* LATER rethink */ - typedmess(x->x_cvtarget->s_thing, widgetps_mouse, 4, at); + typedmess(x->x_cvtarget->s_thing, widgetps_mouse, ac, av); else - typedmess((t_pd *)x->x_glist, widgetps_mouse, 4, at); - widget__inout(x, 1.); + typedmess((t_pd *)x->x_glist, widgetps_mouse, ac, av); + widget__inout(x, 2.); } } /* LATER think how to grab the mouse when dragging */ -static void widget__motion(t_widget *x, t_floatarg fx, t_floatarg fy) +static void widget__motion(t_widget *x, t_symbol *s, int ac, t_atom *av) { + if (ac != 3) + { + loud_error((t_pd *)x, "bad arguments to the '%s' method", s->s_name); + return; + } if (x->x_glist->gl_havewindow) /* LATER calculate on-parent coords */ { - t_text *t = (t_text *)x; - t_atom at[3]; - fx += t->te_xpix; - fy += t->te_ypix; - SETFLOAT(&at[0], fx); - SETFLOAT(&at[1], fy); - SETFLOAT(&at[2], 0); +#if 0 + post("motion %g %g", av[0].a_w.w_float, av[1].a_w.w_float); +#endif if (x->x_cvtarget->s_thing) /* LATER rethink */ - typedmess(x->x_cvtarget->s_thing, widgetps_motion, 3, at); + typedmess(x->x_cvtarget->s_thing, widgetps_motion, ac, av); else - typedmess((t_pd *)x->x_glist, widgetps_motion, 3, at); + typedmess((t_pd *)x->x_glist, widgetps_motion, ac, av); } } @@ -799,6 +836,8 @@ static void widget_debug(t_widget *x) post("type initializer (size %d):\n\"%s\"", sz, bp); bp = scriptlet_getcontents(x->x_iniscript, &sz); post("instance initializer (size %d):\n\"%s\"", sz, bp); + bp = masterwidget_getcontents(&sz); + post("setup definitions (size %d):\n\"%s\"", sz, bp); } #endif @@ -815,6 +854,8 @@ static void gui_unbind(t_pd *x, t_symbol *s) static void widget_free(t_widget *x) { + sys_vgui("::toxy::itemdestroy %s %s\n", + widget_getmypathname(x, x->x_glist)->s_name, x->x_varname->s_name); gui_unbind((t_pd *)x, x->x_cbtarget); gui_unbind((t_pd *)x, x->x_rptarget); props_freeall(x->x_options); @@ -862,28 +903,28 @@ static void *widget_new(t_symbol *s, int ac, t_atom *av) if (!(x->x_tkclass = widgettype_tkclass(x->x_typedef))) x->x_tkclass = x->x_type; + x->x_glist = canvas_getcurrent(); + sprintf(buf, ".x%x.c", (int)x->x_glist); + x->x_cvpathname = gensym(buf); + sprintf(buf, ".x%x", (int)x->x_glist); + x->x_cvtarget = gensym(buf); + sprintf(buf, "::toxy::v%x", (int)x); + x->x_varname = gensym(buf); + x->x_iniscript = scriptlet_new((t_pd *)x, x->x_rptarget, x->x_cbtarget, - x->x_name, widget_cvhook); + x->x_name, x->x_glist, widget_cvhook); x->x_optscript = scriptlet_new((t_pd *)x, x->x_rptarget, x->x_cbtarget, - x->x_name, widget_cvhook); + x->x_name, x->x_glist, widget_cvhook); x->x_auxscript = scriptlet_new((t_pd *)x, x->x_rptarget, x->x_cbtarget, - x->x_name, widget_cvhook); + x->x_name, x->x_glist, widget_cvhook); x->x_transient = scriptlet_new((t_pd *)x, x->x_rptarget, x->x_cbtarget, - x->x_name, widget_cvhook); + x->x_name, x->x_glist, widget_cvhook); x->x_options = props_new((t_pd *)x, "option", "-", 0, 0); x->x_handlers = props_new((t_pd *)x, "handler", "@", x->x_options, 0); x->x_arguments = props_new((t_pd *)x, "argument", "#", x->x_options, widget_propsresolver); - sprintf(buf, ".^.c.%s%x", x->x_name->s_name, (int)x); - x->x_glist = canvas_getcurrent(); - sprintf(buf, ".x%x.c", (int)x->x_glist); - x->x_cvpathname = gensym(buf); - sprintf(buf, ".x%x", (int)x->x_glist); - x->x_cvtarget = gensym(buf); - sprintf(buf, "::toxy::v%x", (int)x); - x->x_varname = gensym(buf); outlet_new((t_object *)x, &s_anything); /* LATER consider estimating these, based on widget class and options */ x->x_width = 50; @@ -894,7 +935,7 @@ static void *widget_new(t_symbol *s, int ac, t_atom *av) x->x_transclock = clock_new(x, (t_method)widget_transtick); x->x_background = 0; x->x_hasstate = 0; - x->x_update = WIDGET_NOUPDATE; + x->x_update = WIDGET_NOVIS; x->x_disabled = 0; x->x_vised = 0; widget_attach(x); @@ -1153,6 +1194,8 @@ void widget_setup(void) widgetps_atbang = gensym("@bang"); widgetps_atfloat = gensym("@float"); widgetps_atsymbol = gensym("@symbol"); + widgetps_atstore = gensym("@store"); + widgetps_atrestore = gensym("@restore"); widgettype_setup(); widget_class = class_new(gensym("widget"), (t_newmethod)widget_new, @@ -1165,6 +1208,10 @@ void widget_setup(void) class_addfloat(widget_class, widget_float); class_addsymbol(widget_class, widget_symbol); class_addanything(widget_class, widget_anything); + class_addmethod(widget_class, (t_method)widget_store, + gensym("store"), A_DEFSYMBOL, 0); + class_addmethod(widget_class, (t_method)widget_restore, + gensym("restore"), A_DEFSYMBOL, 0); class_addmethod(widget_class, (t_method)widget_set, gensym("set"), A_GIMME, 0); class_addmethod(widget_class, (t_method)widget_remove, @@ -1187,9 +1234,9 @@ void widget_setup(void) class_addmethod(widget_class, (t_method)widget__inout, gensym("_inout"), A_FLOAT, 0); class_addmethod(widget_class, (t_method)widget__click, - gensym("_click"), A_FLOAT, A_FLOAT, A_FLOAT, A_FLOAT, 0); + gensym("_click"), A_GIMME, 0); class_addmethod(widget_class, (t_method)widget__motion, - gensym("_motion"), A_FLOAT, A_FLOAT, 0); + gensym("_motion"), A_GIMME, 0); #ifdef WIDGET_DEBUG class_addmethod(widget_class, (t_method)widget_debug, gensym("debug"), 0); diff --git a/toxy/widgettype.c b/toxy/widgettype.c index 5a5684f..3e04824 100644 --- a/toxy/widgettype.c +++ b/toxy/widgettype.c @@ -11,6 +11,10 @@ #include "toxy/scriptlet.h" #include "widgettype.h" +static char masterwidget_builtin[] = +#include "default.wiq" +; + #define WIDGETTYPE_VERBOSE //#define WIDGETTYPE_DEBUG @@ -42,7 +46,7 @@ static t_class *masterwidget_class; static t_masterwidget *masterwidget = 0; -static t_canvas *widgettype_cvhook(t_pd *z) +static t_canvas *widgettype_cvhook(t_pd *caller) { return (0); } @@ -63,22 +67,22 @@ static t_widgettype *widgettype_new(t_masterwidget *mw, wt->wt_handlers = props_new(0, "handler", "@", wt->wt_options, 0); wt->wt_arguments = props_new(0, "argument", "#", wt->wt_options, 0); wt->wt_iniscript = scriptlet_new((t_pd *)wt, mw->mw_target, mw->mw_target, - 0, widgettype_cvhook); + 0, 0, widgettype_cvhook); dict_bind(mw->mw_typemap, (t_pd *)wt, wt->wt_typekey); return (wt); } -static t_canvas *masterwidget_cvhook(t_pd *z) +static t_canvas *masterwidget_cvhook(t_pd *caller) { return (0); } -static t_scriptlet *masterwidget_cmnthook(t_pd *z, char *rc, +static t_scriptlet *masterwidget_cmnthook(t_pd *caller, char *rc, char sel, char *buf) { t_masterwidget *mw = masterwidget; if (!*buf) - return (0); + return (SCRIPTLET_UNLOCK); if (sel == '>') { t_symbol *typekey; @@ -90,23 +94,31 @@ static t_scriptlet *masterwidget_cmnthook(t_pd *z, char *rc, cls = buf; typekey = dict_key(mw->mw_typemap, buf); typeval = (t_widgettype *)dict_value(mw->mw_typemap, typekey); - if (z == (t_pd *)mw) - { /* default.wid */ - if (typeval) + if (caller == (t_pd *)mw) + { /* default.wid or built-in defaults */ + if (mw->mw_defaulttype) + { /* no default type in default.wid, extracting built-in one */ + if (typeval != mw->mw_defaulttype) + return (SCRIPTLET_LOCK); + } + else { - /* LATER rethink */ - loud_warning((t_pd *)mw, "redefinition of '%s'\ + if (typeval) + { + /* LATER rethink */ + loud_warning((t_pd *)mw, "redefinition of '%s'\ in \"%s.wid\" file, ignored", buf, rc); - return (0); + return (SCRIPTLET_LOCK); + } } } else { /* <type>.wid */ - if (z != (t_pd *)typeval) + if (caller != (t_pd *)typeval) { loud_warning((t_pd *)mw, "alien definition of '%s'\ in \"%s.wid\" file, ignored", buf, rc); - return (0); + return (SCRIPTLET_LOCK); } } if (pkg) @@ -150,7 +162,7 @@ static t_scriptlet *masterwidget_cmnthook(t_pd *z, char *rc, } } } - return (0); + return (SCRIPTLET_UNLOCK); } t_widgettype *widgettype_get(t_symbol *s) @@ -170,13 +182,31 @@ t_widgettype *widgettype_get(t_symbol *s) } if (masterwidget->mw_parsedtype) { - if (scriptlet_rcload(wt->wt_iniscript, s->s_name, ".wid", - masterwidget_cmnthook) == SCRIPTLET_OK) + t_scriptlet *mwsp = + scriptlet_new((t_pd *)masterwidget, masterwidget->mw_target, + masterwidget->mw_target, 0, 0, 0); + if (scriptlet_rcload(mwsp, (t_pd *)wt, + s->s_name, ".wid", 0, masterwidget_cmnthook) + == SCRIPTLET_OK) { #ifdef WIDGETTYPE_VERBOSE post("using %s's initializer", s->s_name); #endif + if (!scriptlet_isempty(mwsp)) + { + t_scriptlet *sp = + scriptlet_new((t_pd *)masterwidget, masterwidget->mw_target, + masterwidget->mw_target, 0, 0, 0); + if (scriptlet_evaluate(mwsp, sp, 0, 0, 0, 0)) + { + scriptlet_push(sp); + scriptlet_append(masterwidget->mw_setupscript, mwsp); + } + else bug("widgettype_get"); + scriptlet_free(sp); + } } + scriptlet_free(mwsp); } return (wt); } @@ -218,13 +248,6 @@ int widgettype_evaluate(t_widgettype *wt, t_scriptlet *outsp, visedonly, ac, av, argprops)); } -int masterwidget_evaluate(t_scriptlet *outsp, int visedonly, - int ac, t_atom *av, t_props *argprops) -{ - return (scriptlet_evaluate(masterwidget->mw_defaulttype->wt_iniscript, - outsp, visedonly, ac, av, argprops)); -} - void widgettype_setup(void) { static int done = 0; @@ -238,9 +261,21 @@ void widgettype_setup(void) } } +int masterwidget_evaluate(t_scriptlet *outsp, int visedonly, + int ac, t_atom *av, t_props *argprops) +{ + return (scriptlet_evaluate(masterwidget->mw_defaulttype->wt_iniscript, + outsp, visedonly, ac, av, argprops)); +} + +char *masterwidget_getcontents(int *szp) +{ + return (scriptlet_getcontents(masterwidget->mw_setupscript, szp)); +} + void masterwidget_initialize(void) { - t_scriptlet *sp; + int rcresult; t_symbol *typekey; t_widgettype *typeval; char buf[MAXPDSTRING]; @@ -253,14 +288,17 @@ void masterwidget_initialize(void) masterwidget->mw_typemap = dict_new(0); - sp = masterwidget->mw_setupscript = + masterwidget->mw_setupscript = scriptlet_new((t_pd *)masterwidget, masterwidget->mw_target, - masterwidget->mw_target, 0, 0); - masterwidget->mw_parsedtype = 0; + masterwidget->mw_target, 0, 0, 0); masterwidget->mw_bb = binbuf_new(); + masterwidget->mw_parsedtype = 0; + masterwidget->mw_defaulttype = 0; - if (scriptlet_rcload(sp, "default", ".wid", - masterwidget_cmnthook) == SCRIPTLET_OK) + rcresult = + scriptlet_rcload(masterwidget->mw_setupscript, 0, "default", ".wid", + masterwidget_builtin, masterwidget_cmnthook); + if (rcresult == SCRIPTLET_OK) { #ifdef WIDGETTYPE_VERBOSE post("using file 'default.wid'"); @@ -268,33 +306,42 @@ void masterwidget_initialize(void) } else { - loud_warning((t_pd *)masterwidget, "missing file 'default.wid'"); - - /* no setup scriptlet, LATER use built-in default */ -#if 0 - scriptlet_reset(sp); - scriptlet_addstring(sp, ... -#endif + loud_warning((t_pd *)masterwidget, + "no file 'default.wid'... using built-in defaults"); } typekey = dict_key(masterwidget->mw_typemap, "default"); - if (typeval = (t_widgettype *)dict_value(masterwidget->mw_typemap, typekey)) + if ((typeval = (t_widgettype *)dict_value(masterwidget->mw_typemap, typekey)) + && !scriptlet_isempty(masterwidget->mw_setupscript)) + { masterwidget->mw_defaulttype = typeval; - else + rcresult = SCRIPTLET_OK; + } + else if (rcresult == SCRIPTLET_OK) { - /* no master initializer, LATER use built-in default */ + /* LATER think about adding only missing part to existing local defs */ + loud_warning((t_pd *)masterwidget, "%s missing in file 'default.wid'", + (typeval ? "setup definitions" : "master initializer")); masterwidget->mw_defaulttype = widgettype_new(masterwidget, "default", 0, 0); - sp = masterwidget->mw_defaulttype->wt_iniscript; -#if 0 - scriptlet_reset(sp); - scriptlet_addstring(sp, ... -#endif + scriptlet_reset(masterwidget->mw_setupscript); + rcresult = + scriptlet_rcparse(masterwidget->mw_setupscript, 0, "default", + masterwidget_builtin, masterwidget_cmnthook); } - sp = scriptlet_new((t_pd *)masterwidget, - masterwidget->mw_target, masterwidget->mw_target, 0, 0); - if (scriptlet_evaluate(masterwidget->mw_setupscript, sp, 0, 0, 0, 0)) - scriptlet_push(sp); else - bug("masterwidget_initialize"); - scriptlet_free(sp); + { + bug("masterwidget_initialize 1"); + rcresult = SCRIPTLET_BADFILE; + } + if (rcresult == SCRIPTLET_OK) + { + t_scriptlet *sp = + scriptlet_new((t_pd *)masterwidget, masterwidget->mw_target, + masterwidget->mw_target, 0, 0, 0); + if (scriptlet_evaluate(masterwidget->mw_setupscript, sp, 0, 0, 0, 0)) + scriptlet_push(sp); + else + bug("masterwidget_initialize 2"); + scriptlet_free(sp); + } } diff --git a/toxy/widgettype.h b/toxy/widgettype.h index 55c8e9d..d0df8c6 100644 --- a/toxy/widgettype.h +++ b/toxy/widgettype.h @@ -21,10 +21,11 @@ char *widgettype_propname(t_symbol *s); char *widgettype_getcontents(t_widgettype *wt, int *szp); int widgettype_evaluate(t_widgettype *wt, t_scriptlet *outsp, int visedonly, int ac, t_atom *av, t_props *argprops); +void widgettype_setup(void); + +char *masterwidget_getcontents(int *szp); int masterwidget_evaluate(t_scriptlet *outsp, int visedonly, int ac, t_atom *av, t_props *argprops); void masterwidget_initialize(void); -void widgettype_setup(void); - #endif |