"Fossies" - the Fresh Open Source Software Archive

Member "PDL-2.080/GENERATED/PDL/ImageRGB.pm" (28 May 2022, 6895 Bytes) of package /linux/misc/PDL-2.080.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "ImageRGB.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.079_vs_2.080.

    1 #
    2 # GENERATED WITH PDL::PP! Don't modify!
    3 #
    4 package PDL::ImageRGB;
    5 
    6 our @EXPORT_OK = qw(interlrgb rgbtogr bytescl cquant  cquant_c );
    7 our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
    8 
    9 use PDL::Core;
   10 use PDL::Exporter;
   11 use DynaLoader;
   12 
   13 
   14    
   15    our @ISA = ( 'PDL::Exporter','DynaLoader' );
   16    push @PDL::Core::PP, __PACKAGE__;
   17    bootstrap PDL::ImageRGB ;
   18 
   19 
   20 
   21 
   22 
   23 
   24 #line 9 "imagergb.pd"
   25 
   26 use strict;
   27 use warnings;
   28 
   29 =head1 NAME
   30 
   31 PDL::ImageRGB -- some utility functions for RGB image data handling
   32 
   33 =head1 DESCRIPTION
   34 
   35 Collection of a few commonly used routines involved in handling of RGB, palette
   36 and grayscale images. Not much more than a start. Should be a good place to
   37 exercise some of the broadcast/map/clump PP stuff.
   38 
   39 Other stuff that should/could go here:
   40 
   41 =over 3
   42 
   43 =item *
   44 color space conversion
   45 
   46 =item *
   47 common image filters
   48 
   49 =item *
   50 image rebinning
   51 
   52 =back
   53 
   54 =head1 SYNOPSIS
   55 
   56  use PDL::ImageRGB;
   57 
   58 =cut
   59 
   60 
   61 use vars qw( $typecheck $EPS );
   62 
   63 use PDL::Core;
   64 use PDL::Basic;
   65 use PDL::Primitive;
   66 use PDL::Types;
   67 
   68 use Carp;
   69 use strict 'vars';
   70 
   71 
   72 $PDL::ImageRGB::EPS = 1e-7;     # there is probably a more portable way
   73 
   74 =head1 FUNCTIONS
   75 
   76 =head2 cquant
   77 
   78 =for ref
   79 
   80 quantize and reduce colours in 8-bit images
   81 
   82 =for usage
   83 
   84     ($out, $lut) = cquant($image [,$ncols]);
   85 
   86 This function does color reduction for <=8bit displays and accepts 8bit RGB
   87 and 8bit palette images. It does this through an interface to the ppm_quant
   88 routine from the pbmplus package that implements the median cut routine which
   89 intellegently selects the 'best' colors to represent your image on a <= 8bit
   90 display (based on the median cut algorithm). Optional args: $ncols sets the
   91 maximum nunmber of colours used for the output image (defaults to 256).
   92 There are images where a different color
   93 reduction scheme gives better results (it seems this is true for images
   94 containing large areas with very smoothly changing colours).
   95 
   96 Returns a list containing the new palette image (type PDL_Byte) and the RGB
   97 colormap.
   98 
   99 =cut
  100 
  101 # full broadcasting support intended
  102 *cquant = \&PDL::cquant;
  103 sub PDL::cquant {
  104     barf 'Usage: ($out,$olut) = cquant($image[,$ncols])'
  105        if $#_<0 || $#_>1;
  106     my $image = shift;
  107     my $ncols;
  108     if ($#_ >= 0 ) { $ncols=shift; } else { $ncols = 256; };
  109     my @Dims = $image->dims;
  110     my ($out, $olut) = (null,null);
  111 
  112     barf "input must be byte (3,x,x)" if (@Dims < 2) || ($Dims[0] != 3)
  113         || ($image->get_datatype != $PDL_B);
  114     cquant_c($image,$out,$olut,$ncols);
  115     return ($out,$olut);
  116 }
  117 
  118 
  119 =head2 interlrgb
  120 
  121 =for ref
  122 
  123 Make an RGB image from a palette image and its lookup table.
  124 
  125 =for usage
  126 
  127     $rgb = $palette_im->interlrgb($lut)
  128 
  129 Input should be of an integer type and the lookup table (3,x,...). Will perform
  130 the lookup for any N-dimensional input pdl (i.e. 0D, 1D, 2D, ...). Uses the
  131 index command but will not dataflow by default. If you want it to dataflow the
  132 dataflow_forward flag must be set in the $lut ndarray (you can do that by saying
  133 $lut->set_dataflow_f(1)).
  134 
  135 =cut
  136 
  137 # interlace a palette image, input as 8bit-image, RGB-lut (3,x,..) to
  138 # (R,G,B) format for each pixel in the image
  139 # should already support broadcasting
  140 *interlrgb=\&PDL::interlrgb;
  141 sub PDL::interlrgb {
  142     my ($pdl,$lut) = @_;
  143     my $res;
  144     # for our purposes $lut should be (3,z) where z is the number
  145     # of colours in the lut
  146     barf "expecting (3,x) input" if ($lut->dims)[0] != 3;
  147     # do the conversion as an implicitly broadcasted index lookup
  148     if ($lut->fflows) {
  149       $res = $lut->transpose->index($pdl->dummy(0));
  150     } else {
  151       $res = $lut->transpose->index($pdl->dummy(0))->sever;
  152     }
  153     return $res;
  154 }
  155 
  156 
  157 =head2 rgbtogr
  158 
  159 =for ref
  160 
  161 Converts an RGB image to a grey scale using standard transform
  162 
  163 =for usage
  164 
  165    $gr = $rgb->rgbtogr
  166 
  167 Performs a conversion of an RGB input image (3,x,....) to a
  168 greyscale image (x,.....) using standard formula:
  169 
  170    Grey = 0.301 R + 0.586 G + 0.113 B
  171 
  172 =cut
  173 
  174 # convert interlaced rgb image to grayscale
  175 # will convert any (3,...) dim pdl, i.e. also single lines,
  176 # stacks of RGB images, etc since implicit broadcasting takes care of this
  177 # should already support broadcasting
  178 *rgbtogr = \&PDL::rgbtogr;
  179 sub PDL::rgbtogr {
  180     barf "Usage: \$im->rgbtogr" if $#_ < 0;
  181     my $im = shift;
  182     barf "rgbtogr: expecting RGB (3,...) input"
  183          if (($im->dims)[0] != 3);
  184 
  185     my $type = $im->get_datatype;
  186     my $rgb = float([77,150,29])/256;  # vector for rgb conversion
  187     my $oim = null;  # flag PP we want it to allocate
  188     inner($im,$rgb,$oim); # do the conversion as a broadcasted inner prod
  189 
  190     return $oim->convert($type);  # convert back to original type
  191 }
  192 
  193 =head2 bytescl
  194 
  195 =for ref
  196 
  197 Scales a pdl into a specified data range (default 0-255)
  198 
  199 =for usage
  200 
  201     $scale = $im->bytescl([$top])
  202 
  203 By default $top=255, otherwise you have to give the desired top value as an
  204 argument to C<bytescl>. Normally C<bytescl> doesn't rescale data that fits
  205 already in the bounds 0..$top (it only does the type conversion if required).
  206 If you want to force it to rescale so that the max of the output is at $top and
  207 the min at 0 you give a negative $top value to indicate this.
  208 
  209 =cut
  210 
  211 # scale any pdl linearly so that its data fits into the range
  212 # 0<=x<=$ncols where $ncols<=255
  213 # returns scaled data with type converted to byte
  214 # doesn't rescale but just typecasts if data already fits into range, i.e.
  215 # data ist not necessarily stretched to 0..$ncols
  216 # needs some changes for full broadcasting support ?? (explicit broadcasting?)
  217 *bytescl = \&PDL::bytescl;
  218 sub PDL::bytescl {
  219     barf 'Usage: bytescl $im[,$top]' if $#_ < 0;
  220     my $pdl = shift;
  221     my ($top,$force) = (255,0);
  222     $top = shift if $#_ > -1;
  223     if ($top < 0) { $force=1; $top *= -1; }
  224     $top = 255 if $top > 255;
  225 
  226     print "bytescl: scaling from 0..$top\n" if $PDL::debug;
  227     my ($max, $min);
  228     $max = max $pdl;
  229     $min = min $pdl;
  230     return byte $pdl if ($min >= 0  && $max <= $top && !$force);
  231 
  232     # check for pathological cases
  233     if (($max-$min) < $EPS) {
  234     print "bytescl: pathological case\n" if $PDL::debug;
  235     return byte $pdl
  236         if (abs($max) < $EPS) || ($max >= 0 && $max <= $top);
  237     return byte ($pdl/$max);
  238     }
  239 
  240     my $type = $pdl->get_datatype > $PDL_F ? $PDL_D : $PDL_F;
  241     return byte ($top*($pdl->convert($type)-$min)/($max-$min)+0.5);
  242 }
  243 
  244 ;# Exit with OK status
  245 
  246 1;
  247 
  248 =head1 BUGS
  249 
  250 This package doesn't yet contain enough useful functions!
  251 
  252 =head1 AUTHOR
  253 
  254 Copyright 1997 Christian Soeller <c.soeller@auckland.ac.nz>
  255 All rights reserved. There is no warranty. You are allowed
  256 to redistribute this software / documentation under certain
  257 conditions. For details, see the file COPYING in the PDL
  258 distribution. If this file is separated from the PDL distribution,
  259 the copyright notice should be included in the file.
  260 
  261 
  262 =cut
  263 #line 264 "ImageRGB.pm"
  264 
  265 
  266 
  267 
  268 
  269 
  270 
  271 #line 950 "../../blib/lib/PDL/PP.pm"
  272 
  273 *cquant_c = \&PDL::cquant_c;
  274 #line 275 "ImageRGB.pm"
  275 
  276 
  277 
  278 
  279 
  280 
  281 # Exit with OK status
  282 
  283 1;