Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

XPM (X Pixmap) stats

by rjray (Chaplain)
on Feb 20, 2002 at 07:51 UTC ( #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
Node Status?
node history
Node Type: sourcecode [id://146517]
[ovedpo15]: can't I use just use lib $FindBin::Bin/../ bin" asuming that p2 is in ./bin and p1 is in /config? it says "cant find" altought p2 is
[moritz]: ovedpo15 "use lib" is only for .pm files
[moritz]: if you don't have .pm file, you might to use "require" or "do" with an absolute path
[ovedpo15]: I need to use FindBin thought. does FindBin finds only modules? or it can find perl script also?

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (7)
As of 2018-03-17 20:45 GMT
Find Nodes?
    Voting Booth?
    When I think of a mole I think of:

    Results (226 votes). Check out past polls.