PIKApp/plug-ins/script-fu/libscriptfu/script-fu-register.c

477 lines
15 KiB
C
Raw Normal View History

2023-09-26 00:35:21 +02:00
/* PIKA - Photo and Image Kooker Application
* a rebranding of The GNU Image Manipulation Program (created with heckimp)
* A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
*
* Original copyright, applying to most contents (license remains unchanged):
* 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 <glib.h>
#ifdef G_OS_WIN32
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#endif
#include <libpika/pika.h>
#include "tinyscheme/scheme-private.h"
#include "script-fu-types.h"
#include "script-fu-script.h"
#include "script-fu-register.h"
2023-10-30 23:55:30 +01:00
#include "script-fu-errors.h"
2023-09-26 00:35:21 +02:00
/* Methods for a script's call to script-fu-register or script-fu-register-filter.
* Such calls declare a PDB procedure, that ScriptFu will register in the PDB,
* that the script implements by its inner run func.
* These methods are only creating structs local to ScriptFu, used later to register.
*/
/* Traverse Scheme argument list
* creating a new SFScript with metadata, but empty SFArgs (formal arg specs)
*
* Takes a handle to a pointer into the argument list.
* Advances the pointer past the metadata args.
*
* Returns new SFScript.
*/
SFScript*
script_fu_script_new_from_metadata_args (scheme *sc,
pointer *handle)
{
SFScript *script;
const gchar *name;
const gchar *menu_label;
const gchar *blurb;
const gchar *author;
const gchar *copyright;
const gchar *date;
const gchar *image_types;
guint n_args;
/* dereference handle into local pointer. */
pointer a = *handle;
g_debug ("script_fu_script_new_from_metadata_args");
/* Require list_length starting at a is >=7
* else strange parsing errors at plugin query time.
*/
name = sc->vptr->string_value (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
menu_label = sc->vptr->string_value (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
blurb = sc->vptr->string_value (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
author = sc->vptr->string_value (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
copyright = sc->vptr->string_value (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
date = sc->vptr->string_value (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
if (sc->vptr->is_pair (a))
{
image_types = sc->vptr->string_value (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
}
else
{
image_types = sc->vptr->string_value (a);
a = sc->NIL;
}
/* Store local, advanced pointer at handle from caller. */
*handle = a;
/* Calculate supplied number of formal arguments of the PDB procedure,
* each takes three actual args from Scheme call.
*/
n_args = sc->vptr->list_length (sc, a) / 3;
/* This allocates empty array of SFArg. Hereafter, script knows its n_args. */
script = script_fu_script_new (name,
menu_label,
blurb,
author,
copyright,
date,
image_types,
n_args);
return script;
}
2023-10-30 23:55:30 +01:00
/* Parse a default spec from registration data.
*
* Side effects on arg.
*
* Returns sc->NIL on success.
* Returns pointer to a foreign_error on parsing errors.
*
* A default_spec can be an atom or a list.
* An atom is a single default value.
* A list for SF-COLOR is also a default value.
* In other cases, a list is a default and constraints.
* Some constraints are declared to and enforced by the PDB.
* Some constraints also convey to the widget for the arg.
*
* We check that each list is the correct length,
* so we don't car off the end of the list.
*
* We don't check the types of list elements.
* When they are not the correct type,
* they are *some* scheme object and getting the numeric value
* will return *some* value probably not the intended value,
* but at least not a memory error or crash.
*/
static pointer
script_fu_parse_default_spec (scheme *sc,
pointer default_spec,
SFArg *arg)
{
switch (arg->type)
{
case SF_IMAGE:
case SF_DRAWABLE:
case SF_LAYER:
case SF_CHANNEL:
case SF_VECTORS:
case SF_DISPLAY:
if (!sc->vptr->is_integer (default_spec))
return registration_error (sc, "default IDs must be integers");
arg->default_value.sfa_image =
sc->vptr->ivalue (default_spec);
break;
case SF_COLOR:
if (sc->vptr->is_string (default_spec))
{
if (! pika_rgb_parse_css (&arg->default_value.sfa_color,
sc->vptr->string_value (default_spec),
-1))
return registration_error (sc, "invalid default color name");
pika_rgb_set_alpha (&arg->default_value.sfa_color, 1.0);
}
else if (sc->vptr->is_list (sc, default_spec) &&
sc->vptr->list_length (sc, default_spec) == 3)
{
pointer color_list;
guchar r, g, b;
color_list = default_spec;
r = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)), 0, 255);
color_list = sc->vptr->pair_cdr (color_list);
g = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)), 0, 255);
color_list = sc->vptr->pair_cdr (color_list);
b = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)), 0, 255);
pika_rgb_set_uchar (&arg->default_value.sfa_color, r, g, b);
}
else
{
return registration_error (sc, "color defaults must be a list of 3 integers or a color name");
}
break;
case SF_TOGGLE:
if (!sc->vptr->is_integer (default_spec))
return registration_error (sc, "toggle default must be an integer value");
arg->default_value.sfa_toggle =
(sc->vptr->ivalue (default_spec)) ? TRUE : FALSE;
break;
case SF_VALUE:
if (!sc->vptr->is_string (default_spec))
return registration_error (sc, "value defaults must be strings");
arg->default_value.sfa_value =
g_strdup (sc->vptr->string_value (default_spec));
break;
case SF_STRING:
case SF_TEXT:
if (!sc->vptr->is_string (default_spec))
return registration_error (sc, "string defaults must be strings");
arg->default_value.sfa_value =
g_strdup (sc->vptr->string_value (default_spec));
break;
case SF_ADJUSTMENT:
{
pointer adj_list;
if (!sc->vptr->is_list (sc, default_spec) &&
sc->vptr->list_length (sc, default_spec) != 7)
return registration_error (sc, "adjustment defaults must be a list of 7 elements");
adj_list = default_spec;
arg->default_value.sfa_adjustment.value =
sc->vptr->rvalue (sc->vptr->pair_car (adj_list));
adj_list = sc->vptr->pair_cdr (adj_list);
arg->default_value.sfa_adjustment.lower =
sc->vptr->rvalue (sc->vptr->pair_car (adj_list));
adj_list = sc->vptr->pair_cdr (adj_list);
arg->default_value.sfa_adjustment.upper =
sc->vptr->rvalue (sc->vptr->pair_car (adj_list));
adj_list = sc->vptr->pair_cdr (adj_list);
arg->default_value.sfa_adjustment.step =
sc->vptr->rvalue (sc->vptr->pair_car (adj_list));
adj_list = sc->vptr->pair_cdr (adj_list);
arg->default_value.sfa_adjustment.page =
sc->vptr->rvalue (sc->vptr->pair_car (adj_list));
adj_list = sc->vptr->pair_cdr (adj_list);
arg->default_value.sfa_adjustment.digits =
sc->vptr->ivalue (sc->vptr->pair_car (adj_list));
adj_list = sc->vptr->pair_cdr (adj_list);
arg->default_value.sfa_adjustment.type =
sc->vptr->ivalue (sc->vptr->pair_car (adj_list));
}
break;
case SF_FILENAME:
if (!sc->vptr->is_string (default_spec))
return registration_error (sc, "filename defaults must be strings");
/* fallthrough */
case SF_DIRNAME:
if (!sc->vptr->is_string (default_spec))
return registration_error (sc, "dirname defaults must be strings");
arg->default_value.sfa_file.filename =
g_strdup (sc->vptr->string_value (default_spec));
#ifdef G_OS_WIN32
{
/* Replace POSIX slashes with Win32 backslashes. This
* is just so script-fus can be written with only
* POSIX directory separators.
*/
gchar *filename = arg->default_value.sfa_file.filename;
while (*filename)
{
if (*filename == '/')
*filename = G_DIR_SEPARATOR;
filename++;
}
}
#endif
break;
case SF_FONT:
case SF_PALETTE:
case SF_PATTERN:
case SF_BRUSH:
case SF_GRADIENT:
/* Ignore default_spec given by author, it is just placeholder in script.
* We can't look up resource by name at registration time.
* The ParamSpecResource does not conveniently take a default.
* It makes no sense to set objects for defaults.
* Compare to SF_IMAGE.
* Since v3.
*/
arg->default_value.sfa_resource = -1;
break;
case SF_OPTION:
{
pointer option_list;
if (!sc->vptr->is_list (sc, default_spec) ||
sc->vptr->list_length(sc, default_spec) < 1 )
return registration_error (sc, "option defaults must be a non-empty list");
for (option_list = default_spec;
option_list != sc->NIL;
option_list = sc->vptr->pair_cdr (option_list))
{
pointer option = (sc->vptr->pair_car (option_list));
if (sc->vptr->is_string (option))
arg->default_value.sfa_option.list =
g_slist_append (arg->default_value.sfa_option.list,
g_strdup (sc->vptr->string_value (option)));
else
return registration_error (sc, "options must be strings");
}
}
break;
case SF_ENUM:
{
pointer option_list;
const gchar *val;
gchar *type_name;
GEnumValue *enum_value;
GType enum_type;
if (!sc->vptr->is_list (sc, default_spec))
return registration_error (sc, "enum defaults must be a list");
option_list = default_spec;
if (!sc->vptr->is_string (sc->vptr->pair_car (option_list)))
return registration_error (sc, "first element in enum defaults must be a type-name");
val = sc->vptr->string_value (sc->vptr->pair_car (option_list));
if (g_str_has_prefix (val, "Pika"))
type_name = g_strdup (val);
else
type_name = g_strconcat ("Pika", val, NULL);
enum_type = g_type_from_name (type_name);
if (! G_TYPE_IS_ENUM (enum_type))
{
g_free (type_name);
return registration_error (sc, "first element in enum defaults must be the name of a registered type");
}
arg->default_value.sfa_enum.type_name = type_name;
option_list = sc->vptr->pair_cdr (option_list);
if (!sc->vptr->is_string (sc->vptr->pair_car (option_list)))
return registration_error (sc, "second element in enum defaults must be a string");
enum_value =
g_enum_get_value_by_nick (g_type_class_peek (enum_type),
sc->vptr->string_value (sc->vptr->pair_car (option_list)));
if (enum_value)
arg->default_value.sfa_enum.history = enum_value->value;
}
break;
} /* end switch */
/* success */
return sc->NIL;
}
2023-09-26 00:35:21 +02:00
/* Traverse suffix of Scheme argument list,
* creating SFArgs (formal arg specs) from triplets.
*
* Takes a handle to a pointer into the argument list.
* Advances the pointer past the triplets.
* Changes state of SFScript.args[]
*
* Returns a foreign_error or NIL.
*/
pointer
script_fu_script_create_formal_args (scheme *sc,
pointer *handle,
SFScript *script)
{
/* dereference handle into local pointer. */
pointer a = *handle;
g_debug ("script_fu_script_create_formal_args");
for (guint i = 0; i < script->n_args; i++)
{
SFArg *arg = &script->args[i];
if (a != sc->NIL)
{
if (!sc->vptr->is_integer (sc->vptr->pair_car (a)))
2023-10-30 23:55:30 +01:00
return registration_error (sc, "argument types must be integers");
2023-09-26 00:35:21 +02:00
arg->type = sc->vptr->ivalue (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
}
else
2023-10-30 23:55:30 +01:00
return registration_error (sc, "missing type specifier");
2023-09-26 00:35:21 +02:00
if (a != sc->NIL)
{
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
2023-10-30 23:55:30 +01:00
return registration_error (sc, "argument labels must be strings");
2023-09-26 00:35:21 +02:00
arg->label = g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
a = sc->vptr->pair_cdr (a);
}
else
2023-10-30 23:55:30 +01:00
return registration_error (sc, "missing arguments label");
2023-09-26 00:35:21 +02:00
if (a != sc->NIL)
{
2023-10-30 23:55:30 +01:00
/* a is pointing into a sequence, grouped in three.
* (car a) is the third part of three.
* (cdr a) is the rest of the sequence
*/
pointer default_spec =sc->vptr->pair_car (a);
pointer error = script_fu_parse_default_spec (sc, default_spec, arg);
if (error != sc->NIL)
return error;
else
/* advance to next group of three in the sequence. */
a = sc->vptr->pair_cdr (a);
2023-09-26 00:35:21 +02:00
}
else
{
2023-10-30 23:55:30 +01:00
return registration_error (sc, "missing default argument");
2023-09-26 00:35:21 +02:00
}
} /* end for */
/* Store local, advanced pointer at handle from caller. */
*handle = a;
return sc->NIL;
}
/* Traverse next arg in Scheme argument list.
* Set SFScript.drawable_arity from the argument.
* Used only by script-fu-register-filter.
*
* Return foreign_error or NIL.
*/
pointer
script_fu_script_parse_drawable_arity_arg (scheme *sc,
pointer *handle,
SFScript *script)
{
/* dereference handle into local pointer. */
pointer a = *handle;
/* argument must be an int, usually a symbol from enum e.g. SF-MULTIPLE-DRAWABLE */
if (!sc->vptr->is_integer (sc->vptr->pair_car (a)))
return foreign_error (sc, "script-fu-register-filter: drawable arity must be integer value", 0);
script->drawable_arity = sc->vptr->ivalue (sc->vptr->pair_car (a));
/* Advance the pointer into script. */
a = sc->vptr->pair_cdr (a);
*handle = a;
return sc->NIL;
}