Thank you, this is wonderful!
I'm using it as:
sub palette_rgb_gd {
my $abs_path = _abs_path($_[0]) or return;
my @colors;
require GD;
my $img = GD::Image->new( $abs_path ) or die $!;
my $colors = $img->colorsTotal
or carp("$abs_path is a truecolor image (no palette)?");
for ( 0 .. $colors ) {
my $rgb = sprintf '%02x%02x%02x', $img->rgb( $_ );
#debug( $rgb);
#printf "%5d: R:%2x G:%2x B:%2x\n", $_, $img->rgb( $_ );
push @colors , $rgb;
}
return @colors;
}
This is way better than what I was doing before!
sub identify_im {
my $abs_path = _abs_path($_[0]) or return;
my %HASH;
my $cmd = "identify -verbose '$abs_path'";
my @_i = split(/\n/, `$cmd`);
if( $? ){ carp("problem with : $cmd, $abs_path, $?") and return; }
@_i and scalar @_i or carp("no output with : $cmd, $abs_path") and
+return;
my $lastkey;
for my $_line (@_i){
$_line=~s/^\s+|\s+$//g;
$_line=~s/([^\:]+)\://;
my($k,$v) = ($1,$_line);
if ($k=~/^Histogram$|^Colormap$/){
$HASH{$k}={};
$lastkey =$k;
}
elsif($lastkey=~/^Histogram$|^Colormap$/ and $k=~/^\d+$/ ){
$HASH{$lastkey}->{$k} = $v;
}
else {
$HASH{$k}= $v;
$lastkey = $k;
}
}
return \%HASH;
}
sub palette_rgb_im {
my $abs_path = _abs_path($_[0]) or return;
my $h = identify_im($abs_path) or return;
my $colors = $h->{Colormap} || $h->{Histogram} ;
$colors or carp("No Colormap or Historgram in $abs_path") and retur
+n;
my @colors;
for ( keys %$colors ){
my $_line = $colors->{$_};
$_line=~/\(\s*([0-9]+),\s*([0-9]+),\s*([0-9]+)\)/ or die("cant m
+atch into $_line");
my ($r,$g,$b) = ($1,$2,$3);
debug( "$r $g $b");
#push @colors, "$r$g$b";
my $rgb = sprintf '%2x%2x%2x', $r, $g , $b;
push @colors, $rgb;
}
return @colors;
}
|