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

Last change on this file since 27713 was 13825, checked in by stephankn, 11 years ago

set eol-style to let svn take care of correct line endings

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 6.3 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  if($r == 0)
40  {
41    if($g == 0)
42    {
43      return $b == 255 ? TILETYPE_SEA : TILETYPE_UNKNOWN;
44    }
45    elsif($g == 255 && $b == 0)
46    {
47      return TILETYPE_LAND;
48    }
49  }
50  elsif($r == 255 && $g == 255 && $b == 255)
51  {
52    return TILETYPE_TILE;
53  }
54
55  die "Weird tiletype at [$x,$y]: ($r,$g,$b)\n";
56}
57
58
59#
60#
61#
62sub set_type($$$$)
63{
64  my($image, $x, $y, $type) = @_;
65  my $color;
66
67  if($type == TILETYPE_SEA)
68  { $color = $image->colorResolve(0,0,255); }
69  elsif($type == TILETYPE_LAND)
70  { $color = $image->colorResolve(0,255,0); }
71  elsif($type == TILETYPE_TILE)
72  { $color = $image->colorResolve(255,255,255); }
73  $image->setPixel($x,$y, $color);
74}
75
76
77#
78#
79#
80sub convertfile($$)
81{
82  my ($image,$dat) = @_;
83  my $world_im = getimage($image);
84  my $tileinfo_fh;
85
86  print STDERR "Writing output to $dat\n";
87
88  my $str;
89  for my $y (0..4095)
90  {
91    my $tmp = 0;
92    for my $x (0 .. 4095)
93    {
94      $tmp = ($tmp << 2) | get_type($world_im,$x,$y);
95
96      if(($x&3) == 3)
97      {
98        $str .= chr $tmp;
99        $tmp = 0;
100      }
101    }
102  }
103  open $tileinfo_fh, ">:raw",$dat or die;
104  print $tileinfo_fh $str;
105  close $tileinfo_fh;
106}
107
108
109#
110#
111#
112sub getimage($)
113{
114  my $world_fh;
115  my $name = shift @_;
116
117  open $world_fh, "<:raw",$name or die;
118  my $world_im = GD::Image->newFromPng( $world_fh, 1 );
119  close $world_fh;
120
121  return $world_im;
122}
123
124
125#
126#
127#
128sub saveimage($$)
129{
130  my ($image, $name) = @_;
131  my $world_fh;
132
133  open $world_fh, ">:raw",$name or die;
134  print $world_fh $image->png;
135  close $world_fh;
136}
137
138
139#
140#
141#
142sub printhelp
143{
144  print "Usage: png2tileinfo.pl check <x> <y>\n"
145  .     "       png2tileinfo.pl set <x> <y> <land|sea|mixed> ...\n"
146  .     "       png2tileinfo.pl diff oldfile.png newfile.png\n"
147  .     "       png2tileinfo.pl svndiff\n"
148  .     "       png2tileinfo.pl view\n"
149  .     "       png2tileinfo.pl copydiff [oldfile.png newfile.png targetfile.png]\n";
150  exit(0);
151}
152
153
154#
155#
156#
157if ($#ARGV > -1)
158{
159  my $arg = shift @ARGV;
160  if ($arg eq "check")
161  {
162    printhelp() if (@ARGV < 2);
163
164    my ($x, $y) = ($ARGV[0], $ARGV[1]);
165
166    my $png_val = get_type(getimage($pngname), $x, $y);
167    print "$pngname($x, $y) = $png_val ($typenames[$png_val])\n";
168  }
169  elsif ($arg eq "set")
170  {
171    printhelp() if (@ARGV < 1);
172
173    my $changed;
174    my $world_im = getimage($pngname);
175
176    while(@ARGV)
177    {
178      printhelp() if (@ARGV < 3);
179
180      my ($x, $y, $nt) = splice(@ARGV,0,3);
181      my $newtype;
182
183      my $old_val = get_type($world_im, $x, $y);
184      if($nt eq "land") {$newtype = TILETYPE_LAND;}
185      elsif ($nt eq "sea") {$newtype = TILETYPE_SEA;}
186      elsif ($nt eq "mixed") {$newtype = TILETYPE_TILE;}
187      else {die "Unknown type $nt.\n";}
188
189      if($old_val == $newtype)
190      {
191        print "$pngname($x, $y) = $newtype ($typenames[$newtype]) UNCHANGED\n";
192      }
193      else
194      {
195        set_type($world_im, $x, $y, $newtype);
196        print "$pngname($x, $y) = $newtype ($typenames[$newtype]) WAS $old_val ($typenames[$old_val])\n";
197        $changed = 1;
198      }
199    }
200
201    saveimage($world_im, $pngname) if $changed;
202  }
203  elsif($arg eq "diff" || $arg eq "svndiff")
204  {
205    my $oldfile;
206    my $newfile;
207
208    if($arg eq "svndiff")
209    {
210      ($oldfile,$newfile) = (".svn/text-base/$pngname.svn-base", $pngname);
211    }
212    elsif (@ARGV < 2)
213    {
214      printhelp();
215    }
216    else
217    {
218      ($oldfile,$newfile) = @ARGV;
219    }
220
221    my $world_im = getimage($oldfile);
222    my $newworld_im = getimage($newfile);
223
224    for my $y (0 .. 4095)
225    {
226      for my $x (0 .. 4095)
227      {
228        my $type = get_type($world_im,$x,$y);
229        my $ntype = get_type($newworld_im,$x,$y);
230        if ($ntype != $type)
231        {
232          my $ntypen=$typenames[$ntype];
233          my $typen=$typenames[$type];
234          print "$pngname($x, $y) = $ntype ($ntypen) WAS $type ($typen)\n";
235        }
236      }
237    }
238  }
239  elsif($arg eq "view")
240  {
241    my $file = getimage($pngname);
242    for my $y (0 .. 4095)
243    {
244      for my $x (0 .. 4095)
245      {
246        my $type = get_type($file,$x,$y);
247        print "$pngname($x, $y) = $type ($typenames[$type])\n";
248      }
249    }
250  }
251  elsif($arg eq "copydiff")
252  {
253    my ($oldfile,$newfile,$targetfile);
254    if(!@ARGV)
255    {
256      my @files = sort glob("$pngname.r*");
257      $targetfile = $pngname;
258      if(@files == 2)
259      {
260        ($oldfile, $newfile) = @files;
261      }
262      else
263      {
264        die "Found more or less than two revision conflict files.";
265      }
266    }
267    elsif (@ARGV == 3)
268    {
269      ($oldfile,$newfile,$targetfile) = @ARGV;
270    }
271    else
272    {
273      printhelp();
274    }
275
276    my $world_im = getimage($oldfile);
277    my $newworld_im = getimage($newfile);
278    my $target_im = getimage($targetfile);
279    my $changed;
280
281    for my $y (0 .. 4095)
282    {
283      for my $x (0 .. 4095)
284      {
285        my $type = get_type($world_im,$x,$y);
286        my $ntype = get_type($newworld_im,$x,$y);
287        if ($ntype != $type)
288        {
289          my $ttype = get_type($target_im,$x,$y);
290          my $ntypen=$typenames[$ntype];
291          my $typen=$typenames[$type];
292          my $typet=$typenames[$type];
293          if($ntype == $ttype)
294          {
295            print "$pngname($x, $y) = $ntype ($ntypen) UNCHANGED\n";
296          }
297          else
298          {
299            print "$pngname($x, $y) = $ntype ($ntypen) WAS $type ($typen)/$ttype ($typet)\n";
300            set_type($target_im, $x, $y, $ntype);
301            $changed = 1;
302          }
303        }
304      }
305    }
306    saveimage($target_im, $targetfile) if $changed;
307  }
308  else
309  {
310    printhelp();
311  }
312}
313else
314{
315  convertfile($pngname, $datname);
316}
Note: See TracBrowser for help on using the repository browser.