Gimp/plug-ins/script-fu/libscriptfu/scheme-marshal.c
Jehan f92f7d425c plug-ins: new named argument syntax in Script-Fu.
This syntax is now the official syntax for non-core PDB procedures.

I.e. that while core procedures will still use ordered arguments (e.g.:
`(gimp-image-get-layers 1)`), plug-in PDB procedures called from
Script-Fu will have named arguments in any order.

Say for instance that you want to call python-fu-foggify from Script-Fu.
Whereas we used to run:

> (python-fu-foggify RUN-NONINTERACTIVE 1 (car (gimp-image-get-layers 1)) "Clouds" '(50 4 4) 1.0 50.0)

Now we should call:

> (python-fu-foggify #:image 1 #:drawables (car (gimp-image-get-layers 1)) #:opacity 50.0 #:color '(50 4 4))

Now we can note:

* Every argument is preceded by a #:label which is the argument name.
  This makes these calls much more readable (some plug-in procedures can
  have dozen of arguments and these end up as list of integers, floats
  and strings, which are hard to read and hard to debug) and semantic.
* Order doesn't matter anymore. For instance here, I put #:opacity
  before #:color.
* As a direct consequence, we can drop any argument which we wish to
  keep with default value. E.g. in the old style, we had to put the
  #:run-mode, #:name ("Clouds") and #:turbulence (1.0) because we were
  changing the last argument #:opacity (50.0). Now we can drop all 3
  default arguments.

Having non-ordered argument is in fact the starter of this feature,
because it is already the case for calling PDB procedures in the libgimp
API (and therefore in all GIR bindings). By saying that the order of PDB
procedures is not part of the API, we actually allow to add arguments
and even to reorder them in the future without breaking existing scripts
in the 3.0 series.

This became even more serious when I was considering to make the generic
metadata arguments public. Since they are appended to the end, after all
plug-in-specific arguments, if I do this, adding any argument in an
export plug-in would break order. It won't matter anymore!

Note that it doesn't matter for core PDB procedures (where this syntax
is not used) because these are also C functions and therefore order and
number of arguments matter anyway. Also these don't have dozens of
arguments.

As a helper for Script-Fu developer, in particular as we already
released 2 RCs and therefore some people already started to port their
scripts, the old syntax will still work yet will produce a warning
showing how to call the same thing with the new syntax. For instance,
with the above first call, the warning will be:

> (script-fu:2059912): scriptfu-WARNING **: 22:54:47.507: Calling Plug-In PDB procedures with arguments as an ordered list is deprecated.
> Please use named arguments: (python-fu-foggify #:run-mode 1 #:image 1 #:drawables (2) #:name "Clouds" #:color '(50 4 4) #:turbulence 1.000000 #:opacity 50.000000)

Note that the argument name syntax is coming from the Racket scheme
variant: https://docs.racket-lang.org/arguments/index.html

Common Lisp has a similar syntax, either with just a colon, or also a
sharp + colon (it's unclear to me the difference, something about
interned vs. uninterned symbols).
After discussion with Liam on IRC, we decided to go with the #: syntax
of Racket.
2025-01-20 00:01:23 +01:00

487 lines
15 KiB
C

/* GIMP - The GNU Image Manipulation Program
* Copyright (C) 1995 Spencer Kimball and Peter Mattis
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 3 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <https://www.gnu.org/licenses/>.
*/
#include "config.h"
#include "libgimp/gimp.h"
#include "tinyscheme/scheme-private.h"
#include "scheme-marshal.h"
#include "script-fu-errors.h"
/* When include scheme-private.h, must undef cons macro */
#undef cons
static pointer get_item_from_ID_in_script (scheme *sc,
pointer a,
gint id,
GObject **object_handle);
/*
* Marshal arguments to, and return values from, calls to PDB.
* Convert Scheme constructs to/from a GValue.
*
* For each marshalling function:
* - a returned "pointer" is a scheme pointer to a foreign error or NULL.
* - marshal into a GValue holding a designated type,
* usually a GIMP type but also GLib types, e.g. GFile.
* The GValue's held type is already set, but value is uninitialized.
*
* When marshalling into a GimpObjectArray:
* Setting a GValue's value does not check the contained type.
* But validation of a GimpObjectArray does check the contained type.
* We call gimp_item_get_by_id
* GIMP_TYPE_ITEM is a superclass of most common uses.
* And then set the actual subclass type on the GimpObjectArray.
*/
/* Marshal single object ID from script into a single GObject.
*
* Requires ID's of instances of GimpItem, not for image, display, etc. also having ID.
* The GValue may hold a more specific type, e.g. GimpDrawable.
*/
pointer
marshal_ID_to_item (scheme *sc,
pointer a,
gint id,
GValue *value)
{
GObject *object;
pointer error = get_item_from_ID_in_script (sc, a, id, &object);
if (error)
return error;
/* object is NULL or valid */
/* Shallow copy, adding a reference while the GValue exists. */
g_value_set_object (value, object);
return NULL; /* no error */
}
/* Marshal a vector of ID into GimpObjectArray of same length.
* Requires ID's of instances of GimpItem
*/
pointer
marshal_vector_to_item_array (scheme *sc,
pointer vector,
GValue *value,
gchar **strvalue)
{
GObject **object_array;
GString *v = NULL;
gint id;
pointer error;
guint num_elements = sc->vptr->vector_length (vector);
g_debug ("vector has %d elements", num_elements);
/* empty vector will produce empty GimpObjectArray */
object_array = g_new0 (GObject *, num_elements + 1);
if (strvalue)
v = g_string_new ("");
for (int j = 0; j < num_elements; ++j)
{
pointer element = sc->vptr->vector_elem (vector, j);
if (!sc->vptr->is_number (element))
{
g_free (object_array);
if (v)
g_string_free (v, TRUE);
return script_error (sc, "Expected numeric in vector of ID", vector);
/* FUTURE more detailed error msg:
* return script_type_error_in_container (sc, "numeric", i, j, proc_name, vector);
*/
}
id = sc->vptr->ivalue (element);
error = get_item_from_ID_in_script (sc, element, id, &object_array[j]);
if (error)
{
g_free (object_array);
if (v)
g_string_free (v, TRUE);
return error;
}
if (v)
g_string_append_printf (v, "%s%d", j == 0 ? "" : " ", id);
}
/* Shallow copy.
* This sets the contained type on the array.
* If the array is empty, contained type is GIMP_TYPE_ITEM.
* !!! Seems like validation checks the contained type of empty arrays,
* and fails if we default to G_TYPE_INVALID but passes if ITEM.
*/
g_value_set_boxed (value, (gpointer) object_array);
if (v)
{
*strvalue = g_strdup_printf ("(%s)", v->str);
g_string_free (v, TRUE);
}
g_free (object_array);
return NULL; /* no error */
}
/* Marshal path string from script into a GValue holding type GFile */
void
marshal_path_string_to_gfile (scheme *sc,
pointer a,
GValue *value)
{
/* require sc->vptr->is_string (sc->vptr->pair_car (a)) */
GFile *gfile = g_file_new_for_path (sc->vptr->string_value (sc->vptr->pair_car (a)));
/* GLib docs say that g_file_new_for_path():
* "never fails, but the returned object might not support any I/O operation if path is malformed."
*/
g_value_set_object (value, gfile);
g_debug ("gfile arg is '%s'\n", g_file_get_parse_name (gfile));
}
/* Marshal values returned from PDB call in a GValue, into a Scheme construct to a script. */
/* Marshal a GValue holding a GFile into a string.
*
* Returns NULL or a string that must be freed.
*/
gchar *
marshal_returned_gfile_to_string (GValue *value)
{
gchar * filepath = NULL;
GObject *object = g_value_get_object (value);
/* object can be NULL, the GValue's type only indicates what should have been returned. */
if (object)
{
filepath = g_file_get_parse_name ((GFile *) object);
/* GLib docs:
* For local files with names that can safely be converted to UTF-8 the pathname is used,
* otherwise the IRI is used (a form of URI that allows UTF-8 characters unescaped).
*/
}
return filepath;
}
/* Marshal a GimpObjectArray into a Scheme list of ID's.
*
* Before v3.0, PDB procedure's return type was say INT32ARRAY,
* preceded by a type INT32 designating array length.
* Now return type is GimpObjectArray preceded by length.
*
* Returns a vector, since most arrays in Scriptfu are returned as vectors.
* An alternate implementation would be return list.
*
* Existing scheme plugins usually expect PDB to return values: len, vector.
* If ever the PDB is changed to be more object-oriented,
* scripts could use a scheme call: (vector-length vector)
* to get the length of the vector.
*/
pointer
marshal_returned_object_array_to_vector (scheme *sc,
GValue *value)
{
GObject **object_array;
gint32 n;
pointer vector;
object_array = g_value_get_boxed (value);
n = gimp_core_object_array_get_length (object_array);
vector = sc->vptr->mk_vector (sc, n);
/* Iterate starting at the back of the array, and prefix to container
* so the order of objects is not changed.
*/
for (int j = n - 1; j >= 0; j--)
{
GObject *object = object_array[j];
gint id;
if (object)
g_object_get (object, "id", &id, NULL); /* get property "id" */
else
/* Scriptfu language represents NULL object by ID of -1*/
id = -1;
sc->vptr->set_vector_elem (vector, j, sc->vptr->mk_integer (sc, id));
/* Alt: list = sc->vptr->cons (sc, sc->vptr->mk_integer (sc, id), list); */
}
/* ensure container's len equals object array's len and all elements are ID's or -1 */
return vector;
}
/* From a script numeric (a object ID) set a handle to a object.
* When ID is -1, sets handle to NULL and returns no error.
* When ID is valid, sets handle and returns no error.
* Otherwise (ID is not -1 and not valid ID of a object) returns error.
*
* Require ID is of a GIMP object, some subclass of GimpItem.
*/
static pointer
get_item_from_ID_in_script (scheme *sc,
pointer a,
gint id,
GObject **object_handle)
{
if (id == -1)
{
/* -1 is scriptfu language for NULL i.e. none for an optional */
*object_handle = NULL;
}
else
{
*object_handle = (GObject *) gimp_item_get_by_id (id);
if (! *object_handle)
return script_error (sc, "Invalid ID of GIMP item", a);
}
/* ensure *object_handle is NULL or a valid reference to a object */
return NULL; /* no error */
}
/* Walk a Scheme list of numerics, clamping into a C array of bytes.
* Expects one to four numerics.
* Returns length of list, in range [0,4]
* Length zero denotes an error: not a numeric, or list is empty.
* A list longer than expected (>4) is not an error, but extra list is not used.
*/
static void
marshal_list_of_numeric_to_rgba (scheme *sc,
pointer color_list,
guchar (*rgba)[4], /* OUT */
guint *length, /* OUT */
gchar **strvalue)
{
GString *v = NULL;
*length = 0;
if (strvalue)
v = g_string_new ("");
for (guint i=0; i<4; i++)
{
if (sc->vptr->is_number (sc->vptr->pair_car (color_list)))
{
(*rgba)[i] = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
0, 255);
*length = *length + 1;
color_list = sc->vptr->pair_cdr (color_list);
if (v)
g_string_append_printf (v, "%s%d", i == 0 ? "" : " ", (*rgba)[i]);
}
else
{
/* Reached end of list or non-numeric. */
if (v)
{
if (*length != 0)
*strvalue = g_strdup_printf ("'(%s)", v->str);
g_string_free (v, TRUE);
}
return;
}
}
/* *length is in [0,4] and *rgba is filled in with same count. */
if (v)
{
*strvalue = g_strdup_printf ("'(%s)", v->str);
g_string_free (v, TRUE);
}
}
/* Walk a C array of bytes (rgba) creating Scheme list of numeric.
* Returns list whose length is in range [0,4].
* The list is memory managed by scheme.
*/
static pointer
marshal_rgba_to_list_of_numeric (scheme *sc,
guchar rgba[4],
guint length)
{
pointer result_list = sc->NIL;
/* Walk rgba in reverse. */
for (gint i=length-1; i>=0; i--)
{
/* Prepend to list, returning new list. */
result_list = sc->vptr->cons (sc,
sc->vptr->mk_integer (sc, rgba[i]),
result_list);
}
/* list is numerics from rgba and length (list) == length. */
return result_list;
}
/* Returns a GeglColor from a scheme list.
* Caller owns the returned GeglColor.
* Returns NULL on failure:
* - list wrong length, not >1
* - list elements not numbers.
*/
GeglColor *
marshal_component_list_to_color (scheme *sc,
pointer color_list,
gchar **strvalue)
{
GeglColor *color_result;
guchar rgba[4];
guint list_length;
marshal_list_of_numeric_to_rgba (sc, color_list, &rgba, &list_length, strvalue);
/* list_length is the count of numerics used. */
/* Dispatch on list length and create different format colors */
if (list_length == 3 || list_length == 4)
{
/* RGBA */
if (list_length == 3)
{
/* gegl has no three byte rgb. * ScriptFu sets alpha to 1.0 */
rgba[3] = 255;
}
/* Assert rgba is full */
color_result = gegl_color_new ("black");
gegl_color_set_rgba_with_space (color_result,
(gdouble) rgba[0] / 255.0,
(gdouble) rgba[1] / 255.0,
(gdouble) rgba[2] / 255.0,
(gdouble) rgba[3] / 255.0,
NULL); /* NULL defaults to sRGB */
}
else if (list_length == 1)
{
/* GRAY */
GBytes *bytes = g_bytes_new (rgba, 1);
color_result = gegl_color_new ("black");
gegl_color_set_bytes (color_result, babl_format ("Y' u8"), bytes);
g_free (bytes);
}
else if (list_length == 2)
{
/* GRAYA */
GBytes *bytes = g_bytes_new (rgba, 2);
color_result = gegl_color_new ("black");
gegl_color_set_bytes (color_result, babl_format ("Y'A u8"), bytes);
g_free (bytes);
}
else
{
color_result = NULL;
}
return color_result;
}
/* Returns a Scheme list of integers or empty list,
* the same length as the count of components in the color.
* List is length:
* 1 GRAY
* 2 GRAYA
* 3 RGB
* 4 RGBA
* Returns NIL when color is NULL.
*/
pointer
marshal_color_to_component_list (scheme *sc,
GeglColor *color)
{
pointer result;
guint count_components;
guchar rgba[4] = { 0 };
if (color == NULL)
{
result = sc->NIL;
}
else
{
count_components = babl_format_get_n_components (gegl_color_get_format (color));
switch (count_components)
{
case 3:
gegl_color_get_pixel (color, babl_format ("R'G'B' u8"), rgba);
result = marshal_rgba_to_list_of_numeric (sc, rgba, 3);
break;
case 4:
gegl_color_get_pixel (color, babl_format ("R'G'B'A u8"), rgba);
result = marshal_rgba_to_list_of_numeric (sc, rgba, 4);
break;
case 1:
/* Grayscale with TRC from space */
gegl_color_get_pixel (color, babl_format ("Y' u8"), rgba);
result = marshal_rgba_to_list_of_numeric (sc, rgba, 1);
break;
case 2:
/* Grayscale with TRC from space, separate alpha. */
gegl_color_get_pixel (color, babl_format ("Y'A u8"), rgba);
result = marshal_rgba_to_list_of_numeric (sc, rgba, 2);
break;
default:
g_warning ("%s unhandled count of color components: %d", G_STRFUNC, count_components);
result = sc->NIL;
}
}
return result;
}
/* ColorArray */
/* Returns a vector of lists, where each list is a pixel i.e.
* list of numerics, each the intensity component in a channel.
*
* array is a null-terminated array of pointers to GeglColor which is-a GObject.
*
* The returned vector can be empty, when the passed array is empty.
*/
pointer
marshal_color_array_to_vector (scheme *sc,
GimpColorArray array)
{
guint array_length = gimp_color_array_get_length (array);
pointer result = sc->vptr->mk_vector (sc, array_length);
for (guint j = 0; j < array_length; j++)
{
pointer component_list = marshal_color_to_component_list (sc, array[j]);
sc->vptr->set_vector_elem (result, j, component_list);
}
return result;
}