(Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).
| ImageRGB.pm (PDL-2.074) | : | ImageRGB.pm (PDL-2.075) |
|---|
| | |
| skipping to change at line 17 | | skipping to change at line 17 |
|---|
| our %EXPORT_TAGS = (Func=>\@EXPORT_OK); | | our %EXPORT_TAGS = (Func=>\@EXPORT_OK); |
| | |
| use PDL::Core; | | use PDL::Core; |
| use PDL::Exporter; | | use PDL::Exporter; |
| use DynaLoader; | | use DynaLoader; |
| | |
| our @ISA = ( 'PDL::Exporter','DynaLoader' ); | | our @ISA = ( 'PDL::Exporter','DynaLoader' ); |
| push @PDL::Core::PP, __PACKAGE__; | | push @PDL::Core::PP, __PACKAGE__; |
| bootstrap PDL::ImageRGB ; | | bootstrap PDL::ImageRGB ; |
| | |
|
| #line 10 "imagergb.pd" | | #line 9 "imagergb.pd" |
| | |
| use strict; | | use strict; |
| use warnings; | | use warnings; |
| | |
| =head1 NAME | | =head1 NAME |
| | |
| PDL::ImageRGB -- some utility functions for RGB image data handling | | PDL::ImageRGB -- some utility functions for RGB image data handling |
| | |
| =head1 DESCRIPTION | | =head1 DESCRIPTION |
| | |
| Collection of a few commonly used routines involved in handling of RGB, palette | | Collection of a few commonly used routines involved in handling of RGB, palette |
| and grayscale images. Not much more than a start. Should be a good place to | | and grayscale images. Not much more than a start. Should be a good place to |
|
| exercise some of the thread/map/clump PP stuff. | | exercise some of the broadcast/map/clump PP stuff. |
| | |
| Other stuff that should/could go here: | | Other stuff that should/could go here: |
| | |
| =over 3 | | =over 3 |
| | |
| =item * | | =item * |
| color space conversion | | color space conversion |
| | |
| =item * | | =item * |
| common image filters | | common image filters |
| | |
| skipping to change at line 91 | | skipping to change at line 92 |
|---|
| maximum nunmber of colours used for the output image (defaults to 256). | | maximum nunmber of colours used for the output image (defaults to 256). |
| There are images where a different color | | There are images where a different color |
| reduction scheme gives better results (it seems this is true for images | | reduction scheme gives better results (it seems this is true for images |
| containing large areas with very smoothly changing colours). | | containing large areas with very smoothly changing colours). |
| | |
| Returns a list containing the new palette image (type PDL_Byte) and the RGB | | Returns a list containing the new palette image (type PDL_Byte) and the RGB |
| colormap. | | colormap. |
| | |
| =cut | | =cut |
| | |
|
| # full threading support intended | | # full broadcasting support intended |
| *cquant = \&PDL::cquant; | | *cquant = \&PDL::cquant; |
| sub PDL::cquant { | | sub PDL::cquant { |
| barf 'Usage: ($out,$olut) = cquant($image[,$ncols])' | | barf 'Usage: ($out,$olut) = cquant($image[,$ncols])' |
| if $#_<0 || $#_>1; | | if $#_<0 || $#_>1; |
| my $image = shift; | | my $image = shift; |
| my $ncols; | | my $ncols; |
| if ($#_ >= 0 ) { $ncols=shift; } else { $ncols = 256; }; | | if ($#_ >= 0 ) { $ncols=shift; } else { $ncols = 256; }; |
| my @Dims = $image->dims; | | my @Dims = $image->dims; |
| my ($out, $olut) = (null,null); | | my ($out, $olut) = (null,null); |
| | |
| | |
| skipping to change at line 128 | | skipping to change at line 129 |
|---|
| Input should be of an integer type and the lookup table (3,x,...). Will perform | | Input should be of an integer type and the lookup table (3,x,...). Will perform |
| the lookup for any N-dimensional input pdl (i.e. 0D, 1D, 2D, ...). Uses the | | the lookup for any N-dimensional input pdl (i.e. 0D, 1D, 2D, ...). Uses the |
| index command but will not dataflow by default. If you want it to dataflow the | | index command but will not dataflow by default. If you want it to dataflow the |
| dataflow_forward flag must be set in the $lut ndarray (you can do that by saying | | dataflow_forward flag must be set in the $lut ndarray (you can do that by saying |
| $lut->set_dataflow_f(1)). | | $lut->set_dataflow_f(1)). |
| | |
| =cut | | =cut |
| | |
| # interlace a palette image, input as 8bit-image, RGB-lut (3,x,..) to | | # interlace a palette image, input as 8bit-image, RGB-lut (3,x,..) to |
| # (R,G,B) format for each pixel in the image | | # (R,G,B) format for each pixel in the image |
|
| # should already support threading | | # should already support broadcasting |
| *interlrgb=\&PDL::interlrgb; | | *interlrgb=\&PDL::interlrgb; |
| sub PDL::interlrgb { | | sub PDL::interlrgb { |
| my ($pdl,$lut) = @_; | | my ($pdl,$lut) = @_; |
| my $res; | | my $res; |
| # for our purposes $lut should be (3,z) where z is the number | | # for our purposes $lut should be (3,z) where z is the number |
| # of colours in the lut | | # of colours in the lut |
| barf "expecting (3,x) input" if ($lut->dims)[0] != 3; | | barf "expecting (3,x) input" if ($lut->dims)[0] != 3; |
|
| # do the conversion as an implicitly threaded index lookup | | # do the conversion as an implicitly broadcasted index lookup |
| if ($lut->fflows) { | | if ($lut->fflows) { |
| $res = $lut->transpose->index($pdl->dummy(0)); | | $res = $lut->transpose->index($pdl->dummy(0)); |
| } else { | | } else { |
| $res = $lut->transpose->index($pdl->dummy(0))->sever; | | $res = $lut->transpose->index($pdl->dummy(0))->sever; |
| } | | } |
| return $res; | | return $res; |
| } | | } |
| | |
| =head2 rgbtogr | | =head2 rgbtogr |
| | |
| | |
| skipping to change at line 164 | | skipping to change at line 165 |
|---|
| | |
| Performs a conversion of an RGB input image (3,x,....) to a | | Performs a conversion of an RGB input image (3,x,....) to a |
| greyscale image (x,.....) using standard formula: | | greyscale image (x,.....) using standard formula: |
| | |
| Grey = 0.301 R + 0.586 G + 0.113 B | | Grey = 0.301 R + 0.586 G + 0.113 B |
| | |
| =cut | | =cut |
| | |
| # convert interlaced rgb image to grayscale | | # convert interlaced rgb image to grayscale |
| # will convert any (3,...) dim pdl, i.e. also single lines, | | # will convert any (3,...) dim pdl, i.e. also single lines, |
|
| # stacks of RGB images, etc since implicit threading takes care of this | | # stacks of RGB images, etc since implicit broadcasting takes care of this |
| # should already support threading | | # should already support broadcasting |
| *rgbtogr = \&PDL::rgbtogr; | | *rgbtogr = \&PDL::rgbtogr; |
| sub PDL::rgbtogr { | | sub PDL::rgbtogr { |
| barf "Usage: \$im->rgbtogr" if $#_ < 0; | | barf "Usage: \$im->rgbtogr" if $#_ < 0; |
| my $im = shift; | | my $im = shift; |
| barf "rgbtogr: expecting RGB (3,...) input" | | barf "rgbtogr: expecting RGB (3,...) input" |
| if (($im->dims)[0] != 3); | | if (($im->dims)[0] != 3); |
| | |
| my $type = $im->get_datatype; | | my $type = $im->get_datatype; |
| my $rgb = float([77,150,29])/256; # vector for rgb conversion | | my $rgb = float([77,150,29])/256; # vector for rgb conversion |
| my $oim = null; # flag PP we want it to allocate | | my $oim = null; # flag PP we want it to allocate |
|
| inner($im,$rgb,$oim); # do the conversion as a threaded inner prod | | inner($im,$rgb,$oim); # do the conversion as a broadcasted inner prod |
| | |
| return $oim->convert($type); # convert back to original type | | return $oim->convert($type); # convert back to original type |
| } | | } |
| | |
| =head2 bytescl | | =head2 bytescl |
| | |
| =for ref | | =for ref |
| | |
| Scales a pdl into a specified data range (default 0-255) | | Scales a pdl into a specified data range (default 0-255) |
| | |
| | |
| skipping to change at line 204 | | skipping to change at line 205 |
|---|
| If you want to force it to rescale so that the max of the output is at $top and | | If you want to force it to rescale so that the max of the output is at $top and |
| the min at 0 you give a negative $top value to indicate this. | | the min at 0 you give a negative $top value to indicate this. |
| | |
| =cut | | =cut |
| | |
| # scale any pdl linearly so that its data fits into the range | | # scale any pdl linearly so that its data fits into the range |
| # 0<=x<=$ncols where $ncols<=255 | | # 0<=x<=$ncols where $ncols<=255 |
| # returns scaled data with type converted to byte | | # returns scaled data with type converted to byte |
| # doesn't rescale but just typecasts if data already fits into range, i.e. | | # doesn't rescale but just typecasts if data already fits into range, i.e. |
| # data ist not necessarily stretched to 0..$ncols | | # data ist not necessarily stretched to 0..$ncols |
|
| # needs some changes for full threading support ?? (explicit threading?) | | # needs some changes for full broadcasting support ?? (explicit broadcasting?) |
| *bytescl = \&PDL::bytescl; | | *bytescl = \&PDL::bytescl; |
| sub PDL::bytescl { | | sub PDL::bytescl { |
| barf 'Usage: bytescl $im[,$top]' if $#_ < 0; | | barf 'Usage: bytescl $im[,$top]' if $#_ < 0; |
| my $pdl = shift; | | my $pdl = shift; |
| my ($top,$force) = (255,0); | | my ($top,$force) = (255,0); |
| $top = shift if $#_ > -1; | | $top = shift if $#_ > -1; |
| if ($top < 0) { $force=1; $top *= -1; } | | if ($top < 0) { $force=1; $top *= -1; } |
| $top = 255 if $top > 255; | | $top = 255 if $top > 255; |
| | |
| print "bytescl: scaling from 0..$top\n" if $PDL::debug; | | print "bytescl: scaling from 0..$top\n" if $PDL::debug; |
| | |
| skipping to change at line 250 | | skipping to change at line 251 |
|---|
| =head1 AUTHOR | | =head1 AUTHOR |
| | |
| Copyright 1997 Christian Soeller <c.soeller@auckland.ac.nz> | | Copyright 1997 Christian Soeller <c.soeller@auckland.ac.nz> |
| All rights reserved. There is no warranty. You are allowed | | All rights reserved. There is no warranty. You are allowed |
| to redistribute this software / documentation under certain | | to redistribute this software / documentation under certain |
| conditions. For details, see the file COPYING in the PDL | | conditions. For details, see the file COPYING in the PDL |
| distribution. If this file is separated from the PDL distribution, | | distribution. If this file is separated from the PDL distribution, |
| the copyright notice should be included in the file. | | the copyright notice should be included in the file. |
| | |
| =cut | | =cut |
|
| #line 263 "ImageRGB.pm" | | #line 264 "ImageRGB.pm" |
| | |
| | #line 1060 "../../blib/lib/PDL/PP.pm" |
| | |
|
| #line 1061 "../../blib/lib/PDL/PP.pm" | | |
| *cquant_c = \&PDL::cquant_c; | | *cquant_c = \&PDL::cquant_c; |
|
| #line 273 "ImageRGB.pm" | | #line 275 "ImageRGB.pm" |
| | |
| # Exit with OK status | | # Exit with OK status |
| | |
| 1; | | 1; |
| | | |
| End of changes. 11 change blocks. |
|---|
| 12 lines changed or deleted | | 14 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 