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