406 lines
8.8 KiB
Plaintext
406 lines
8.8 KiB
Plaintext
|
# 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;
|
