| Category: | Miscellaneous |
| Author/Contact Info | rjray |
| Description: | This is something I recently found while "cleaning house" in my /home prior to a disk upgrade. It reads the data parts of an XPM file and gives a simple accounting of the colors used in the pixmap, sorted in descending order of frequency. It's short and simple, so you should be able to adopt and/or adapt whatever parts you may have need for into other areas. My original reasoning for it was when I was more fond of using background images on webpages. I tended to use marble patterns, faux-paper patterns, etc. I wanted to set a background color that was as close to the overall image as possible, so that people having network problems could still read the text even if the background hadn't loaded yet. Nothing worse than yellow text on a white background while you wait for that near-black background tile to finish loading. Basically, I grew tired of loading the image in sxpm or XV and rolling the mouse over it while guessing at which of the color specs was really showing up the most. --rjray |
#!/usr/bin/perl
use strict;
my $file = shift || die "USAGE: $0 filename [ max_number_to_show ]";
my $most = shift || 0;
open(F, "< $file"); die "Error opening $file: $!, stopped" if $?;
my @lines = map { /^\s*(".*"),?/ ? $1 : () } (<F>);
close(F);
# First line is xy-size, numcolors and char-width
my ($x, $y, $num, $wc) = shift(@lines) =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\d
++)/;
die "$file: data line malformed, stopped" unless ($x && $y && $num &&
+$wc);
my %colors;
# Build color table
for my $i (1 .. $num)
{
die "$file: color spec line #$i malformed, stopped"
unless (shift(@lines) =~ /^"(.).*c\s+(\S+)/i);
$colors{$1} = $2;
}
my (%color_count, $color, @line);
for my $line (1 .. $y)
{
die "$file: Data line #$line malformed, stopped"
unless ($lines[$line - 1] =~ /^"(.*)"$/ && (length($1) == $x*$
+wc));
@line = split(//, $1);
while (length($color = join('', splice(@line, 0, $wc))) == $wc)
{
$color_count{$color}++;
}
}
my @sorted = sort { $color_count{$b} <=> $color_count{$a} } keys %colo
+r_count;
# If specified, show only $most values
@sorted = splice(@sorted, 0, $most) if $most;
print "Color Frequency\n";
for (@sorted)
{
printf("%-20s %d\n",
($colors{$_} =~ /none/i ? 'None (transparent)' : $colors{$_
+}),
$color_count{$_});
}
exit;
|
|
|
|---|