475 lines
17 KiB
C
475 lines
17 KiB
C
/* 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"
|
|
|
|
/* 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;
|
|
}
|
|
|
|
/* 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)))
|
|
return foreign_error (sc, "script-fu-register: argument types must be integer values", 0);
|
|
|
|
arg->type = sc->vptr->ivalue (sc->vptr->pair_car (a));
|
|
a = sc->vptr->pair_cdr (a);
|
|
}
|
|
else
|
|
return foreign_error (sc, "script-fu-register: missing type specifier", 0);
|
|
|
|
if (a != sc->NIL)
|
|
{
|
|
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: argument labels must be strings", 0);
|
|
|
|
arg->label = g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
|
|
a = sc->vptr->pair_cdr (a);
|
|
}
|
|
else
|
|
return foreign_error (sc, "script-fu-register: missing arguments label", 0);
|
|
|
|
if (a != sc->NIL)
|
|
{
|
|
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 (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: default IDs must be integer values", 0);
|
|
|
|
arg->default_value.sfa_image =
|
|
sc->vptr->ivalue (sc->vptr->pair_car (a));
|
|
break;
|
|
|
|
case SF_COLOR:
|
|
if (sc->vptr->is_string (sc->vptr->pair_car (a)))
|
|
{
|
|
if (! pika_rgb_parse_css (&arg->default_value.sfa_color,
|
|
sc->vptr->string_value (sc->vptr->pair_car (a)),
|
|
-1))
|
|
return foreign_error (sc, "script-fu-register: invalid default color name", 0);
|
|
|
|
pika_rgb_set_alpha (&arg->default_value.sfa_color, 1.0);
|
|
}
|
|
else if (sc->vptr->is_list (sc, sc->vptr->pair_car (a)) &&
|
|
sc->vptr->list_length(sc, sc->vptr->pair_car (a)) == 3)
|
|
{
|
|
pointer color_list;
|
|
guchar r, g, b;
|
|
|
|
color_list = sc->vptr->pair_car (a);
|
|
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 foreign_error (sc, "script-fu-register: color defaults must be a list of 3 integers or a color name", 0);
|
|
}
|
|
break;
|
|
|
|
case SF_TOGGLE:
|
|
if (!sc->vptr->is_integer (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: toggle default must be an integer value", 0);
|
|
|
|
arg->default_value.sfa_toggle =
|
|
(sc->vptr->ivalue (sc->vptr->pair_car (a))) ? TRUE : FALSE;
|
|
break;
|
|
|
|
case SF_VALUE:
|
|
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: value defaults must be string values", 0);
|
|
|
|
arg->default_value.sfa_value =
|
|
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
|
|
break;
|
|
|
|
case SF_STRING:
|
|
case SF_TEXT:
|
|
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: string defaults must be string values", 0);
|
|
|
|
arg->default_value.sfa_value =
|
|
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
|
|
break;
|
|
|
|
case SF_ADJUSTMENT:
|
|
{
|
|
pointer adj_list;
|
|
|
|
if (!sc->vptr->is_list (sc, a))
|
|
return foreign_error (sc, "script-fu-register: adjustment defaults must be a list", 0);
|
|
|
|
adj_list = sc->vptr->pair_car (a);
|
|
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 (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: filename defaults must be string values", 0);
|
|
/* fallthrough */
|
|
|
|
case SF_DIRNAME:
|
|
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: dirname defaults must be string values", 0);
|
|
|
|
arg->default_value.sfa_file.filename =
|
|
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
|
|
|
|
#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:
|
|
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: font defaults must be string values", 0);
|
|
|
|
arg->default_value.sfa_font =
|
|
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
|
|
break;
|
|
|
|
case SF_PALETTE:
|
|
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: palette defaults must be string values", 0);
|
|
|
|
arg->default_value.sfa_palette =
|
|
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
|
|
break;
|
|
|
|
case SF_PATTERN:
|
|
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: pattern defaults must be string values", 0);
|
|
|
|
arg->default_value.sfa_pattern =
|
|
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
|
|
break;
|
|
|
|
case SF_BRUSH:
|
|
{
|
|
pointer brush_list;
|
|
|
|
if (!sc->vptr->is_list (sc, a))
|
|
return foreign_error (sc, "script-fu-register: brush defaults must be a list", 0);
|
|
|
|
#ifdef OLD
|
|
temporarily, still a list, but use only the name
|
|
future: not a list, only a name
|
|
|
|
brush_list = sc->vptr->pair_car (a);
|
|
arg->default_value.sfa_brush.name =
|
|
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (brush_list)));
|
|
|
|
brush_list = sc->vptr->pair_cdr (brush_list);
|
|
arg->default_value.sfa_brush.opacity =
|
|
sc->vptr->rvalue (sc->vptr->pair_car (brush_list));
|
|
|
|
brush_list = sc->vptr->pair_cdr (brush_list);
|
|
arg->default_value.sfa_brush.spacing =
|
|
sc->vptr->ivalue (sc->vptr->pair_car (brush_list));
|
|
|
|
brush_list = sc->vptr->pair_cdr (brush_list);
|
|
arg->default_value.sfa_brush.paint_mode =
|
|
sc->vptr->ivalue (sc->vptr->pair_car (brush_list));
|
|
#else
|
|
brush_list = sc->vptr->pair_car (a);
|
|
arg->default_value.sfa_brush =
|
|
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (brush_list)));
|
|
#endif
|
|
}
|
|
break;
|
|
|
|
case SF_GRADIENT:
|
|
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
|
|
return foreign_error (sc, "script-fu-register: gradient defaults must be string values", 0);
|
|
|
|
arg->default_value.sfa_gradient =
|
|
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
|
|
break;
|
|
|
|
case SF_OPTION:
|
|
{
|
|
pointer option_list;
|
|
|
|
if (!sc->vptr->is_list (sc, a))
|
|
return foreign_error (sc, "script-fu-register: option defaults must be a list", 0);
|
|
|
|
for (option_list = sc->vptr->pair_car (a);
|
|
option_list != sc->NIL;
|
|
option_list = sc->vptr->pair_cdr (option_list))
|
|
{
|
|
arg->default_value.sfa_option.list =
|
|
g_slist_append (arg->default_value.sfa_option.list,
|
|
g_strdup (sc->vptr->string_value
|
|
(sc->vptr->pair_car (option_list))));
|
|
}
|
|
}
|
|
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, a))
|
|
return foreign_error (sc, "script-fu-register: enum defaults must be a list", 0);
|
|
|
|
option_list = sc->vptr->pair_car (a);
|
|
if (!sc->vptr->is_string (sc->vptr->pair_car (option_list)))
|
|
return foreign_error (sc, "script-fu-register: first element in enum defaults must be a type-name", 0);
|
|
|
|
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 foreign_error (sc, "script-fu-register: first element in enum defaults must be the name of a registered type", 0);
|
|
}
|
|
|
|
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 foreign_error (sc, "script-fu-register: second element in enum defaults must be a string", 0);
|
|
|
|
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;
|
|
}
|
|
|
|
a = sc->vptr->pair_cdr (a);
|
|
}
|
|
else
|
|
{
|
|
return foreign_error (sc, "script-fu-register: missing default argument", 0);
|
|
}
|
|
} /* 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;
|
|
}
|
