source: subversion/applications/rendering/tilesAtHome/tools/png2tileinfo/png2tileinfo.pl @ 10397

Last change on this file since 10397 was 9905, checked in by andrew, 12 years ago

Slight speedup in png2tileinfo: check for tile types in order of frequency.

  • Property svn:executable set to *
File size: 3.4 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;
25
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 @typenames = ('unknown', 'land', 'sea', 'mixed');
82            my ($x, $y) = ($ARGV[1], $ARGV[2]);
83
84            open $world_fh, "<oceantiles_12.png" or die;
85            # use binmode so it works on windows too
86            binmode $world_fh;
87
88            $world_im = GD::Image->newFromPng( $world_fh, 1 );
89
90            my $png_val = get_type($world_im, $x, $y);
91
92            print "oceantiles_12.png($x, $y) = $png_val ($typenames[$png_val])\n";
93        }
94
95        exit 0;
96    }
97
98    if ($ARGV[0] eq "set")
99    {
100        if ($#ARGV < 3)
101        {
102            print "Usage: png2tileinfo.pl set <x> <y> [land|sea|mixed]\n";
103        }
104        else
105        {
106            my ($x, $y) = ($ARGV[1], $ARGV[2]);
107            my $newtype;
108
109            open $world_fh, "<oceantiles_12.png" or die;
110            # use binmode so it works on windows too
111            binmode $world_fh;
112            $world_im = GD::Image->newFromPng( $world_fh, 1 );
113            close $world_fh;
114   
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            set_type($world_im, $x, $y, $newtype);
120
121            open $world_fh, ">oceantiles_12.png" or die;
122            # use binmode so it works on windows too
123            binmode $world_fh;
124            print $world_fh $world_im->png;
125            close $world_fh;
126        }
127
128        exit 0;
129    }
130}
131
132
133# Convert the resulting file in any case...
134open $world_fh, "<oceantiles_12.png" or die;
135open $tileinfo_fh, ">oceantiles_12.dat" or die;
136# use binmode so it works on windows too
137binmode $world_fh;
138binmode $tileinfo_fh;
139print STDERR "Writing output to ./oceantiles_12.dat\n";
140$world_im = GD::Image->newFromPng( $world_fh, 1 );
141
142for my $y (0..4095)
143{
144  my $tmp = 0;
145  my $str = "";
146  for my $x (0 .. 4095)
147  {
148    my $type = get_type($world_im,$x,$y);
149    $tmp = ($tmp << 2) | $type;
150   
151    if( ($x&3) == 3)
152    {
153      my $byte = chr $tmp;
154      $str .= $byte;
155      $tmp=0;
156    }
157  }
158  print $tileinfo_fh $str;
159}
160 
161close $tileinfo_fh;
162
Note: See TracBrowser for help on using the repository browser.