/[perl]/xvpictoxpm.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /xvpictoxpm.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (vendor branch)
Thu Jun 14 11:50:21 2001 UTC (17 years, 11 months ago) by dpavlin
Branch: DbP, MAIN
CVS Tags: a, HEAD
Changes since 1.1: +0 -0 lines
File MIME type: text/plain
initial import

1 #!/usr/bin/perl -w
2
3 # xvpictoxpm.pl
4
5 # by Dobrica Pavlinusic <dpavlin@rot13.org> 2001-06-14
6 # based on info from xvthumb.c GIMP plugin, placed under GPL
7
8 # reads XV thumnail (from .xvpics directory) and dumps xpm to stdout (and
9 # errors/warnings to stderr)
10
11 use strict;
12
13 my $xv_pic=".xvpics/0610_011.jpg";
14
15 $xv_pic = $ARGV[0] if ($ARGV[0]);
16
17 my ($w,$h,$cols) = (0,0,0);
18 my @xv_pix;
19
20 open(XV,$xv_pic) || die "$xv_pic: $!";
21 my $l=<XV>; chomp $l;
22 die "$xv_pic not XV thumbnail file ($l)" if ($l!~m/^P7 332$/);
23 while(<XV>) {
24 chomp;
25 next if (/^#/);
26 if (/^(\d+) (\d+) (\d+)$/) {
27 ($w,$h,$cols) = ($1,$2,$3);
28 last;
29 }
30 print STDERR "--$_--\n";
31 }
32
33 warn "$xv_pic number of colors is not 255 (strange)" if ($cols != 255);
34
35 my $buf; # tmp buffer for read;
36
37 # read pixels
38 read XV,$buf,($w*$h);
39 @xv_pix=unpack("C*",$buf);
40
41 print STDERR "$w $h $cols $#xv_pix (",length($buf)," bytes) file pos: ",tell(XV),"\n";
42
43 #/* width height ncolors chars_per_pixel */
44 my @xpm_data= ( "$w $h 256 2" );
45
46 # Generate 332 colour-cube colourmap
47 for (my $i=0; $i<256; $i++) {
48
49 push(@xpm_data,sprintf ("%02x c #%02x%02x%02x",$i,
50 (255*(($i&(7<<5))>>5))/7,
51 (255*(($i&(7<<2))>>2))/7,
52 (255*(($i&(3<<0))>>0))/3
53 ));
54 }
55
56 my @xpm;
57 my $pix = 0;
58
59 for(my $y=0; $y<$h; $y++) {
60 for (my $x=0; $x<$w; $x++) {
61 if (defined($xv_pix[$y*$w+$x])) {
62 $pix++;
63 $xpm[$y*$w+$x] = sprintf("%02x",$xv_pix[$y*$w+$x]);
64 } else {
65 print STDERR "undef pixel $x,$y!\n";
66 }
67 }
68 }
69
70 print STDERR " w: $w h: $h pixela: $pix\n";
71
72 my $tmp=join('',@xpm);
73
74 print STDERR " xpm pixels len: ",length($tmp)," (should be ",$w*$h*2,")\n";
75
76 my $lw=$w*2;
77 while ($tmp=~s/^(.{$lw})//) {
78 push(@xpm_data,$1);
79 }
80 if ($tmp) { # this shouldn't happend!
81 push(@xpm_data,$tmp); # push rest of line
82 }
83
84 print "/* XPM */\nstatic char *noname[] = {\n";
85 foreach (@xpm_data) {
86 print "\"$_\",\n";
87 }
88 print "};\n";

  ViewVC Help
Powered by ViewVC 1.1.26