misc/tools/fiximage.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 # Usage:
   7 #   convert image.tga -depth 8 RGBA:- | perl fiximage.pl 72 | convert -depth 8 -size 72x56 RGBA:- output.tga
   8
   9 my ($width) = @ARGV;
  10
  11 my @pixels = ();
  12
  13 for(;;)
  14 {
  15         read STDIN, my $data, 4
  16                 or last;
  17         my ($r, $g, $b, $a) = unpack "CCCC", $data;
  18         push @pixels, [$r, $g, $b, $a];
  19 }
  20
  21 my $height = @pixels / $width;
  22 my @fixlater;
  23 for my $y(0..($height-1))
  24 {
  25         for my $x(0..($width-1))
  26         {
  27                 next
  28                         if $pixels[$x + $y * $width][3] != 0;
  29                 # alpha is zero? Replace by weighted average.
  30                 my ($r, $g, $b, $a) = (0, 0, 0);
  31                 for my $dy(-1..1)
  32                 {
  33                         next if $y + $dy < 0;
  34                         next if $y + $dy >= $height;
  35                         for my $dx(-1..1)
  36                         {
  37                                 next if $x + $dx < 0;
  38                                 next if $x + $dx >= $width;
  39                                 my $pix = $pixels[($x + $dx) + ($y + $dy) * $width];
  40                                 $r += $pix->[0] * $pix->[3];
  41                                 $g += $pix->[1] * $pix->[3];
  42                                 $b += $pix->[2] * $pix->[3];
  43                                 $a += $pix->[3];
  44                         }
  45                 }
  46                 if($a == 0)
  47                 {
  48                         push @fixlater, [$x, $y];
  49                         $pixels[$x + $y * $width] = [0, 0, 0, 0, undef];
  50                         next;
  51                 }
  52                 $r = int ($r / $a);
  53                 $g = int ($g / $a);
  54                 $b = int ($b / $a);
  55                 print STDERR "Fixing ($x, $y -> $r, $g, $b, $a)\n";
  56                 $pixels[$x + $y * $width] = [$r, $g, $b, 0];
  57         }
  58 }
  59
  60 while(@fixlater)
  61 {
  62         print STDERR "Pixels left: ", scalar(@fixlater), "\n";
  63
  64         # These pixels have no neighbors with a non-zero alpha.
  65         my @fixels = @fixlater;
  66         @fixlater = ();
  67         my @pixelsorig = @pixels;
  68         for(@fixels)
  69         {
  70                 my ($x, $y) = @$_;
  71                 my ($r, $g, $b, $a) = (0, 0, 0, 0);
  72                 for my $dy(-1..1)
  73                 {
  74                         next if $y + $dy < 0;
  75                         next if $y + $dy >= $height;
  76                         for my $dx(-1..1)
  77                         {
  78                                 next if $x + $dx < 0;
  79                                 next if $x + $dx >= $width;
  80                                 my $pix = $pixelsorig[($x + $dx) + ($y + $dy) * $width];
  81                                 next
  82                                         if @$pix == 5;
  83                                 $r += $pix->[0];
  84                                 $g += $pix->[1];
  85                                 $b += $pix->[2];
  86                                 $a += 1;
  87                         }
  88                 }
  89                 if($a == 0)
  90                 {
  91                         push @fixlater, [$x, $y];
  92                         next;
  93                 }
  94                 $r = int ($r / $a);
  95                 $g = int ($g / $a);
  96                 $b = int ($b / $a);
  97                 #print STDERR "Fixing later ($x, $y -> $r, $g, $b, $a)\n";
  98                 $pixels[$x + $y * $width] = [$r, $g, $b, 0];
  99         }
 100 }
 101
 102 for(@pixels)
 103 {
 104         print pack "CCCC", @$_;
 105 }