/* 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 . */ #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; }