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

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

added view

  • Property svn:executable set to *
File size: 6.0 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    printhelp() if (@ARGV < 3);
254    my ($oldfile,$newfile,$targetfile) = @ARGV;
255
256    my $world_im = getimage($oldfile);
257    my $newworld_im = getimage($newfile);
258    my $target_im = getimage($targetfile);
259    my $changed;
260
261    for my $y (0 .. 4095)
262    {
263      for my $x (0 .. 4095)
264      {
265        my $type = get_type($world_im,$x,$y);
266        my $ntype = get_type($newworld_im,$x,$y);
267        if ($ntype != $type)
268        {
269          my $ttype = get_type($target_im,$x,$y);
270          my $ntypen=$typenames[$ntype];
271          my $typen=$typenames[$type];
272          my $typet=$typenames[$type];
273          if($ntype == $ttype)
274          {
275            print "$pngname($x, $y) = $ntype ($ntypen) UNCHANGED\n";
276          }
277          else
278          {
279            print "$pngname($x, $y) = $ntype ($ntypen) WAS $type ($typen)/$ttype ($typet)\n";
280            set_type($target_im, $x, $y, $ntype);
281            $changed = 1;
282          }
283        }
284      }
285    }
286    saveimage($target_im, $targetfile) if $changed;
287  }
288  else
289  {
290    printhelp();
291  }
292}
293else
294{
295  convertfile($pngname, $datname);
296}
Note: See TracBrowser for help on using the repository browser.