source: subversion/applications/rendering/png2tileinfo/png2tileinfo.pl @ 11119

Last change on this file since 11119 was 11119, checked in by Dirk Stoecker, 12 years ago

updated some lakes

  • Property svn:executable set to *
File size: 5.8 KB
Line 
1#!/usr/bin/perl -w
2
3# This program generates the "oceantiles_12.dat" file as used by
4# lowzoom.pl and close-areas.pl.
5#
6# It takes a 4096x4096 pixel PNG file as input; the pixels in the
7# PNG file may have one of the four colors
8#
9# white - coastline intersects with this tile
10# green - no coastline intersect, land tile
11# blue -  no coastline intersect, sea tile
12# black - unknown
13
14# written by Martijn van Oosterhout <kleptog@gmail.com>
15# with minor changes by Frederik Ramm <frederik@remote.org>
16
17use GD;
18use strict;
19use bytes;
20
21use constant TILETYPE_UNKNOWN => 0;
22use constant TILETYPE_LAND => 1;
23use constant TILETYPE_SEA => 2;
24use constant TILETYPE_TILE => 3;
25my @typenames = ('unknown', 'land', 'sea', 'mixed');
26my $pngname = "oceantiles_12.png";
27my $datname = "oceantiles_12.dat";
28
29
30#
31#
32#
33sub get_type($$$)
34{
35  my($image, $x, $y) = @_;
36
37  my($r,$g,$b) = $image->rgb( $image->getPixel( $x,$y ) );
38
39  return TILETYPE_SEA if $r == 0 && $g == 0   && $b == 255;
40  return TILETYPE_LAND if $r == 0 && $g == 255 && $b == 0;
41  return TILETYPE_TILE if $r == 255 && $g == 255 && $b == 255;
42  return TILETYPE_UNKNOWN if $r == 0 && $g == 0 && $b == 0;
43
44  die "Weird tiletype at [$x,$y]: ($r,$g,$b)\n";
45}
46
47
48#
49#
50#
51sub set_type($$$$)
52{
53  my($image, $x, $y, $type) = @_;
54  my $color;
55
56  $color = $image->colorResolve(0,0,255) if($type == TILETYPE_SEA);
57  $color = $image->colorResolve(0,255,0) if($type == TILETYPE_LAND);
58  $color = $image->colorResolve(255,255,255) if($type == TILETYPE_TILE);
59  $image->setPixel($x,$y, $color);
60}
61
62
63#
64#
65#
66sub convertfile($$)
67{
68  my ($image,$dat) = @_;
69  my $world_im = getimage($image);
70  my $tileinfo_fh;
71
72  open $tileinfo_fh, ">:raw",$dat or die;
73
74  print STDERR "Writing output to $dat\n";
75
76  for my $y (0..4095)
77  {
78    my $tmp = 0;
79    my $str = "";
80    for my $x (0 .. 4095)
81    {
82      my $type = get_type($world_im,$x,$y);
83      $tmp = ($tmp << 2) | $type;
84
85      if( ($x&3) == 3)
86      {
87        my $byte = chr $tmp;
88        $str .= $byte;
89        $tmp=0;
90      }
91    }
92    print $tileinfo_fh $str;
93  }
94  close $tileinfo_fh;
95}
96
97
98#
99#
100#
101sub getimage($)
102{
103  my $world_fh;
104  my $name = shift @_;
105
106  open $world_fh, "<:raw",$name or die;
107  my $world_im = GD::Image->newFromPng( $world_fh, 1 );
108  close $world_fh;
109
110  return $world_im;
111}
112
113
114#
115#
116#
117sub saveimage($$)
118{
119  my ($image, $name) = @_;
120  my $world_fh;
121
122  open $world_fh, ">:raw",$name or die;
123  print $world_fh $image->png;
124  close $world_fh;
125}
126
127
128#
129#
130#
131sub printhelp
132{
133  print "Usage: png2tileinfo.pl check <x> <y>\n"
134  .     "       png2tileinfo.pl set <x> <y> [land|sea|mixed] ...\n"
135  .     "       png2tileinfo.pl diff oldfile.png newfile.png\n"
136  .     "       png2tileinfo.pl svndiff\n"
137  .     "       png2tileinfo.pl copydiff oldfile.png newfile.png targetfile.png\n";
138  exit(0);
139}
140
141
142#
143#
144#
145if ($#ARGV > -1)
146{
147  my $arg = shift @ARGV;
148  if ($arg eq "check")
149  {
150    printhelp() if (@ARGV < 2);
151
152    my ($x, $y) = ($ARGV[1], $ARGV[2]);
153
154    my $png_val = get_type(getimage($pngname), $x, $y);
155    print "$pngname($x, $y) = $png_val ($typenames[$png_val])\n";
156  }
157  elsif ($arg eq "set")
158  {
159    printhelp() if (@ARGV < 1);
160
161    my $changed;
162    my $world_im = getimage($pngname);
163
164    while(@ARGV)
165    {
166      printhelp() if (@ARGV < 3);
167
168      my ($x, $y, $nt) = splice(@ARGV,0,3);
169      my $newtype;
170
171      my $old_val = get_type($world_im, $x, $y);
172      if($nt eq "land") {$newtype = TILETYPE_LAND;}
173      elsif ($nt eq "sea") {$newtype = TILETYPE_SEA;}
174      elsif ($nt eq "mixed") {$newtype = TILETYPE_TILE;}
175      else {die "Unknown type $nt.\n";}
176
177      if($old_val == $newtype)
178      {
179        print "$pngname($x, $y) = $newtype ($typenames[$newtype]) UNCHANGED\n";
180      }
181      else
182      {
183        set_type($world_im, $x, $y, $newtype);
184        print "$pngname($x, $y) = $newtype ($typenames[$newtype]) WAS $old_val ($typenames[$old_val])\n";
185        $changed = 1;
186      }
187    }
188
189    saveimage($world_im, $pngname) if $changed;
190  }
191  elsif($arg eq "diff" || $arg eq "svndiff")
192  {
193    my $oldfile;
194    my $newfile;
195
196    if($arg eq "svndiff")
197    {
198      ($oldfile,$newfile) = (".svn/text-base/$pngname.svn-base", $pngname);
199    }
200    elsif (@ARGV < 2)
201    {
202      printhelp();
203    }
204    else
205    {
206      ($oldfile,$newfile) = @ARGV;
207    }
208
209    my $world_im = getimage($oldfile);
210    my $newworld_im = getimage($newfile);
211
212    for my $y (0..4095)
213    {
214      my $tmp = 0;
215      my $str = "";
216      for my $x (0 .. 4095)
217      {
218        my $type = get_type($world_im,$x,$y);
219        my $ntype = get_type($newworld_im,$x,$y);
220        if ($ntype != $type)
221        {
222          my $ntypen=$typenames[$ntype];
223          my $typen=$typenames[$type];
224          print "$pngname($x, $y) = $ntype ($ntypen) WAS $type ($typen)\n";
225        }
226      }
227    }
228  }
229  elsif($arg eq "copydiff")
230  {
231    printhelp() if (@ARGV < 3);
232    my ($oldfile,$newfile,$targetfile) = @ARGV;
233
234    my $world_im = getimage($oldfile);
235    my $newworld_im = getimage($newfile);
236    my $target_im = getimage($targetfile);
237    my $changed;
238
239    for my $y (0..4095)
240    {
241      my $tmp = 0;
242      my $str = "";
243      for my $x (0 .. 4095)
244      {
245        my $type = get_type($world_im,$x,$y);
246        my $ntype = get_type($newworld_im,$x,$y);
247        if ($ntype != $type)
248        {
249          my $ttype = get_type($target_im,$x,$y);
250          my $ntypen=$typenames[$ntype];
251          my $typen=$typenames[$type];
252          my $typet=$typenames[$type];
253          if($ntype == $ttype)
254          {
255            print "$pngname($x, $y) = $ntype ($ntypen) UNCHANGED\n";
256          }
257          else
258          {
259            print "$pngname($x, $y) = $ntype ($ntypen) WAS $type ($typen)/$ttype ($typet)\n";
260            set_type($target_im, $x, $y, $ntype);
261            $changed = 1;
262          }
263        }
264      }
265    }
266    saveimage($target_im, $targetfile) if $changed;
267  }
268  else
269  {
270    printhelp();
271  }
272}
273else
274{
275  convertfile($pngname, $datname);
276}
Note: See TracBrowser for help on using the repository browser.