This file is indexed.

/usr/share/perl5/Math/Gradient.pm is in libmath-gradient-perl 0.04-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
package Math::Gradient;
use strict;
use warnings;

=head1 NAME

Math::Gradient - Perl extension for calculating gradients for colour transitions, etc.

=head1 SYNOPSIS

use Math::Gradient qw(multi_gradient);

# make a 100-point colour palette to smothly transition between 6 RGB values

my(@hot_spots) = ([ 0, 255, 0 ], [ 255, 255, 0 ], [ 127, 127, 127 ], [ 0, 0, 255 ], [ 127, 0, 0 ], [ 255, 255, 255 ]);

my(@gradient) = multi_array_gradient(100, @hot_spots);

=head1 DESCRIPTION

Math::Gradient is used to calculate smooth transitions between numerical values (also known as a "Gradient"). I wrote this module mainly to mix colours, but it probably has several other applications. Methods are supported to handle both basic and multiple-point gradients, both with scalars and arrays.

=head1 FUNCTIONS

=over 4

=item gradient($start_value, $end_value, $steps)

This function will return an array of evenly distributed values between $start_value and $end_value. All three values supplied should be numeric. $steps should be the number of steps that should occur  between the two points; for instance, gradient(0, 10, 4) would return the array (2, 4, 6, 8); the 4 evenly-distributed steps necessary to get from 0 to 10, whereas gradient(0, 1, 3) would return (0.25, 0.5, 0.75). This is the basest function in the Math::Gradient module and isn't very exciting, but all of the other functions below derive their work from it.

=item array_gradient($start_value, $end_value, $steps)

While gradient() takes numeric values for $start_value and $end_value, array_gradient() takes arrayrefs instead. The arrays supplied are expected to be lists of numerical values, and all of the arrays should contain the same number of elements. array_gradient() will return a list of arrayrefs signifying the gradient of all values on the lists $start_value and $end_value.

For example, calling array_gradient([ 0, 100, 2 ], [ 100, 50, 70], 3) would return: ([ 25, 87.5, 19 ], [ 50, 75, 36 ], [ 75, 62.5, 53 ]).

=item multi_gradient($steps, @values)

multi_gradient() calculates multiple gradients at once, returning one list that is an even transition between all points, with the values supplied interpolated evenly within the list. If $steps is less than the number of entries in the list @values, items are deleted from @values instead.

For example, calling multi_gradient(10, 0, 100, 50) would return: (0, 25, 50, 75, 100, 90, 80, 70, 60, 50)

=item multi_array_gradient($steps, @values)

multi_array_gradient() is the same as multi_gradient, except that it works on arrayrefs instead of scalars (like array_gradient() is to gradient()).

=back
  
=cut  

use 5.005;
use strict;
use warnings;

require Exporter;

sub gradient ($$$);
sub array_gradient ($$$);
sub multi_array_gradient ($@);
sub multi_gradient ($@);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Math::Gradient ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	gradient array_gradient multi_gradient multi_array_gradient
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);

our $VERSION = '0.04';


# Preloaded methods go here.

# Math::Gradient

# Take sets of numbers and a specified number of steps, and return a
# gradient for going betewen those steps

# for example,

# [ 2, 4, 6 ], [ 4, 8, 12 ], [ 16, 32, 48 ] with 5 steps would result in

# [ 2, 4, 6 ], [ 3, 6, 9 ], [ 4, 8, 12 ], [ 10, 24, 30 ], [ 16, 32, 48 ]

# This involves two distinct steps;
# making a gradient between two points,
# and calculating the gradient between X points.


# To make a gradient between two points, we are given the points,
# and the number of steps to create between them.


# basic_gradient - get start and end number and # of steps to
# create in-between the two. returns an array of the intermediary steps.
sub gradient ($$$)
{
 my($low, $high, $steps) = @_;
 my $xsteps = $steps + 1; # steps incl. low
 my $xdistance = $high - $low; # distance; may be negative
 my $step_value = $xdistance/$xsteps; # how much to add to each step to create a gradient
 my $value = $low; # start off with the starting value
 
 my @values;
 foreach my $step (1 .. $steps)
 {
  $value += $step_value;
  push(@values, $value);
 }
 return(@values); # we have a gradient!
}

# takes two arrayrefs, and # of steps. arrayrefs should have same number
# of values in each.
sub array_gradient ($$$)
{
 my($low, $high, $steps) = @_;
 my(@values);
 my $g_count = scalar(@$low);
 foreach my $x (1 .. scalar(@$low))
 {
  my(@y) = (gradient($low->[$x - 1], $high->[$x - 1], $steps));
  foreach my $y (1 .. scalar(@y))
  {
   $values[$y - 1] ||= [];
   push(@{$values[$y - 1]}, $y[$y - 1]);
  }
 }
 return(@values);
}

# takes a number of steps and any number of steps already filled in (at least two)
# returns the full gradient, including supplied steps

sub multi_array_gradient ($@)
{
 my($steps, @start_steps) = @_;
 if($steps == scalar(@start_steps))
 {
  return(@start_steps); # already have the # of steps we want
 }
 my @values;
 # "steppage" is how many steps we should request on average between
 # steps we've been supplied.
 my $steppage = ($steps - scalar(@start_steps)) / (scalar(@start_steps) - 1);
 my $steps_left = $steps - scalar(@start_steps);
 my $xstep = 0;
 while(my $cstep = shift(@start_steps))
 {
  push(@values, $cstep);
  $xstep += $steppage;
  if(@start_steps && $xstep >= 1)
  {
   my $xxstep = int($xstep);
   $xstep -= $xxstep;
   $steps_left -= $xxstep;
   push(@values, array_gradient($cstep, $start_steps[0], $xxstep));
  }
  elsif(@start_steps && $xstep <= 1)
  {
   my $xxstep = int($xstep);
   $xstep -= $xxstep;
   $steps_left -= $xxstep;
   splice(@values, scalar(@values) + $xxstep, abs($xxstep));
  }
 }
 return(@values);
}

sub multi_gradient ($@)
{
 my($steps, @start_steps) = (@_);
 if($steps == scalar(@start_steps))
 {
  return(@start_steps); # already have the # of steps we want
 }
 my @values;
 # "steppage" is how many steps we should request on average between
 # steps we've been supplied.
 my $steppage = ($steps - scalar(@start_steps)) / (scalar(@start_steps) - 1);
 my $steps_left = $steps - scalar(@start_steps);
 my $xstep = 0;
 while(scalar(@start_steps))
 {
  my $cstep = shift(@start_steps);
  push(@values, $cstep);
  $xstep += $steppage;
  if(@start_steps && $xstep >= 1)
  {
   my $xxstep = int($xstep);
   $xstep -= $xxstep;
   $steps_left -= $xxstep;
   push(@values, gradient($cstep, $start_steps[0], $xxstep));
  }
  elsif(@start_steps && $xstep <= 1)
  {
   my $xxstep = int($xstep);
   $xstep -= $xxstep;
   $steps_left -= $xxstep;
   splice(@values, scalar(@values) + $xxstep, abs($xxstep));
  }
 }
 return(@values);
}


1;
__END__
# Below is stub documentation for your module. You'd better edit it!



=head1 AUTHOR

Tyler MacDonald, E<lt>japh@crackerjack.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2003 by Tyler MacDonald

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut