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

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

added some more african lakes, better output in scripts

  • Property svn:executable set to *
File size: 3.7 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');
26
27
28#
29#
30#
31my ($world_fh, $tileinfo_fh);
32our $world_im;
33
34
35#
36#
37#
38sub get_type 
39{
40  my($image, $x, $y) = @_;
41
42  my($r,$g,$b) = $image->rgb( $image->getPixel( $x,$y ) );
43 
44  return TILETYPE_SEA if $r == 0 && $g == 0   && $b == 255;
45  return TILETYPE_LAND if $r == 0 && $g == 255 && $b == 0;
46  return TILETYPE_TILE if $r == 255 && $g == 255 && $b == 255;
47  return TILETYPE_UNKNOWN if $r == 0 && $g == 0 && $b == 0;
48 
49  die "Wierd tiletype at [$x,$y]: ($r,$g,$b)\n";
50}
51
52
53#
54#
55#
56sub set_type
57{
58  my($image, $x, $y, $type) = @_;
59  my $color;
60
61  $color = $image->colorResolve(0,0,255) if($type == TILETYPE_SEA);
62  $color = $image->colorResolve(0,255,0) if($type == TILETYPE_LAND);
63  $color = $image->colorResolve(255,255,255) if($type == TILETYPE_TILE);
64  $image->setPixel($x,$y, $color);
65}
66
67
68#
69#
70#
71if ($#ARGV > -1)
72{
73    if($ARGV[0] eq "check")
74    {
75        if ($#ARGV < 2)
76        {
77            print "Usage: png2tileinfo.pl check <x> <y>\n";
78        }
79        else
80        {
81            my ($x, $y) = ($ARGV[1], $ARGV[2]);
82
83            open $world_fh, "<oceantiles_12.png" or die;
84            # use binmode so it works on windows too
85            binmode $world_fh;
86
87            $world_im = GD::Image->newFromPng( $world_fh, 1 );
88
89            my $png_val = get_type($world_im, $x, $y);
90
91            print "oceantiles_12.png($x, $y) = $png_val ($typenames[$png_val])\n";
92        }
93
94        exit 0;
95    }
96
97    if ($ARGV[0] eq "set")
98    {
99        if ($#ARGV < 3)
100        {
101            print "Usage: png2tileinfo.pl set <x> <y> [land|sea|mixed]\n";
102        }
103        else
104        {
105            my ($x, $y) = ($ARGV[1], $ARGV[2]);
106            my $newtype;
107
108            open $world_fh, "<oceantiles_12.png" or die;
109            # use binmode so it works on windows too
110            binmode $world_fh;
111            $world_im = GD::Image->newFromPng( $world_fh, 1 );
112            close $world_fh;
113   
114            my $old_val = get_type($world_im, $x, $y);
115            $newtype = TILETYPE_LAND if ($ARGV[3] eq "land");
116            $newtype = TILETYPE_SEA  if ($ARGV[3] eq "sea");
117            $newtype = TILETYPE_TILE if ($ARGV[3] eq "mixed");
118
119            if($old_val == $newtype)
120            {
121                print "oceantiles_12.png($x, $y) = $newtype ($typenames[$newtype]) UNCHANGED\n";
122            }
123            else
124            {
125                set_type($world_im, $x, $y, $newtype);
126                print "oceantiles_12.png($x, $y) = $newtype ($typenames[$newtype]) WAS $old_val ($typenames[$old_val])\n";
127
128                open $world_fh, ">oceantiles_12.png" or die;
129                # use binmode so it works on windows too
130                binmode $world_fh;
131                print $world_fh $world_im->png;
132                close $world_fh;
133            }
134        }
135
136        exit 0;
137    }
138}
139
140
141# Convert the resulting file in any case...
142open $world_fh, "<oceantiles_12.png" or die;
143open $tileinfo_fh, ">oceantiles_12.dat" or die;
144# use binmode so it works on windows too
145binmode $world_fh;
146binmode $tileinfo_fh;
147print STDERR "Writing output to ./oceantiles_12.dat\n";
148$world_im = GD::Image->newFromPng( $world_fh, 1 );
149
150for my $y (0..4095)
151{
152  my $tmp = 0;
153  my $str = "";
154  for my $x (0 .. 4095)
155  {
156    my $type = get_type($world_im,$x,$y);
157    $tmp = ($tmp << 2) | $type;
158   
159    if( ($x&3) == 3)
160    {
161      my $byte = chr $tmp;
162      $str .= $byte;
163      $tmp=0;
164    }
165  }
166  print $tileinfo_fh $str;
167}
168 
169close $tileinfo_fh;
170
Note: See TracBrowser for help on using the repository browser.