From 5379dfb8d1f5e55bd2770a37527404a7d1d34658 Mon Sep 17 00:00:00 2001
From: Guillem <guillembartrina@gmail.com>
Date: Fri, 3 Jul 2020 17:36:18 +0200
Subject: [PATCH] pd vanilla fwd intlet~ argument port

comment the line that defines an extra inlet for the 'inlet~' object

show error message in the case its a inlet(~) object but argument 'fwd' is not specified. Third approach

fix for case fwd message is not properly built, pd could crash

add zcheckgetfn method. given a selector and a list of param types, checks if the object has that method and if the params coincide

switch to mess3 method for calling fwd callback and add proper argument verification,  pack conditions to call inlet_fwd inside it, selector 'fwd' can be sent again through inlet objects

create wrappers of symbol and blob for inlet_fwd

create wrappers of pointer for inlet_fwd
---
 pd/src/g_clone.c | 13 ++++++++++++-
 pd/src/g_io.c    | 25 ++++++++++++++++++++++---
 pd/src/m_class.c | 34 ++++++++++++++++++++++++++++++++++
 pd/src/m_obj.c   | 46 ++++++++++++++++++++++++++++++++++++++++------
 4 files changed, 108 insertions(+), 10 deletions(-)

diff --git a/pd/src/g_clone.c b/pd/src/g_clone.c
index ade8cddd5..89f0fa5b1 100644
--- a/pd/src/g_clone.c
+++ b/pd/src/g_clone.c
@@ -143,6 +143,14 @@ static void clone_in_vis(t_in *x, t_floatarg fn, t_floatarg vis)
     canvas_vis(x->i_owner->x_vec[n].c_gl, (vis != 0));
 }
 
+static void clone_in_fwd(t_in *x, t_symbol *s, int argc, t_atom *argv)
+{
+    if(s != gensym("fwd"))
+        typedmess(&x->i_pd, s, argc, argv);
+    else
+        pd_error(x->i_owner, "clone-inlet: no method for 'fwd'");
+}
+
 static void clone_out_anything(t_out *x, t_symbol *s, int argc, t_atom *argv)
 {
     t_atom *outv;
@@ -405,7 +413,8 @@ static void *clone_new(t_symbol *s, int argc, t_atom *argv)
             obj_issignalinlet(&x->x_vec[0].c_gl->gl_obj, i);
         x->x_invec[i].i_n = i;
         if (x->x_invec[i].i_signal)
-            signalinlet_new(&x->x_obj, 0);
+            inlet_new(&x->x_obj, &x->x_invec[i].i_pd,
+                &s_signal, &s_signal);
         else inlet_new(&x->x_obj, &x->x_invec[i].i_pd, 0, 0);
     }
     x->x_nout = obj_noutlets(&x->x_vec[0].c_gl->gl_obj);
@@ -458,6 +467,8 @@ void clone_setup(void)
         A_GIMME, 0);
     class_addmethod(clone_in_class, (t_method)clone_in_vis, gensym("vis"),
         A_FLOAT, A_FLOAT, 0);
+    class_addmethod(clone_in_class, (t_method)clone_in_fwd, gensym("fwd"),
+        A_GIMME, 0);
     class_addlist(clone_in_class, (t_method)clone_in_list);
 
     clone_out_class = class_new(gensym("clone-outlet"), 0, 0,
diff --git a/pd/src/g_io.c b/pd/src/g_io.c
index c7330bf63..eee1af66c 100644
--- a/pd/src/g_io.c
+++ b/pd/src/g_io.c
@@ -36,8 +36,8 @@ typedef struct _vinlet
   /* if not reblocking, the next slot communicates the parent's inlet
      signal from the prolog to the DSP routine: */
     t_signal *x_directsignal;
-
-  t_resample x_updown;
+    t_resample x_updown;
+    t_outlet *x_fwdout;  /* optional outlet for forwarding messages to inlet~ */
 } t_vinlet;
 
 static void *vinlet_new(t_symbol *s)
@@ -116,6 +116,19 @@ t_int *vinlet_perform(t_int *w)
     return (w+4);
 }
 
+static void vinlet_fwd(t_vinlet *x, t_symbol *s, int argc, t_atom *argv)
+{
+    if(x->x_fwdout) /* inlet~ fwd */
+        outlet_anything(x->x_fwdout, s, argc, argv);
+    else if(x->x_buf == 0) /* inlet, need to forward message because we want
+                                it to accept fwd selector */
+        outlet_anything(x->x_obj.ob_outlet, s, argc, argv);
+    else /* inlet~ without fwd */
+        pd_error(x->x_canvas, "inlet~: expected 'signal' but got '%s' "
+            "(Note: [inlet~] does not forward non-signal messages unless "
+            "argument 'fwd' is defined)", s->s_name);
+}
+
 static void vinlet_dsp(t_vinlet *x, t_signal **sp)
 {
     t_signal *outsig;
@@ -251,8 +264,10 @@ static void *vinlet_newsig(t_symbol *s)
     x->x_endbuf = x->x_buf = (t_float *)getbytes(0);
     x->x_bufsize = 0;
     x->x_directsignal = 0;
+    x->x_fwdout = 0;
     outlet_new(&x->x_obj, &s_signal);
-
+    /* this line was in pd vanilla but I don't think it is necessary
+       inlet_new(&x->x_obj, (t_pd *)x->x_inlet, 0, 0); */
     resample_init(&x->x_updown);
 
     /* this should be thought over: 
@@ -265,6 +280,8 @@ static void *vinlet_newsig(t_symbol *s)
     else if (s == gensym("lin"))x->x_updown.method=2; /* up: linear interpolation */
     else x->x_updown.method=0;                        /* up: zero-padding */
 
+    if (s == gensym("fwd"))         /* turn on forwarding */
+        x->x_fwdout = outlet_new(&x->x_obj, 0);
     return (x);
 }
 
@@ -279,6 +296,8 @@ static void vinlet_setup(void)
     class_addsymbol(vinlet_class, vinlet_symbol);
     class_addlist(vinlet_class, vinlet_list);
     class_addanything(vinlet_class, vinlet_anything);
+    class_addmethod(vinlet_class,(t_method)vinlet_fwd,  gensym("fwd"),
+        A_GIMME, 0);
     class_addmethod(vinlet_class, (t_method)vinlet_dsp, gensym("dsp"),
         A_CANT, 0);
     class_sethelpsymbol(vinlet_class, gensym("pd"));
diff --git a/pd/src/m_class.c b/pd/src/m_class.c
index a9d296369..e0122c39f 100644
--- a/pd/src/m_class.c
+++ b/pd/src/m_class.c
@@ -1077,3 +1077,37 @@ t_gotfn zgetfn(t_pd *x, t_symbol *s)
         if (m->me_name == s) return(m->me_fun);
     return(0);
 }
+
+t_gotfn zcheckgetfn(t_pd *x, t_symbol *s, t_atomtype arg1, ...)
+{
+    t_class *c = *x;
+    t_methodentry *m;
+    int i, j;
+
+    /* get arg types */
+    va_list ap;
+    int nargs = 0;
+    t_atomtype args[MAXPDARG+1], curr = arg1;
+    va_start(ap, arg1);
+    while (curr != A_NULL && nargs < MAXPDARG)
+    {
+        args[nargs++] = curr;
+        curr = va_arg(ap, t_atomtype);
+    }
+    if (curr != A_NULL) error("zcheckgetfn: only 5 arguments are typecheckable");
+    args[nargs] = A_NULL;
+    va_end(ap);
+
+    for (i = c->c_nmethod, m = c->c_methods; i--; m++)
+    {
+        if (m->me_name == s)
+        {
+            j = 0;
+            /* both argtype lists are valid, dont need to check whether j < MAXDPARG */
+            while(m->me_arg[j] != A_NULL && args[j] != A_NULL
+                    && m->me_arg[j] == args[j]) j++;
+            if(m->me_arg[j] == A_NULL && args[j] == A_NULL) return(m->me_fun);
+        }
+    }
+    return(0);
+}
diff --git a/pd/src/m_obj.c b/pd/src/m_obj.c
index ea1dd5dd2..725ecf425 100644
--- a/pd/src/m_obj.c
+++ b/pd/src/m_obj.c
@@ -80,6 +80,36 @@ static void inlet_wrong(t_inlet *x, t_symbol *s, int argc, t_atom *argv)
         x->i_symfrom->s_name, s->s_name, type_hint(s, argc, argv, 1));
 }
 
+    /* forward a message to an inlet~ object */
+static int inlet_fwd(t_inlet *x, t_symbol *s, int argc, t_atom *argv)
+{
+    if(x->i_symfrom == &s_signal
+        && zcheckgetfn(x->i_dest, gensym("fwd"), A_GIMME, A_NULL))
+    {
+        mess3(x->i_dest, gensym("fwd"), s, argc, argv);
+        return 1;
+    }
+    return 0;
+}
+
+static int inlet_fwd_symbol(t_inlet *x, t_symbol *s)
+{
+    t_atom sym; SETSYMBOL(&sym, s);
+    return inlet_fwd(x, &s_symbol, 1, &sym);
+}
+
+static int inlet_fwd_blob(t_inlet *x, t_blob *st)
+{
+    t_atom blob; SETBLOB(&blob, st);
+    return inlet_fwd(x, &s_blob, 1, &blob);
+}
+
+static int inlet_fwd_pointer(t_inlet *x, t_gpointer *gp)
+{
+    t_atom ptr; SETPOINTER(&ptr, gp);
+    return inlet_fwd(x, &s_pointer, 1, &ptr);
+}
+
 static void inlet_list(t_inlet *x, t_symbol *s, int argc, t_atom *argv);
 
     /* LATER figure out how to make these efficient: */
@@ -90,7 +120,8 @@ static void inlet_bang(t_inlet *x)
     else if (!x->i_symfrom) pd_bang(x->i_dest);
     else if (x->i_symfrom == &s_list)
         inlet_list(x, &s_bang, 0, 0);
-    else inlet_wrong(x, &s_bang, 0, 0);
+    else if (!inlet_fwd(x, &s_bang, 0, 0))
+        inlet_wrong(x, &s_bang, 0, 0);
 }
 
 static void inlet_pointer(t_inlet *x, t_gpointer *gp)
@@ -104,7 +135,8 @@ static void inlet_pointer(t_inlet *x, t_gpointer *gp)
         SETPOINTER(&a, gp);
         inlet_list(x, &s_pointer, 1, &a);
     }
-    else inlet_wrong(x, &s_pointer, 0, 0);
+    else if (!inlet_fwd_pointer(x, gp))
+        inlet_wrong(x, &s_pointer, 0, 0);
 }
 
 static void inlet_float(t_inlet *x, t_float f)
@@ -129,7 +161,7 @@ static void inlet_symbol(t_inlet *x, t_symbol *s)
     if (x->i_symfrom == &s_symbol) 
         pd_vmess(x->i_dest, x->i_symto, "s", s);
     else if (!x->i_symfrom) pd_symbol(x->i_dest, s);
-    else
+    else if (!inlet_fwd_symbol(x, s))
     {
         t_atom a;
         SETSYMBOL(&a, s);
@@ -153,7 +185,7 @@ static void inlet_blob(t_inlet *x, t_blob *st) /* MP20061226 blob type */
         /*post("inlet_blob calling pd_blob");*/
         pd_blob(x->i_dest, st);
     }
-    else
+    else if (!inlet_fwd_blob(x, st))
     {
         /*post("inlet_blob calling inlet_wrong");*/
         inlet_wrong(x, &s_blob, 0, 0);
@@ -172,7 +204,8 @@ static void inlet_list(t_inlet *x, t_symbol *s, int argc, t_atom *argv)
       inlet_float(x, atom_getfloat(argv));
     else if (argc==1 && argv->a_type == A_SYMBOL)
       inlet_symbol(x, atom_getsymbol(argv));
-    else inlet_wrong(x, &s_list, 0, 0);
+    else if (!inlet_fwd(x, &s_list, argc, argv))
+        inlet_wrong(x, &s_list, 0, 0);
 }
 
 static void inlet_anything(t_inlet *x, t_symbol *s, int argc, t_atom *argv)
@@ -181,7 +214,8 @@ static void inlet_anything(t_inlet *x, t_symbol *s, int argc, t_atom *argv)
         typedmess(x->i_dest, x->i_symto, argc, argv);
     else if (!x->i_symfrom)
         typedmess(x->i_dest, s, argc, argv);
-    else inlet_wrong(x, s, 0, 0);
+    else if (!inlet_fwd(x, s, argc, argv))
+        inlet_wrong(x, s, 0, 0);
 }
 
 void inlet_free(t_inlet *x)
-- 
GitLab