in reply to Reading an image palette

GD will do that for you:

#! perl -slw use strict; use GD; my $img = GD::Image->new( $ARGV[ 0 ] ) or die $!; my $colors = $img->colorsTotal or die "$ARGV[ 0] is a truecolor image (no palette)"; for ( 0 .. $colors ) { printf "%5d: R:%2x G:%2x B:%2x\n", $_, $img->rgb( $_ ); }

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
"Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."

Replies are listed 'Best First'.
Re^2: Reading an image palette
by leocharre (Priest) on Oct 03, 2008 at 15:49 UTC

    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; }