cyclone alpha55 (see notes.txt for cyclone and shared)

svn path=/trunk/externals/miXed/; revision=4011

4 files changed, 192 insertions, 4 deletions

diff --git a/toxy/Makefile.objects b/toxy/Makefile.objects
index b0300f0..3a947af 100644
--- a/toxy/Makefile.objects
+++ b/toxy/Makefile.objects
@@ -20,6 +20,7 @@ toxy/scriptlet.o \
 toxy/plusbob.o
 
 PLUSTOT_PRIVATEOBJECTS = \
+plustot.ar.o \
 plustot.env.o \
 plustot.in.o \
 plustot.var.o \
diff --git a/toxy/plustot.ar.c b/toxy/plustot.ar.c
new file mode 100644
index 0000000..adca72c
--- /dev/null
+++ b/toxy/plustot.ar.c
@@ -0,0 +1,128 @@
+/* Copyright (c) 2003-2005 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_ar
+{
+    t_pd        pp_pd;
+    t_plustob  *pp_tob;
+} t_plusproxy_ar;
+
+typedef struct _plustot_ar
+{
+    t_plusobject     x_plusobject;
+    t_glist         *x_glist;
+    t_plustob       *x_tob;
+    t_plusproxy_ar  *x_proxy;
+} t_plustot_ar;
+
+static t_class *plusproxy_ar_class;
+static t_class *plustot_ar_class;
+
+static t_plusproxy_ar *plusproxy_ar_new(t_pd *master)
+{
+    t_plusproxy_ar *pp = (t_plusproxy_ar *)pd_new(plusproxy_ar_class);
+    pp->pp_tob = ((t_plustot_ar *)master)->x_tob;
+    return (pp);
+}
+
+static void plusproxy_ar_float(t_plusproxy_ar *pp, t_float f)
+{
+    plustob_setfloat(pp->pp_tob, f);
+}
+
+static void plusproxy_ar_symbol(t_plusproxy_ar *pp, t_symbol *s)
+{
+    plustob_setsymbol(pp->pp_tob, s);
+}
+
+static void plusproxy_ar_list(t_plusproxy_ar *pp,
+			      t_symbol *s, int ac, t_atom *av)
+{
+    plustob_setlist(pp->pp_tob, ac, av);
+}
+
+static void plustot_ar_bang(t_plustot_ar *x)
+{
+    if (plustob_getvalue(x->x_tob))
+	outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob);
+}
+
+static void plustot_ar_float(t_plustot_ar *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_ar_symbol(t_plustot_ar *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_ar_list(t_plustot_ar *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_ar_free(t_plustot_ar *x)
+{
+    plusbob_release((t_plusbob *)x->x_tob);
+    if (x->x_proxy) pd_free((t_pd *)x->x_proxy);
+    plusobject_free(&x->x_plusobject);
+}
+
+void *plustot_ar_new(t_symbol *s, int ac, t_atom *av)
+{
+    t_plustot_ar *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_ar *)plusobject_new(plustot_ar_class, s, ac, av, 0);
+	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_ar_new((t_pd *)x);
+	plusinlet_new(&x->x_plusobject, (t_pd *)x->x_proxy, 0, 0);
+	plusoutlet_new(&x->x_plusobject, &s_symbol);
+    }
+    else
+    {
+	loud_error(0, "+ar: cannot initialize");
+	if (tin)
+	{
+	    plusbob_preserve((t_plusbob *)tin);
+	    plusbob_release((t_plusbob *)tin);
+	}
+    }
+    return (x);
+}
+
+void plustot_ar_setup(void)
+{
+    plustot_ar_class = class_new(gensym("+ar"), 0,
+				 (t_method)plustot_ar_free,
+				 sizeof(t_plustot_ar), 0, 0);
+    plusclass_inherit(plustot_ar_class, gensym("+ar"));
+    class_addbang(plustot_ar_class, plustot_ar_bang);
+    class_addfloat(plustot_ar_class, plustot_ar_float);
+    class_addsymbol(plustot_ar_class, plustot_ar_symbol);
+    class_addlist(plustot_ar_class, plustot_ar_list);
+
+    plusproxy_ar_class = class_new(gensym("+ar proxy"), 0, 0,
+				   sizeof(t_plusproxy_ar), CLASS_PD, 0);
+    class_addfloat(plusproxy_ar_class, plusproxy_ar_float);
+    class_addsymbol(plusproxy_ar_class, plusproxy_ar_symbol);
+    class_addlist(plusproxy_ar_class, plusproxy_ar_list);
+}
diff --git a/toxy/plustot.c b/toxy/plustot.c
index 865b39c..cb3917b 100644
--- a/toxy/plustot.c
+++ b/toxy/plustot.c
@@ -34,6 +34,7 @@
 #   define PLUSDEBUG_DECRREFCOUNT(ob, fn)  Tcl_DecrRefCount(ob)
 #endif
 
+static t_symbol *plusps_ar;
 static t_symbol *plusps_env;
 static t_symbol *plusps_in;
 static t_symbol *plusps_var;
@@ -52,6 +53,7 @@ static void plussymbols_create(void)
     plusps_Tv = gensym("+Tv");
 
     /* private */
+    plusps_ar = gensym("+ar");
     plusps_env = gensym("+env");
     plusps_in = gensym("+in");
     plusps_var = gensym("+var");
@@ -101,9 +103,10 @@ void plusloud_tclerror(t_pd *caller, Tcl_Interp *interp, char *msg)
 
 struct _plustin
 {
-    t_plusenv    tin_env;
-    t_glist     *tin_glist;
-    Tcl_Interp  *tin_interp;
+    t_plusenv     tin_env;
+    t_glist      *tin_glist;
+    Tcl_Interp   *tin_interp;
+    Tcl_CmdInfo  *tin_cinfop;
 };
 
 static t_plustype *plustin_basetype;
@@ -144,11 +147,18 @@ t_plustin *plustin_create(t_plustype *tp, t_plusbob *parent, t_symbol *id)
 		     (id ? id->s_name : "default"), (int)interp);
 #endif
 	tin->tin_interp = interp;
+	tin->tin_cinfop = 0;
 	Tcl_Preserve(interp);
 	if (Tcl_Init(interp) == TCL_ERROR)
 	    plusloud_tclerror(0, interp, "interpreter initialization failed");
 	else
 	{
+	    Tcl_CmdInfo cinfo;
+	    /* store Tcl_CmdInfo for off-API Tcl_InfoObjCmd() */
+	    if (Tcl_GetCommandInfo(interp, "info", &cinfo)
+		&& cinfo.isNativeObjectProc)
+		tin->tin_cinfop = copybytes(&cinfo, sizeof(*tin->tin_cinfop));
+	    /* create custom commands */
 	    Tcl_CreateObjCommand(interp, "test::test",
 				 (Tcl_ObjCmdProc*)plustin_testCmd,
 				 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
@@ -168,6 +178,8 @@ static void plustin_delete(t_plustin *tin)
     loudbug_post("plustin_delete '%s' over %x",
 		 (id ? id->s_name : "default"), (int)tin->tin_interp);
 #endif
+    if (tin->tin_cinfop)
+	freebytes(tin->tin_cinfop, sizeof(*tin->tin_cinfop));
     Tcl_Preserve(tin->tin_interp);
     if (!Tcl_InterpDeleted(tin->tin_interp))
 	Tcl_DeleteInterp(tin->tin_interp);
@@ -179,6 +191,44 @@ Tcl_Interp *plustin_getinterp(t_plustin *tin)
     return (tin->tin_interp);
 }
 
+int plustin_procargc(t_plustin *tin, char *pname)
+{
+    int result = -1;
+    if (tin->tin_cinfop)
+    {
+	/* FIXME preallocate */
+	Tcl_Obj *argv[3];
+	argv[0] = Tcl_NewStringObj("info", -1);
+	PLUSDEBUG_INCRREFCOUNT(argv[0], "plustin_procargc");
+	argv[1] = Tcl_NewStringObj("args", -1);
+	PLUSDEBUG_INCRREFCOUNT(argv[0], "plustin_procargc");
+	argv[2] = Tcl_NewStringObj(pname, -1);
+	PLUSDEBUG_INCRREFCOUNT(argv[1], "plustin_procargc");
+	if ((*tin->tin_cinfop->objProc)(tin->tin_cinfop->objClientData,
+					tin->tin_interp,
+					3, argv) == TCL_OK)
+	{
+	    Tcl_Obj *rob;
+	    if (rob = Tcl_GetObjResult(tin->tin_interp))
+	    {
+		PLUSDEBUG_INCRREFCOUNT(rob, "plustin_procargc");
+		if (Tcl_ListObjLength(tin->tin_interp, rob, &result) != TCL_OK)
+		{
+		    result = -1;
+		    plusloud_tcldirty(0, "plustin_procargc");
+		}
+		Tcl_ResetResult(tin->tin_interp);
+		PLUSDEBUG_DECRREFCOUNT(rob, "plustin_procargc");
+	    }
+	    else plusloud_tcldirty(0, "plustin_procargc");
+	}
+	PLUSDEBUG_DECRREFCOUNT(argv[0], "plustin_procargc");
+	PLUSDEBUG_DECRREFCOUNT(argv[1], "plustin_procargc");
+	PLUSDEBUG_DECRREFCOUNT(argv[2], "plustin_procargc");
+    }
+    return (result);
+}
+
 t_symbol *plustin_glistid(t_glist *gl)
 {
     char buf[32];
@@ -2089,7 +2139,9 @@ static void *plustot_new(t_symbol *s, int ac, t_atom *av)
     {
 	if (*cmdname->s_name == '+')
 	{
-	    if (cmdname == plusps_env)
+	    if (cmdname == plusps_ar)
+		return (plustot_ar_new(cmdname, ac, av));
+	    else if (cmdname == plusps_env)
 		return (plustot_env_new(cmdname, ac, av));
 	    else if (cmdname == plusps_in)
 		return (plustot_in_new(cmdname, ac, av));
@@ -2180,6 +2232,10 @@ static void *plustot_new(t_symbol *s, int ac, t_atom *av)
 			    res = plustot_makewords(x);
 			if (res)
 			{
+			    /* FIXME [+tot +ar pname] */
+			    int n = plustin_procargc(tin, cmdname->s_name);
+			    loudbug_post("plustin_procargc: %d", n);
+
 			    /* creation time evaluation, LATER rethink:
 			       should this be immediate or scheduled? */
 			    x->x_isloud = 0;
@@ -2325,6 +2381,7 @@ void plustot_setup(void)
     plusvar_type = plustype_new(plustob_type, plusps_Tv,
 				sizeof(t_plusvar),
 				(t_plustypefn)plusvar_delete, 0, 0, 0);
+    plustot_ar_setup();
     plustot_env_setup();
     plustot_in_setup();
     plustot_var_setup();
diff --git a/toxy/plustot.h b/toxy/plustot.h
index 0cc6fa6..7022fd6 100644
--- a/toxy/plustot.h
+++ b/toxy/plustot.h
@@ -101,6 +101,7 @@ t_inlet *plusinlet_new(t_plusobject *po, t_pd *dest,
 t_outlet *plusoutlet_new(t_plusobject *po, t_symbol *s);
 void plusclass_inherit(t_class *c, t_symbol *s);
 
+void plustot_ar_setup(void);
 void plustot_env_setup(void);
 void plustot_in_setup(void);
 void plustot_var_setup(void);
@@ -108,6 +109,7 @@ void plustot_out_setup(void);
 void plustot_qlist_setup(void);
 void plustot_print_setup(void);
 
+void *plustot_ar_new(t_symbol *s, int ac, t_atom *av);
 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);