source: subversion/applications/rendering/png2tileinfo/pngdiff.pl @ 10854

Last change on this file since 10854 was 5991, checked in by bobkare, 12 years ago

pngdiff.pl: A script to diff two versions of oceantiles_12.png and generate a list of tiles. Written by Steinar Hamre

  • Property svn:executable set to *
File size: 2.1 KB
Line 
1
2#!/usr/bin/perl -w
3
4# This program compares two oceantiles.png-files and lists
5# the differences.
6
7# The files must be 4096x4096 pixel files for zoom-12.
8
9# based on code by Martijn van Oosterhout <kleptog@gmail.com>
10# written by Steinar Hamre <steinarh@pvv.ntnu.no>
11
12use strict;
13use LWP::Simple;
14
15use GD;
16use strict;
17use bytes;
18
19use constant TILETYPE_UNKNOWN => 0;
20use constant TILETYPE_LAND => 1;
21use constant TILETYPE_SEA => 2;
22use constant TILETYPE_TILE => 3;
23
24#
25#
26#
27sub get_type 
28{
29  my($image, $x, $y) = @_;
30
31  my($r,$g,$b) = $image->rgb( $image->getPixel( $x,$y ) );
32 
33  return TILETYPE_LAND if $r == 0 && $g == 255 && $b == 0;
34  return TILETYPE_SEA if $r == 0 && $g == 0   && $b == 255;
35  return TILETYPE_TILE if $r == 255 && $g == 255 && $b == 255;
36  return TILETYPE_UNKNOWN if $r == 0 && $g == 0 && $b == 0;
37 
38  die "Wierd tiletype at [$x,$y]: ($r,$g,$b)\n";
39}
40
41#
42#
43#
44sub set_type
45{
46  my($image, $x, $y, $type) = @_;
47  my $color;
48
49  # Resolve not Allocate so we don't run out of colors
50  $color = $image->colorResolve(0,0,255) if($type == TILETYPE_SEA);
51  $color = $image->colorResolve(0,255,0) if($type == TILETYPE_LAND);
52  $color = $image->colorResolve(255,255,255) if($type == TILETYPE_TILE);
53  die if not defined $color;
54  print STDERR "Setting $x,$y to $color\n";
55  $image->setPixel($x,$y, $color);
56}
57
58
59
60if ($#ARGV < 1) {
61    print "Usage: pngdiff.pl oldfile.png newfile.png\n";
62    exit(0);
63}
64
65my $oldfile=$ARGV[0];
66my $newfile=$ARGV[1];
67
68open my $world_fh, "<$oldfile" or die "Couldn't open $oldfile ($!)\n";
69my $world_im = GD::Image->newFromPng( $world_fh, 1 );
70close $world_fh;
71
72open my $newworld_fh, "<$newfile" or die "Couldn't open $newfile ($!)\n";
73my $newworld_im = GD::Image->newFromPng( $newworld_fh, 1 );
74close $newworld_fh;
75
76# Autoflush on
77$|=1;
78
79my @typenames = ('unknown', 'land', 'sea', 'mixed');
80for my $y (0..4095)
81{
82  my $tmp = 0;
83  my $str = "";
84  for my $x (0 .. 4095)
85  {
86    my $type = get_type($world_im,$x,$y);
87    my $ntype = get_type($newworld_im,$x,$y);
88    if ($ntype != $type) {
89        my $ntypen=$typenames[$ntype];
90        print "$x,$y,12,$ntypen\n";
91    }
92  }
93}
Note: See TracBrowser for help on using the repository browser.