# PIKA - Photo and Image Kooker Application
# 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/>.

# "Perlized" from C source by Manish Singh <yosh@gimp.org>

sub resource_get_by_name {
    $blurb = "Returns a resource with the given name.";
    $help  = "Returns a resource with the given name.";

    &jehan_pdb_misc('2023', '3.0');

    $lib_private = 1;

    @inargs = (
        { name => 'type_name', type => 'string', non_empty => 1,
          desc => 'The name of the resource type' },
	{ name => 'resource_name', type => 'string', non_empty => 1,
	  desc => 'The name of the resource' }
    );

    @outargs = (
      { name => 'resource',
        type => 'resource',
        desc => "The resource" }
    );

    %invoke = (
        code => <<'CODE'
{
  resource = pika_pdb_get_resource (pika, g_type_from_name (type_name), resource_name,
                                    PIKA_PDB_DATA_ACCESS_READ, error);

  if (! resource)
    success = FALSE;
}
CODE
    );
}

sub resource_get_by_identifiers {
    $blurb = "Returns the resource contained in a given file with a given name.";
    $help = <<'HELP';
Returns a resource specifically stored in a given file path, under a given name
(a single path may be a collection containing several resources).
HELP

    &jehan_pdb_misc('2023', '3.0');

    $lib_private = 1;

    @inargs = (
        { name => 'type_name', type => 'string', non_empty => 1,
          desc => 'The name of the resource type' },
	{ name => 'resource_name', type => 'string', non_empty => 1,
	  desc => 'The name of the resource' },
	{ name => 'collection', type => 'string', non_empty => 1,
	  desc => 'The collection identifier' },
        { name => 'is_internal', type => 'boolean',
          desc => 'Whether this is the identifier for internal data'}
    );

    @outargs = (
      { name => 'resource',
        type => 'resource',
        desc => "The resource" }
    );

    %invoke = (
        code => <<'CODE'
{
  resource = pika_pdb_get_resource_by_id (pika, g_type_from_name (type_name),
                                          resource_name, collection, is_internal,
                                          PIKA_PDB_DATA_ACCESS_READ, error);

  if (! resource)
    success = FALSE;
}
CODE
    );
}

sub resource_id_is_valid {
    $blurb = 'Returns TRUE if the resource ID is valid.';

    $help = <<'HELP';
This procedure checks if the given resource ID is valid and refers to an
existing resource.
HELP

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
      { name => 'resource_id', type => 'int32',
        desc => 'The resource ID to check' }
    );

    @outargs = (
	{ name => 'valid', type => 'boolean',
	  desc => 'Whether the resource ID is valid' }
    );

    %invoke = (
	code => <<'CODE'
{
  PikaData *data = pika_data_get_by_id (resource_id);

  valid = PIKA_IS_DATA (data);
}
CODE
    );
}

sub resource_id_is_brush {
    $blurb = 'Returns whether the resource ID is a brush.';

    $help = <<HELP;
This procedure returns TRUE if the specified resource ID is a brush.
HELP

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
      { name => 'resource_id', type => 'int32',
        desc => 'The resource ID' }
    );

    @outargs = (
      { name => 'brush', type => 'boolean',
        desc => 'TRUE if the resource ID is a brush, FALSE otherwise' }
    );

    %invoke = (
	code => <<'CODE'
{
  PikaData *data = pika_data_get_by_id (resource_id);

  brush = PIKA_IS_BRUSH (data);
}
CODE
    );
}

sub resource_id_is_pattern {
    $blurb = 'Returns whether the resource ID is a pattern.';

    $help = <<HELP;
This procedure returns TRUE if the specified resource ID is a pattern.
HELP

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
      { name => 'resource_id', type => 'int32',
        desc => 'The resource ID' }
    );

    @outargs = (
      { name => 'pattern', type => 'boolean',
        desc => 'TRUE if the resource ID is a pattern, FALSE otherwise' }
    );

    %invoke = (
	code => <<'CODE'
{
  PikaData *data = pika_data_get_by_id (resource_id);

  pattern = PIKA_IS_PATTERN (data);
}
CODE
    );
}

sub resource_id_is_gradient {
    $blurb = 'Returns whether the resource ID is a gradient.';

    $help = <<HELP;
This procedure returns TRUE if the specified resource ID is a gradient.
HELP

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
      { name => 'resource_id', type => 'int32',
        desc => 'The resource ID' }
    );

    @outargs = (
      { name => 'gradient', type => 'boolean',
        desc => 'TRUE if the resource ID is a gradient, FALSE otherwise' }
    );

    %invoke = (
        code => <<'CODE'
{
  PikaData *data = pika_data_get_by_id (resource_id);

  gradient = PIKA_IS_GRADIENT (data);
}
CODE
    );
}

sub resource_id_is_palette {
    $blurb = 'Returns whether the resource ID is a palette.';

    $help = <<HELP;
This procedure returns TRUE if the specified resource ID is a palette.
HELP

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
	{ name => 'resource_id', type => 'int32',
	  desc => 'The resource ID' }
    );

    @outargs = (
	{ name => 'palette', type => 'boolean',
	  desc => 'TRUE if the resource ID is a palette, FALSE otherwise' }
    );

    %invoke = (
	code => <<'CODE'
{
  PikaData *data = pika_data_get_by_id (resource_id);

  palette = PIKA_IS_PALETTE (data);
}
CODE
    );
}

sub resource_id_is_font {
    $blurb = 'Returns whether the resource ID is a font.';

    $help = <<HELP;
This procedure returns TRUE if the specified resource ID is a font.
HELP

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
	{ name => 'resource_id', type => 'int32',
	  desc => 'The resource ID' }
    );

    @outargs = (
	{ name => 'font', type => 'boolean',
	  desc => 'TRUE if the resource ID is a font, FALSE otherwise' }
    );

    %invoke = (
	code => <<'CODE'
{
  PikaData *data = pika_data_get_by_id (resource_id);

  font = PIKA_IS_FONT (data);
}
CODE
    );
}

sub resource_get_name {
    $blurb = "Returns the resource's name.";

    $help = <<HELP;
This procedure returns the resource's name.
HELP

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
	{ name => 'resource', type => 'resource',
	  desc => 'The resource' }
    );

    @outargs = (
	{ name => 'name', type => 'string',
	  desc => "The resource's name" }
    );

    %invoke = (
	code => <<'CODE'
{
  name = g_strdup (pika_object_get_name (PIKA_OBJECT (resource)));
}
CODE
    );
}

sub resource_get_identifiers {
    $blurb = "Returns a triplet identifying the resource.";

    $help = <<HELP;
This procedure returns 2 strings and a boolean. The first string is the resource
name, similar to what you would obtain calling pika_resource_get_name(). The
second is an opaque identifier for the collection this resource belongs to.

Note: as far as PIKA is concerned, a collection of resource usually corresponds
to a single file on disk (which may or may not contain several resources).
Therefore the identifier may be derived from the local file path. Nevertheless
you should not use this string as such as this is not guaranteed to be always
the case. You should consider it as an opaque identifier only to be used again
through _pika_resource_get_by_identifier().
HELP

    &jehan_pdb_misc('2023', '3.0');

    $lib_private = 1;

    @inargs = (
	{ name => 'resource', type => 'resource',
	  desc => 'The resource' }
    );

    @outargs = (
        { name => 'is_internal', type => 'boolean',
          desc => 'Whether this is the identifier for internal data'},
	{ name => 'name', type => 'string',
	  desc => "The resource's name" },
	{ name => 'collection_id', type => 'string',
	  desc => "The resource's collection identifier" }
    );

    %invoke = (
	code => <<'CODE'
{
  pika_data_get_identifiers (PIKA_DATA (resource), &name, &collection_id, &is_internal);
}
CODE
    );
}

sub resource_is_editable {
    $blurb = "Whether the resource can be edited.";
    $help  = "Returns TRUE if you have permission to change the resource.";

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
	{ name => 'resource', type => 'resource',
	  desc => 'The resource' }
    );

    @outargs = (
      { name => 'editable', type => 'boolean',
        desc => 'TRUE if the resource can be edited' }
    );

    %invoke = (
        code => <<'CODE'
{
  editable = pika_data_is_writable (PIKA_DATA (resource));
}
CODE
    );
}

sub resource_duplicate {
    $blurb = "Duplicates a resource.";
    $help  = "Returns a copy having a different, unique ID.";

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
	{ name => 'resource', type => 'resource',
	  desc => 'The resource' }
    );

    @outargs = (
      { name => 'resource_copy',
        type => 'resource',
        desc => "A copy of the resource." }
    );

    %invoke = (
        code => <<'CODE'
{
  PikaDataFactory *factory;

  factory = pika_pdb_get_data_factory (pika, G_TYPE_FROM_INSTANCE (resource));

  resource_copy = (PikaResource *)
    pika_data_factory_data_duplicate (factory, PIKA_DATA (resource));

  if (! resource_copy)
    success = FALSE;
}
CODE
    );
}

sub resource_rename {
    $blurb = "Renames a resource. When the name is in use, renames to a unique name.";

    $help = <<'HELP';
Renames a resource. When the proposed name is already used, PIKA
generates a unique name.
HELP

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
        { name => 'resource', type => 'resource',
          desc => 'The resource' },
        { name => 'new_name', type => 'string', non_empty => 1,
          desc => 'The proposed new name of the resource' }
    );

    %invoke = (
	code => <<'CODE'
{
  if (pika_viewable_is_name_editable (PIKA_VIEWABLE (resource)))
    {
      pika_object_set_name (PIKA_OBJECT (resource), new_name);
    }
  else
    {
      g_set_error (error, PIKA_PDB_ERROR, PIKA_PDB_ERROR_INVALID_ARGUMENT,
                   _("Resource '%s' is not renamable"),
                  pika_object_get_name (PIKA_OBJECT (resource)));
      success = FALSE;
    }
}
CODE
    );
}

sub resource_delete {
    $blurb = "Deletes a resource.";
    $help = <<'HELP';
Deletes a resource.  Returns an error if the resource is not deletable.
Deletes the resource's data.  You should not use the resource afterwards.
HELP

    &mitch_pdb_misc('2023', '3.0');

    @inargs = (
      { name => 'resource', type => 'resource',
        desc => 'The resource' }
    );

    %invoke = (
	code => <<'CODE'
{
  PikaDataFactory *factory;

  factory = pika_pdb_get_data_factory (pika, G_TYPE_FROM_INSTANCE (resource));

  if (pika_data_is_deletable (PIKA_DATA (resource)))
    success = pika_data_factory_data_delete (factory, PIKA_DATA (resource),
                                             TRUE, error);
  else
    success = FALSE;
}
CODE
    );
}


@headers = qw("core/pikabrush.h"
              "core/pikadatafactory.h"
              "core/pikagradient.h"
              "core/pikapalette.h"
              "core/pikapattern.h"
              "text/pikafont.h"
              "pikapdb-utils.h"
              "pikapdberror.h"
              "pika-intl.h");

@procs = qw(resource_get_by_name
            resource_get_by_identifiers
            resource_id_is_valid
            resource_id_is_brush
            resource_id_is_pattern
            resource_id_is_gradient
            resource_id_is_palette
            resource_id_is_font
            resource_get_name
            resource_get_identifiers
            resource_is_editable
            resource_duplicate
            resource_rename
            resource_delete);

%exports = (app => [@procs], lib => [@procs]);

$desc = 'Resource procedures';
$doc_title = 'pikaresource';
$doc_short_desc = 'Functions to manipulate resources.';
$doc_long_desc = 'Functions to manipulate resources.';

1;