#!/usr/bin/perl -w

# This program generates the "oceantiles_12.dat" file as used by
# lowzoom.pl and close-areas.pl.
#
# It takes a 4096x4096 pixel PNG file as input; the pixels in the 
# PNG file may have one of the four colors
#
# white - coastline intersects with this tile
# green - no coastline intersect, land tile
# blue -  no coastline intersect, sea tile
# black - unknown

# written by Martijn van Oosterhout <kleptog@gmail.com>
# with minor changes by Frederik Ramm <frederik@remote.org>

use GD;
use strict;
use bytes;

use constant TILETYPE_UNKNOWN => 0;
use constant TILETYPE_LAND => 1;
use constant TILETYPE_SEA => 2;
use constant TILETYPE_TILE => 3;

my($world_fh,$tileinfo_fh, $world_im);


if($ARGV[0] eq "check"){
    my @typenames = ('unknown', 'land', 'sea', 'land&sea');
    my ($x, $y) = ($ARGV[1], $ARGV[2]);

    open $world_fh, "<oceantiles_12.png" or die;
    open $tileinfo_fh, "<oceantiles_12.dat" or die;

    $world_im = GD::Image->newFromPng( $world_fh, 1 );

    my $png_val = get_type_png($x, $y);
    my $dat_val = get_type_data($x, $y);

    print "oceantiles_12.png($x, $y) = $png_val ($typenames[$png_val])\n";
    print "oceantiles_12.dat($x, $y) = $dat_val ($typenames[$dat_val])\n";
    exit 0;
} elsif ($ARGV[0] eq "set"){
    my ($x, $y) = ($ARGV[1], $ARGV[2]);
    my $newtype;

    open $tileinfo_fh, "+<oceantiles_12.dat" or die;
    open $world_fh, "<oceantiles_12.png" or die;
    $world_im = GD::Image->newFromPng( $world_fh, 1 );
    close $world_fh;
    open $world_fh, ">oceantiles_12.png" or die;
    
      $newtype = TILETYPE_LAND if ($ARGV[3] eq "land");
      $newtype = TILETYPE_SEA  if ($ARGV[3] eq "sea");
      $newtype = TILETYPE_TILE  if ($ARGV[3] eq "coast");

    set_type_dat($x, $y, $newtype);
    set_type_png($x, $y, $newtype);
    print $world_fh $world_im->png;
    close $world_fh;
    close $tileinfo_fh;
    exit 0;
}

open $world_fh, "<oceantiles_12.png" or die;
open $tileinfo_fh, ">oceantiles_12.dat" or die;

$world_im = GD::Image->newFromPng( $world_fh, 1 );



for my $y (0..4095)
{
  my $tmp = 0;
  my $str = "";
  for my $x (0 .. 4095)
  {
    my $type = get_type_png($x,$y);
    $tmp = ($tmp << 2) | $type;
    
    if( ($x&3) == 3)
    {
      my $byte = chr $tmp;
      $str .= $byte;
      $tmp=0;
    }
  }
  print $tileinfo_fh $str;
}
  
close $tileinfo_fh;


sub get_type_data 
{
    my ($x, $y) = @_;
    my $offset = 4096*$y + $x;
    my $buf;

    binmode $tileinfo_fh;

    seek($tileinfo_fh, $offset/4, 0);
    read($tileinfo_fh, $buf, 1);
    my $byte = ord $buf;

    return (($byte >> 4) & 3)  if(($offset % 4) == 1);
    return (($byte >> 2) & 3)  if(($offset % 4) == 2);
    return ($byte & 3)         if(($offset % 4) == 3);
    return (($byte >> 6) & 3)  if(($offset % 4) == 0);
}

sub set_type_dat
{
    my($x, $y, $type) = @_;
    my $buf;

    binmode $tileinfo_fh;
    my $offset = 4096*$y + $x;
    seek($tileinfo_fh, $offset/4, 0);
    read($tileinfo_fh, $buf, 1);
    my $byte = ord $buf;

    my $byteoffset = (3-($offset %4));
    my $tmp = 0;
    $tmp |= $type; 
    $tmp = $tmp << (2*$byteoffset); 


    $byte &= (~(3 << 2*$byteoffset));
    $byte |=  $tmp;
    seek($tileinfo_fh, $offset/4, 0);
    $buf = chr $byte;
    print $tileinfo_fh $buf;
}

sub set_type_png
{
  my($x, $y, $type) = @_;
  my $color;

  $color = $world_im->colorAllocate(0,0,255) if($type == TILETYPE_SEA);
  $color = $world_im->colorAllocate(0,255,0) if($type == TILETYPE_LAND);
  $color = $world_im->colorAllocate(255,255,255) if($type == TILETYPE_TILE);
  $world_im->setPixel($x,$y, $color);
}

sub get_type_png
{
  my($x,$y) = @_;

  my($r,$g,$b) = $world_im->rgb( $world_im->getPixel( $x,$y ) );

  return TILETYPE_LAND if $r == 0 && $g == 255 && $b == 0;
  return TILETYPE_SEA if $r == 0 && $g == 0   && $b == 255;
  return TILETYPE_TILE if $r == 255 && $g == 255 && $b == 255;
  return TILETYPE_UNKNOWN if $r == 0 && $g == 0 && $b == 0;
  
  die "Wierd tiletype at [$x,$y]: ($r,$g,$b)\n";
}