Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

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

Comment on XPM (X Pixmap) stats
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (6)
As of 2014-12-27 09:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (176 votes), past polls