PIKApp/pdb/groups/unit.pdb

# 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 unit_get_number_of_units {
    $blurb = 'Returns the number of units.';

    $help = 'This procedure returns the number of defined units.';

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @outargs = (
	{ name => 'num_units', type => 'int32', libdef => 'PIKA_UNIT_END',
	  desc => 'The number of units' }
    );

    %invoke = (
	code => <<'CODE'
{
  num_units = _pika_unit_get_number_of_units (pika);
}
CODE
    );
}

sub unit_get_number_of_built_in_units {
    $blurb = 'Returns the number of built-in units.';

    $help = <<'HELP';
This procedure returns the number of defined units built-in to PIKA.
HELP

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @outargs = (
	{ name => 'num_units', type => 'int32', libdef => 'PIKA_UNIT_END',
	  desc => 'The number of built-in units' }
    );

    %invoke = (
	code => <<'CODE'
{
  num_units = _pika_unit_get_number_of_built_in_units (pika);
}
CODE
    );
}

sub unit_new {
    $blurb = "Creates a new unit and returns it's integer ID.";

    $help = <<'HELP';
This procedure creates a new unit and returns it's integer ID. Note that the
new unit will have it's deletion flag set to TRUE, so you will have to set it
to FALSE with pika_unit_set_deletion_flag() to make it persistent.
HELP

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @inargs = (
	{ name => 'identifier', type => 'string', non_empty => 1,
	  desc => "The new unit's identifier" },
	{ name => 'factor', type => 'float',
	  desc => "The new unit's factor" },
	{ name => 'digits', type => 'int32',
	  desc => "The new unit's digits" },
	{ name => 'symbol', type => 'string', non_empty => 1,
	  desc => "The new unit's symbol" },
	{ name => 'abbreviation', type => 'string', non_empty => 1,
	  desc => "The new unit's abbreviation" },
	{ name => 'singular', type => 'string', non_empty => 1,
	  desc => "The new unit's singular form" },
	{ name => 'plural', type => 'string', non_empty => 1,
	  desc => "The new unit's plural form" }
    );

    @outargs = (
	{ name => 'unit_id', type => 'unit',
	  desc => "The new unit's ID",
	  libdef => 'PIKA_UNIT_INCH' }
    );

    %invoke = (
	code => <<'CODE'
{
  unit_id = _pika_unit_new (pika, identifier, factor, digits,
                            symbol, abbreviation, singular, plural);
}
CODE
    );
}

sub unit_get_deletion_flag {
    $blurb = "Returns the deletion flag of the unit.";

    $help = <<'HELP';
This procedure returns the deletion flag of the unit. If this value is TRUE the
unit's definition will not be saved in the user's unitrc file on pika exit.
HELP

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @inargs = (
	{ name => 'unit_id', type => 'unit',
	  desc => "The unit's integer ID" }
    );

    @outargs = (
	{ name => 'deletion_flag', type => 'boolean',
	  desc => "The unit's deletion flag" }
    );

    %invoke = (
	code => <<'CODE'
{
  deletion_flag = _pika_unit_get_deletion_flag (pika, unit_id);
}
CODE
    );
}

sub unit_set_deletion_flag {
    $blurb = 'Sets the deletion flag of a unit.';

    $help = <<'HELP';
This procedure sets the unit's deletion flag. If the deletion flag of a unit is
TRUE on pika exit, this unit's definition will not be saved in the user's
unitrc.
HELP

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @inargs = (
	{ name => 'unit_id', type => 'unit',
	  desc => "The unit's integer ID" },
	{ name => 'deletion_flag', type => 'boolean',
	  desc => 'The new deletion flag of the unit' }
    );

    %invoke = (
	code => <<'CODE'
{
  _pika_unit_set_deletion_flag (pika, unit_id, deletion_flag);
}
CODE
    );
}

sub unit_get_identifier {
    $blurb = "Returns the textual identifier of the unit.";

    $help = <<'HELP';
This procedure returns the textual identifier of the unit. For built-in units
it will be the english singular form of the unit's name. For user-defined units
this should equal to the singular form.
HELP

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @inargs = (
	{ name => 'unit_id', type => 'unit',
	  desc => "The unit's integer ID" }
    );

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

    %invoke = (
	code => <<'CODE'
{
  identifier = g_strdup (_pika_unit_get_identifier (pika, unit_id));
}
CODE
    );
}

sub unit_get_factor {
    $blurb = "Returns the factor of the unit.";

    $help = <<'HELP';
This procedure returns the unit's factor which indicates how many units make up
an inch. Note that asking for the factor of "pixels" will produce an error.
HELP

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @inargs = (
	{ name => 'unit_id', type => 'unit',
	  desc => "The unit's integer ID" }
    );

    @outargs = (
	{ name => 'factor', type => 'float',
	  desc => "The unit's factor" }
    );

    %invoke = (
	code => <<'CODE'
{
  factor = _pika_unit_get_factor (pika, unit_id);
}
CODE
    );
}

sub unit_get_digits {
    $blurb = "Returns the number of digits of the unit.";

    $help = <<'HELP';
This procedure returns the number of digits you should provide in input or
output functions to get approximately the same accuracy as with two digits and
inches. Note that asking for the digits of "pixels" will produce an error.
HELP

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @inargs = (
	{ name => 'unit_id', type => 'unit',
	  desc => "The unit's integer ID" }
    );

    @outargs = (
	{ name => 'digits', type => 'int32',
	  desc => "The unit's number of digits" }
    );

    %invoke = (
	code => <<'CODE'
{
  digits = _pika_unit_get_digits (pika, unit_id);
}
CODE
    );
}

sub unit_get_symbol {
    $blurb = "Returns the symbol of the unit.";

    $help = <<'HELP';
This procedure returns the symbol of the unit ("''" for inches).
HELP

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @inargs = (
	{ name => 'unit_id', type => 'unit',
	  desc => "The unit's integer ID" }
    );

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

    %invoke = (
	code => <<'CODE'
{
  symbol = g_strdup (_pika_unit_get_symbol (pika, unit_id));
}
CODE
    );
}

sub unit_get_abbreviation {
    $blurb = "Returns the abbreviation of the unit.";

    $help = <<'HELP';
This procedure returns the abbreviation of the unit ("in" for inches).
HELP

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @inargs = (
	{ name => 'unit_id', type => 'unit',
	  desc => "The unit's integer ID" }
    );

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

    %invoke = (
	code => <<'CODE'
{
  abbreviation = g_strdup (_pika_unit_get_abbreviation (pika, unit_id));
}
CODE
    );
}

sub unit_get_singular {
    $blurb = "Returns the singular form of the unit.";
    $help  = 'This procedure returns the singular form of the unit.';

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @inargs = (
	{ name => 'unit_id', type => 'unit',
	  desc => "The unit's integer ID" }
    );

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

    %invoke = (
	code => <<'CODE'
{
  singular = g_strdup (_pika_unit_get_singular (pika, unit_id));
}
CODE
    );
}

sub unit_get_plural {
    $blurb = "Returns the plural form of the unit.";
    $help  = 'This procedure returns the plural form of the unit.';

    &mitch_pdb_misc('1999');

    $lib_private = 1;

    @inargs = (
	{ name => 'unit_id', type => 'unit',
	  desc => "The unit's integer ID" }
    );

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

    %invoke = (
	code => <<'CODE'
{
  plural = g_strdup (_pika_unit_get_plural (pika, unit_id));
}
CODE
    );
}


@headers = qw("libpikabase/pikabase.h"
              "core/pikaunit.h");

@procs = qw(unit_get_number_of_units
            unit_get_number_of_built_in_units
	    unit_new
            unit_get_deletion_flag
            unit_set_deletion_flag
            unit_get_identifier
            unit_get_factor
            unit_get_digits
            unit_get_symbol
            unit_get_abbreviation
            unit_get_singular
            unit_get_plural);

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

$desc = 'Units';

$lib_private = 1;

1;