use strict;
use warnings;
# Invoke PDL::PP
my $path;
BEGIN {
# .PL scripts are sent their filename, sans the .PL part. That's almost what
# PDL::PP expects to see, so massage it into the proper form:
$path = $ARGV[0];
$path =~ s/\.pm//;
# Handle backslashes for Windows paths:
$path =~ s/\\/\\\\/g;
}
use PDL::PP (qw(PDL::Drawing::Prima::Utils PDL::Drawing::Prima::Utils), $path);
# Set the module version from the version stashed in the M::B object. The string
# passed to pp_setversion must include the quotes to ensure that it is processed
# as a string from the actual module:
use Module::Build;
my $build = Module::Build->current;
pp_setversion('"' . $build->dist_version . '"');
# Add the .xs file to the cleanup lists:
$build->add_to_cleanup("$path.xs");
pp_addpm({At=>'Top'},<<'ModuleMaterial');
=head1 NAME
PDL::Drawing::Prima::Utils - A handful of useful utilities.
=head1 DESCRIPTION
These functions provide a number of utilities that do not depend on the Prima
toolkit but which are useful for Prima/PDL interaction. The first set of
functions assist in converting colors from one format to another. The second set
of functions are important for the auto-scaling calculations in
L<PDL::Graphics::Prima>. Strictly speaking, they should probably be defined
somewhere in that module, but they reside here at the moment.
=cut
ModuleMaterial
################
# color_to_rgb #
################
# Based on value2rgb from Prima's ColorDialog.pm
=head1 FUNCTIONS
=head2 color_to_rgb
=cut
pp_def('color_to_rgb',
Pars => 'int color(); int [o] rgb(n=3)',
Code => q{
$rgb(n=>0) = $color() >> 16 & 0xFF;
$rgb(n=>1) = $color() >> 8 & 0xFF;
$rgb(n=>2) = $color() & 0xFF;
},
HandleBad => 1,
BadCode => q{
if ($ISBAD(color())) {
loop(n) %{
$SETBAD(rgb());
%}
}
else {
$rgb(n=>0) = $color() >> 16 & 0xFF;
$rgb(n=>1) = $color() >> 8 & 0xFF;
$rgb(n=>2) = $color() & 0xFF;
}
},
Doc => <<DOCUMENTATION,
=pod
=for ref
Converts a Prima color value to RGB representation
If the input piddle has dimension (m, n, ...), the output piddle has
dimensions (3, m, n, ...). The first element represents the red value, the
second the green value, and the third the blue value. The resulting piddle is
suitable for use in C<rgb_to_color> or C<rgb_to_hsv>.
The code for this routine is based on C<value2rgb> from L<Prima::colorDialog>.
=cut
DOCUMENTATION
BadDoc => <<BADDOC
=for bad
If C<color_to_rgb> encounters a bad value in the input, the output piddle will
be marked as bad and the associated rgb values will all be marked with the bad
value.
=cut
BADDOC
);
################
# rgb_to_color #
################
# Based on rgb2value from Prima's ColorDialog.pm
=head2 rgb_to_color
=cut
pp_def('rgb_to_color',
Pars => 'int rgb(n=3); int [o] color()',
Code => q{
int r, g, b;
threadloop %{
/* extract and clean up the rgb values */
r = $rgb(n => 0);
if (r < 0) r = 0;
if (r > 255) r = 255;
g = $rgb(n => 1);
if (g < 0) g = 0;
if (g > 255) g = 255;
b = $rgb(n => 2);
if (b < 0) b = 0;
if (b > 255) b = 255;
/* compute and return the color value */
$color() = b | g<<8 | r<<16;
%}
},
HandleBad => 1,
BadCode => q{
int r, g, b;
threadloop %{
if ($ISBAD(rgb(n=>0)) || $ISBAD(rgb(n=>1)) || $ISBAD(rgb(n=>2))) {
$SETBAD(color());
}
else {
/* extract and clean up the rgb values */
r = $rgb(n => 0);
if (r < 0) r = 0;
if (r > 255) r = 255;
g = $rgb(n => 1);
if (g < 0) g = 0;
if (g > 255) g = 255;
b = $rgb(n => 2);
if (b < 0) b = 0;
if (b > 255) b = 255;
/* compute and return the color value */
$color() = b | g<<8 | r<<16;
}
%}
},
Doc => <<DOCUMENTATION,
=pod
=for ref
Converts an RGB color to a Prima color value
Red, green, and blue values must fall between 0 and 255. Any values outside
those boundaries will be truncated to the nearest boundary before computing the
color.
The RGB values must be in the first dimension. In other words, the size of the
first dimension must be three, so if the input piddle has dimensions (3, m, n,
...), the output piddle will have dimension (m, n, ...). The resulting piddle is
suitable for use when specifying colors to drawing primitives.
The code for this routine is based on C<rgb2value> from L<Prima::colorDialog>.
=cut
DOCUMENTATION
BadDoc => <<BADDOC,
=for bad
If C<rgb_to_color> encounters a bad value in any of the red, green, or blue
values of the input, the output piddle will be marked as bad and the associated
color values will all be marked as bad.
=cut
BADDOC
);
##############
# hsv_to_rgb #
##############
# Based on hsv2rgb from Prima's ColorDialog.pm
=head2 hsv_to_rgb
=cut
my $hsv_to_rgb_code = q{
/* Get and adjust the value */
v = $hsv(n=>2);
if (v > 1) v = 1;
if (v < 0) v = 0;
/* Set value to something between 0 and 255 */
v *= 255;
/* Get and adjust the saturation */
s = $hsv(n=>1);
if (s > 1) s = 1;
if (s < 0) s = 0;
/* handle the special case of zero saturation */
if (s == 0) {
$rgb(m=>0) = v;
$rgb(m=>1) = v;
$rgb(m=>2) = v;
}
else {
/* Get and adjust the hue */
h = $hsv(n=>0);
if (h < 0) h = 0;
if (h > 360) h = 360;
/* Adjust hue to run between 0 and 6 instead of 0 and 360 */
h /= 60;
/* To help understand this, see hsv2rgb from Prima's ColorDialog.pm */
/* and also Fig. 24 under en.wikipedia.org/wiki/HSL_and_HSV#From_HSV */
i = (int) h;
f = h - i;
w = v * (1 - s);
q = v * (1 - (s * f));
t = v * (1 - (s * (1 - f)));
if (i == 0 || i == 6) {
$rgb(m=>0) = v;
$rgb(m=>1) = t;
$rgb(m=>2) = w;
}
else if (i == 1) {
$rgb(m=>0) = q;
$rgb(m=>1) = v;
$rgb(m=>2) = w;
}
else if (i == 2) {
$rgb(m=>0) = w;
$rgb(m=>1) = v;
$rgb(m=>2) = t;
}
else if (i == 3) {
$rgb(m=>0) = w;
$rgb(m=>1) = q;
$rgb(m=>2) = v;
}
else if (i == 4) {
$rgb(m=>0) = t;
$rgb(m=>1) = w;
$rgb(m=>2) = v;
}
else {
$rgb(m=>0) = v;
$rgb(m=>1) = w;
$rgb(m=>2) = q;
}
}
};
pp_def('hsv_to_rgb',
Pars => 'float+ hsv(n=3); int [o]rgb(m=3)',
Code => q[
$GENERIC(hsv) v, s, h, f, w, q, t;
int i;
threadloop %{
] . $hsv_to_rgb_code . q[
%}
],
HandleBad => 1,
BadCode => q[
$GENERIC(hsv) v, s, h, f, w, q, t;
int i;
threadloop %{
/* First check for bad values */
if ($ISBAD(hsv(n=>0)) || $ISBAD(hsv(n=>1)) || $ISBAD(hsv(n=>2))) {
loop (m) %{
$SETBAD(rgb());
%}
/* skip to the next hsv triple */
}
else {
] . $hsv_to_rgb_code . q[
}
%}
],
Doc => <<DOCUMENTATION,
=pod
=for ref
Converts an HSV color triple to an RGB color triple
HSV stands for hue-saturation-value and is nicely represented by a cirle in a
color palette. In this representation, the numbers representing saturation and
value must be between 0 and 1; anything less than zero or greater than 1 will be
truncated to the closest limit. The hue must be a value between 0 and 360, and
again it will be truncated to the corresponding limit if that is not the case.
For more information about HSV, see L<http://en.wikipedia.org/wiki/HSL_and_HSV>.
Note that Prima's C<hsv2rgb> function, upon which this was based, had a special
notation for a hue of -1, which always corresponded to a saturation of 0. Since
a saturation of 0 means 'use greyscale', this function does not make any special
use of that notation.
The first dimension of the piddles holding the hsv and rgb values must be size
3, i.e. the dimensions must look like (3, m, n, ...). The resulting piddle is
suitable for input into L<rgb_to_color> as well as manual manipulation.
The code for this routine is based on C<hsv2rgb> from L<Prima::colorDialog>.
=cut
DOCUMENTATION
BadDoc => <<BADDOC,
=for bad
If C<hsv_to_rgb> encounters a bad value in any of the hue, saturation, or value
quantities, the output piddle will be marked as bad and the associated rgb
color values will all be marked as bad.
=cut
BADDOC
);
##############
# rgb_to_hsv #
##############
# Based on rgb2hsv from Prima's ColorDialog.pm
=head2 rgb_to_hsv
=cut
# if ( $r == $max) {
# $h = ( $g - $b) / $delta;
# } elsif ( $g == $max) {
# $h = 2 + ( $b - $r) / $delta;
# } else {
# $h = 4 + ( $r - $g) / $delta;
# }
# $h *= 60;
# $h += 360 if $h < 0;
# return $h, $s, $v;
my $rgb_to_hsv_code = q{
/* Get and rescale the rgb values */
r = $rgb(n=>0);
if (r < 0) r = 0;
if (r > 255) r = 255;
r /= 255.0;
g = $rgb(n=>1);
if (g < 0) g = 0;
if (g > 255) g = 255;
g /= 255.0;
b = $rgb(n=>2);
if (b < 0) b = 0;
if (b > 255) b = 255;
b /= 255.0;
/* compute the min and max */
max = r;
if (max < g) max = g;
if (max < b) max = b;
min = r;
if (g < min) min = g;
if (b < min) min = b;
/* Set the value and delta */
v = max;
delta = max - min;
/* set up a greyscale if rgb values are identical */
/* Note: automatically includes max = 0 */
if (delta == 0) {
$hsv(m=>0) = 0;
$hsv(m=>1) = 0;
$hsv(m=>2) = v;
}
else {
s = delta / max;
/* compute hue */
if (r == max) {
h = (g - b) / delta;
}
else if (g == max) {
h = 2 + (b - r) / delta;
}
else {
h = 4 + (r - g) / delta;
}
h *= 60;
if (h < 0) h += 360;
$hsv(m=>0) = h;
$hsv(m=>1) = s;
$hsv(m=>2) = v;
}
};
pp_def('rgb_to_hsv',
Pars => 'int rgb(n=3); float+ [o]hsv(m=3)',
Code => q[
$GENERIC(hsv) r, g, b, h, s, v, max, min, delta;
threadloop %{
] . $rgb_to_hsv_code . q[
%}
],
HandleBad => 1,
BadCode => q[
$GENERIC(hsv) r, g, b, h, s, v, max, min, delta;
threadloop %{
/* First check for bad values */
if ($ISBAD(rgb(n=>0)) || $ISBAD(rgb(n=>1)) || $ISBAD(rgb(n=>2))) {
loop (m) %{
$SETBAD(hsv());
%}
/* skip to the next hsv triple */
}
else {
] . $rgb_to_hsv_code . q[
}
%}
],
Doc => <<DOCUMENTATION,
=pod
=for ref
Converts an RGB color triple to an HSV color triple
HSV stands for hue-saturation-value and is nicely represented by a cirle in a
color palette. In this representation, the numbers representing saturation and
value will run between 0 and 1. The hue will be a value between 0 and 360.
For more information about HSV, see L<http://en.wikipedia.org/wiki/HSL_and_HSV>.
Note that Prima's C<rgb2hsv> function, upon which this was based, returned a
special value if r == g == b. In that case, it returned a hue of -1 and a
saturation of zero. In the rgb color is a greyscale and the value is based
simply on that. This function does not make use of that special hue value; it
simply returns a hue value of 0.
The first dimension of the piddles holding the hsv and rgb values must be size
3, i.e. the dimensions must look like (3, m, n, ...). The resulting piddle is
suitable for manual manipulation and input into L<hsv_to_rgb>.
The code for this routine is based on C<rgb2hsv> from L<Prima::colorDialog>.
=cut
DOCUMENTATION
BadDoc => <<BADDOC,
=for bad
If C<rgb_to_hsv> encounters a bad value in any of the red, green, or blue values
the output piddle will be marked as bad and the associated hsv values will all
be marked as bad.
=cut
BADDOC
);
#################
# minmaxforpair #
#################
my $indx_type = PDL::Types::mapfld(indx => 'convertfunc', 'ppsym');
$indx_type ||= '';
=head2 minmaxforpair
=cut
pp_def('minmaxforpair',
Pars => 'x(n); y(n); [o] min_x(); [o] min_y(); [o] max_x(); [o] max_y()',
# Good code.
Code => pp_line_numbers(__LINE__, q[
// Set the initial values for the min/max. The naive approach is to set
// the first value as our starting point, which works fine for integer
// types. However, this approach is not guaranteed to work with
// floating-point values since inf and nan are valid values in PDL, but
// not in this function. So, if it is a floating point value, set the
// initial min/max to something that we know will be overridden, and be
// sure to check at the end that it is, indeed, overridden.
types (BSUL] . $indx_type . q[Q) %{
$min_x() = $x(n => 0);
$max_x() = $x(n => 0);
$min_y() = $y(n => 0);
$max_y() = $y(n => 0);
%}
types (FD) %{
// From math.h
$min_x() = INFINITY;
$max_x() = -INFINITY;
$min_y() = INFINITY;
$max_y() = -INFINITY;
%}
loop(n) %{
types (BSUL] . $indx_type . q[Q) %{
if ($x() < $min_x()) $min_x() = $x();
if ($max_x() < $x()) $max_x() = $x();
if ($y() < $min_y()) $min_y() = $y();
if ($max_y() < $y()) $max_y() = $y();
%}
types (FD) %{
if (isfinite($x()) && isfinite($y())) {
if ($x() < $min_x()) $min_x() = $x();
if ($max_x() < $x()) $max_x() = $x();
if ($y() < $min_y()) $min_y() = $y();
if ($max_y() < $y()) $max_y() = $y();
}
%}
%}
// finally, for floats, check if we have finite values. Otherwise set
// the piddle to bad.
types (FD) %{
if (isinf($min_x()) || isinf($min_y())) {
$PDLSTATESETBAD(min_x);
$SETBAD(min_x());
$PDLSTATESETBAD(min_y);
$SETBAD(min_y());
$PDLSTATESETBAD(max_x);
$SETBAD(max_x());
$PDLSTATESETBAD(max_y);
$SETBAD(max_y());
}
%}
]),
# Bad code
HandleBad => 1,
BadCode => pp_line_numbers(__LINE__, q{
// For bad code, I can't set initial values for min/max as the first
// elements of x/y. In fact, I need to assume that possibly all the data
// could be bad, so start with that:
$SETBAD(min_x());
$SETBAD(max_x());
$SETBAD(min_y());
$SETBAD(max_y());
loop(n) %{
types (FD) %{
// Additional finite check for float types
if (!isfinite($x()) || !isfinite($y())) continue;
%}
// Only check (and possibly change) if both x and y are good:
if ($ISGOOD(x()) && $ISGOOD(y())) {
// It could be that this is the first good value. If so, just
// assign the value. Note that either all min/max value are bad,
// or they are good, so I only need to check one of them (min_x
// in this case):
if ($ISBAD(min_x())) {
$min_x() = $x();
$max_x() = $x();
$min_y() = $y();
$max_y() = $y();
}
// If the min/max values are good, then I need to perform a
// bona-fide comparison:
else {
if ($x() < $min_x()) $min_x() = $x();
if ($max_x() < $x()) $max_x() = $x();
if ($y() < $min_y()) $min_y() = $y();
if ($max_y() < $y()) $max_y() = $y();
}
}
%}
}),
Doc => q{
=pod
=for ref
Returns the min/max values for the pairs of coordinates x and y.
This function is only really useful in one very specific context: when the
number of dimensions for x and y do not agree, and when you have bad data in
x, y, or both.
Suppose that you know that x and y are good. Then you could get the min/max
data using the C<minmax> function:
my ($xmin, $xmax) = $x->minmax;
my ($ymin, $ymax) = $y->minmax;
On the other hand, if you have data but you know that the dimensions of x and
y match, you could modify the above like so:
my ($xmin, $xmax) = $x->where($x->isgood & $y->isgood)->minmax;
my ($ymin, $ymax) = $y->where($x->isgood & $y->isgood)->minmax;
However, what if you have only one-dimensional x-data but two-dimensional
y-data? For example, you want to plot mutliple y datasets against the same
x-coordinates. In that case, if some of the x-data is bad, you could probably
hack something, but if some of the y-data is bad you you will have a hard time
picking out the good pairs, and getting the min/max from them. That is the
purpose of this function.
=cut
},
BadDoc => q{
=pod
Output is set bad if no pair of x/y data is good.
=cut
},
);
############################
# collate_min_max_wrt_many #
############################
# This should probably be moved into PDL::Graphics::Prima, but I'm keeping
# it here because PDL::Drawing::Prima is configured to compile PP.
# If you change this number, you must also change the PMCode below:
my $max_N_extras = 20;
my $max_piddle_index = $max_N_extras - 1;
pp_def ('collate_min_max_wrt_many',
Pars => 'min_check(Q); int min_index(Q); max_check(Q); int max_index(Q); '
. join('', map {"extra${_}(Q); "} (0..$max_piddle_index))
. '[o] min(N); [o] max(N)',
OtherPars => 'int N_extras',
# Here, the number of possible padding values is N,
# and the number of piddles to track is 1.
# Note: 0 <= N_extras <= 20 (as shown here)
# The PMCode section must always set min and max to bad piddles
# good code must never be called
Doc => '',
Code => q{
barf("Internal error: good code should never be called in collate_min_max_for_many");
},
HandleBad => 1,
BadCode => '# line ' . (__LINE__ + 1) . q["lib/PDL/Drawing/Prima/Utils.pm.PL"
int N_extras, index, N_pixels;
$GENERIC(min_check) min_value, max_value;
N_extras = $COMP(N_extras);
N_pixels = $SIZE(N);
threadloop %{
loop(Q) %{
/* First check that all the piddles have good values; note
* the fall-through!!!! */
switch(N_extras) {]
. join('', map {"
case $_:
min_value = \$extra${_}();
if (\$ISBAD(extra${_}()) /* bad check */
|| min_value != min_value /* nan check */
|| min_value * 0.0 != 0.0) /* inf check */
continue;
"} reverse (0..$max_piddle_index))
. q[
/* And make sure the index is good */
default:
if($ISBAD(min_index()) || $ISBAD(max_index())) continue;
min_value = $min_check();
max_value = $max_check();
if( $ISBAD(min_check()) /* bad check */
|| $ISBAD(max_check())
|| min_value != min_value /* nan check */
|| max_value != max_value
|| min_value * 0.0 != 0.0 /* inf check */
|| max_value * 0.0 != 0.0)
continue;
}
/* If we've reached here, we're ready to test the current
* min/max against the values, which are guaranteed to hold
* min_check and max_check. */
/* First work with the minima */
/* get the index and cut it off at the maximum (N-1) */
index = $min_index();
if (index >= N_pixels) index = N_pixels-1;
if (index < 0) index = 0;
if($ISBAD(min(N => index)) || min_value < $min(N => index))
$min(N => index) = min_value;
/* Now work with the maxima */
index = $max_index();
if (index >= N_pixels) index = N_pixels-1;
if (index < 0) index = 0;
if($ISBAD(max(N => index)) || max_value > $max(N => index))
$max(N => index) = max_value;
%}
%}
],
PMCode => <<'ModuleMaterial',
=head2 collate_min_max_wrt_many
=for sig
Signature: ($min(N_pixels), $max(N_pixels))
= collate_min_max_wrt_many(
$min_to_collate(M); $min_index(M);
$max_to_collate(M); $max_index(M);
N_pixels; $p1(M); $p2(M); ...);
=for ref
Collates the min/max two piddles according to their supplied indices.
This function pretty much only makes sense in the context of
PDL::Graphics::Prima and it's auto-scaling calculations. Here's how it
works.
Suppose you're drawing a collection of colored blobs. Your blobs have
various radii and you want to know the min and the max x-positions, collated
for each radius. In other words, for all the blobs with radius 1, give me
the min and the max; for all the blobs with radius 2, give me the min and
the max; etc. However, you are not going to draw the blobs that have a
badvalue for a the y position or the color---badvalues for any of these mean
"skip me". You only want to know the minima and maxima for the blobs that
you intend to draw. Also, let's assume that the widget onto which you intend
to draw is 500 pixels wide.
For that situation, you would call collate_min_max_wrt_many like so:
my ($min, $max) = PDL::collate_min_max_wrt_many($x, $xRadii, $x, $xRadii
, 500, $y, $yRadii, $colors);
The arguments are interpreted as follows. The first two piddles are the
values and the indices of the data from which we wish to draw the minima.
Here we want to find the smallest value of x, collated according to the
specified pixel radii. The next two piddles are the values and indices of
the data from which we wish to draw the maxima. The fifth argument, a scalar
number, indicates the maximum collation bin.
The remainder of the arguments are values against which we want to check
for bad values. For example, suppose the first (x, y) pair is (2, inf). This
point will not be drawn, because infinity cannot be drawn, so I will not
want to collate that x-value of 2, regardless of the xRadius with which it
corresponds. So, each value of x is included in the min/max collation only
if all the other piddles have good values at the same index.
This function threads over as many as 20 extra piddles, checking each
of them to see if they have bad values, inf, or nan. The limit to 20 piddles
is a hard but arbitrary limit. It could be increased if the need arose, but
the function would need to be recompiled.
=for bad
This function is explicitly meant to handle bad values. The output piddles
will have bad values for any index that was not represented in the
calculation. If any of the supplied piddles have bad values, the
corresponding position will not be analyzed.
=cut
use Carp 'croak';
sub PDL::collate_min_max_wrt_many {
my ($min_to_check, $min_index, $max_to_check, $max_index, $N_pixels
, @extra_piddles) = @_;
# Ensure all the things that are supposed to be piddles are indeed
# piddles:
foreach ($min_to_check, $min_index, $max_to_check, $max_index, @extra_piddles) {
$_ = PDL::Core::topdl($_);
}
# Determine the number of piddles over which to thread:
my $N_extras = scalar(@extra_piddles);
croak("Currently, collate_min_max_for_many only allows up to 20 extra piddles")
if $N_extras > 20;
# Determine the dimensions of the min/max piddles, starting with the
# min/max piddles and their indices, and then moving to the extras:
my @dims = $min_to_check->dims;
my %to_consider = (min_index => $min_index
, max_to_check => $max_to_check, max_index => $max_index);
while (my ($name, $piddle) = each(%to_consider)) {
for(my $idx = 0; $idx < $piddle->ndims; $idx++) {
my $dim = $piddle->dim($idx);
# Some sanity checks
if (not exists $dims[$idx] or $dims[$idx] == 1) {
$dims[$idx] = $dim;
}
elsif($dim != 1 and $dims[$idx] != $dim) {
croak("Index mismatch in collate_min_max_wrt_many for piddle $name:\n"
. " Expected dim($idx) = $dims[$idx] but got $dim")
}
}
}
# Next, check the extra dimensions.
for (my $piddle_count = 0; $piddle_count < @extra_piddles; $piddle_count++) {
my $piddle = $extra_piddles[$piddle_count];
for(my $idx = 0; $idx < $piddle->ndims; $idx++) {
my $dim = $piddle->dim($idx);
# Some sanity checks
if (not exists $dims[$idx] or $dims[$idx] == 1) {
$dims[$idx] = $dim;
}
elsif($dim != 1 and $dims[$idx] != $dim) {
croak("Index mismatch in collate_min_max_wrt_many for extra piddle $piddle_count:\n"
. " Expected dim($idx) = $dims[$idx] but got $dim");
}
}
}
# We'll be threading over the first dimension, so get rid of that:
shift @dims;
# Build the min and max piddles:
my $min = zeroes($N_pixels+1, @dims)->setvaltobad(0);
my $max = $min->copy;
$min_to_check->badflag(1);
# Pad out the list of extra piddles so the threading engine has piddles
# to handle:
while(@extra_piddles < 20) {
push @extra_piddles, zeroes(1);
}
# Call the underlying PP function
PDL::_collate_min_max_wrt_many_int($min_to_check, $min_index,
$max_to_check, $max_index, @extra_piddles, $min, $max, $N_extras);
# Return the results
return ($min, $max);
}
ModuleMaterial
);
#################
# trim_collated #
#################
=head2 trim_collated_min
=cut
pp_def('trim_collated_min',
Pars => 'minima(m, a=3); int [o] min_mask(m)',
# Here, the zeroeth column holds the original data, the first column
# holds the pixel width, and the second column holds the computed values
Code => q{
$GENERIC(minima) min;
int countdown, M;
M = $SIZE(m);
threadloop %{
min = $minima(m => M-1,a=>2);
/* Always keep the highest one */
$min_mask(m=>M-1) = 1;
/* Run through, from the top to the bottom, */
for (countdown = M-2; countdown >= 0; countdown--) {
if ($minima(m=>countdown,a=>2) < min) {
$min_mask(m=>countdown) = 1;
min = $minima(m=>countdown,a=>2);
}
else {
$min_mask(m=>countdown) = 0;
}
}
%}
},
Doc => q{
=pod
=for ref
Returns a mask to trim a collated list of minima so that the resulting
(masked off) entries are in strictly decreasing order with increasing index.
working here - this needs documentation
=cut
},
);
=head2 trim_collated_max
=cut
pp_def('trim_collated_max',
Pars => 'maxima(n, a=3); int [o] max_mask(n)',
# Here, the zeroeth column holds the original data, the first column
# holds the pixel width, and the second column holds the computed values
# Good code.
Code => q{
$GENERIC(maxima) max;
int countdown, N;
N = $SIZE(n);
threadloop %{
max = $maxima(n => N-1,a=>2);
/* Always keep the highest one */
$max_mask(n=>N-1) = 1;
/* Run through, from the top to the bottom, */
for (countdown = N-2; countdown >= 0; countdown--) {
if ($maxima(n=>countdown,a=>2) > max ) {
$max_mask(n=>countdown) = 1;
max = $maxima(n=>countdown,a=>2);
}
else {
$max_mask(n=>countdown) = 0;
}
}
%}
},
Doc => q{
=pod
=for ref
Returns a mask to trim a collated list so that the resulting (masked off)
entries are in strictly decreasing extremeness with increasing index.
working here - this needs documentation
=cut
},
);