Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

XPM (X Pixmap) stats

by rjray (Chaplain)
on Feb 20, 2002 at 07:51 UTC ( [id://146517]=sourcecode: print w/replies, xml ) Need Help??
Category: Miscellaneous
Author/Contact Info rjray

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.



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

# 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 && 
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*$
    @line = split(//, $1);
    while (length($color = join('', splice(@line, 0, $wc))) == $wc)

my @sorted = sort { $color_count{$b} <=> $color_count{$a} } keys %colo
# 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{$_


Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://146517]
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (7)
As of 2024-04-25 08:23 GMT
Find Nodes?
    Voting Booth?

    No recent polls found