package BDSM::Map;

use strict;
use warnings;
use include;

use BDSM::Util;

# Returns a new tilemap with height * width tiles initialized as a blank tile.
sub new {
  my $class = shift;
  die "new() called off an existing map!\n" if ref $class;
  my $height = shift;
  my $width = shift;
  my $blank = shift;
  die "No default key for the tile!\n" if ref $blank eq "HASH"
                                          and !(my $key = shift);
  my $map = [];
  # TODO: offset stuff
  foreach my $y (0 .. $height) {
    foreach my $x (0 .. $width) {
      # We don't want a ton of tiles with references to one blank tile!
      $map->[$y][$x] = (ref $blank eq "HASH") ? { %$blank } : $blank;
    }
  }
  my $self = bless {
    Map      => $map,
    OnChange => sub {
      # The placeholder handler for changing a tile and (usually) updating the
      # UI.
      my ($mapobj, $y, $x, $new) = @_;
    },
    Flyweight => {
      # Each hash entry here allows for flyweighting. So if a tile should
      # possibly have a certain reference to a unique object like, say, an
      # inventory container... instead of creating tons of useless containers,
      # create them as they're needed.
      # Example entry:
      # method1  => sub { undef },
      # method2  => sub { @{[]} },
      # _handler => $ref
      # _tilekey => "key"
      # See AUTOLOAD for details.
    }

  }, $class;
  $self->{TileKey} = $key if ref $blank;
  return $self;
}

# Returns the height of the map.
sub height {
  my $self = shift;
  return $#{ $self->{Map} };
}

# Returns the width of the map.
sub width {
  my $self = shift;
  # All maps are rectangular; thus, each row is the same width.
  return $#{ $self->{Map}[0] };
}

# Change a tile on the map.
sub mod {
  my ($self, $y, $x, $new) = @_;
  die "Out of bounds ($y, $x)!\n" if $y < 0 or $x < 0 or $y > $self->height
                                     or $x > $self->width;
  # Each tile is either a scalar or a hash. If it's a hash and we pass in a
  # scalar, then (to make it nice) just assume they mean some default key.
  if (ref $self->{Map}[$y][$x] eq "HASH") {
    # "Blanking" a tile is only possible by passing in a hash with all of the
    # keys "blanked" or by manually resetting the tile to a new hash.
    my $tile = $self->{Map}[$y][$x];
    if (ref $new eq "HASH") {
      %$tile = (%$tile, %$new);
    } else {
      $tile->{ $self->{TileKey} } = $new;
    }
  } else {
    $self->{Map}[$y][$x] = $new;
  }
  # Let arbitrary things happen, like updating the UI.
  $self->{OnChange}->($self, $y, $x, $new);
  return $new;
}

# Quick and simple dump to STDERR in a format suitable for viewing with most(1)
sub dump {
  my $self = shift;
  foreach my $y (0 .. $self->height) {
    print STDERR join("", map {
      (ref $_ eq "HASH") ? $_->{ $self->{TileKey } } : $_;
    } @{ $self->{Map}[$y] }), "\n";
  }
  return 1;
}

# Takes in the source and destination coordinates (both y, x) and a hash of
# options. Returns the path if possible, -1 if impossible, or 0 if already
# there.
sub pathfind {
  # Real simple A*, actually.
  my $self = shift;
  my $y1 = shift;
  my $x1 = shift;
  my $y2 = shift;
  my $x2 = shift;
  my $opts = shift || {};
  die "Need a barrier checker!\n" unless ref $opts->{Pass} eq "CODE";

  # Save some time.
  return 0 if $y1 == $y2 and $x1 == $x2;
  # Destination itself cannot be traversed.
  return -1 unless $opts->{Pass}->($self->{Map}[$y2][$x2]);

  my $open = new_pqueue;
  $open->add({
    P => abs($y1 - $y2) + abs($x1 - $x2),
    Y => $y1,
    X => $x1
  });

  # Set up a temp copy of the map to hold data.
  my $map = [];
  foreach my $y (0 .. $self->height) {
    foreach my $x (0 .. $self->width) {
      $map->[$y][$x] = {};
    }
  }

  $map->[$y1][$x1]{Used} = 1;
  $map->[$y1][$x1]{Backref} = "Start";
  my $node;
  while ($node = $open->lowest) {

    if ($node->{Y} == $y2 and $node->{X} == $x2) {
      # We're here!
      my $y = $node->{Y};
      my $x = $node->{X};
      my @path = ([$y, $x]);
      # From the destination node, trace back to Start.
      while (ref $map->[$y][$x]{Backref} eq "ARRAY") {
        my $backref = $map->[$y][$x]{Backref};
        ($y, $x) = @$backref;
        unshift @path, $backref;
      }
      return @path;
    }

    $map->[ $node->{Y} ][ $node->{X} ]{Used} = 1;
    foreach my $dir (vi_dirs) {
      next if $opts->{Diags} == 0 and is_diag($dir);
      my ($y, $x) = keycoord($dir, $node->{Y}, $node->{X});
      next if $map->[$y][$x]{Used};   # Pointless trails, dude.
      next unless $opts->{Pass}->($self->{Map}[$y][$x]);

      my $h = abs($y - $y2) + abs($x - $x2);
      $map->[$y][$x]{Used} = 1;
      $map->[$y][$x]{Backref} = [ $node->{Y}, $node->{X} ];
      $open->add({
        P => $h, 
        Y => $y,
        X => $x
      });
    }

  }
  return -1;
}

# Change the form of each tile.
sub retile {
  my ($self, $change) = @_;
  foreach my $y (0 .. $self->height) {
    foreach my $x (0 .. $self->width) {
      my $new = $change->($self->{Map}[$y][$x]);
      delete $self->{TileKey} unless ref $new eq "HASH";
      $self->{Map}[$y][$x] = $new;
    }
  }
}

# Finds a random tile on the map.
sub getpt {
  my ($self, $match) = @_;
  my ($y, $x);
  while (1) {
    $y = CONFIG->random(0, $self->height);
    $x = CONFIG->random(0, $self->width);
    my $tile = $self->{Map}[$y][$x];
    if ($self->{TileKey}) {
      last if $tile->{ $self->{TileKey} } eq $match;
    } else {
      last if $tile eq $match;
    }
  }
  return ($y, $x);
}

# Finds all tiles matching a specification.
sub find {
  my ($self, $match) = @_;
  my @ls;
  foreach my $y (0 .. $self->height) {
    foreach my $x (0 .. $self->width) {
      my $tile = $self->{Map}[$y][$x];
      if ($self->{TileKey}) {
        push @ls, [$y, $x] if $tile->{ $self->{TileKey} } eq $match;
      } else {
        push @ls, [$y, $x] if $tile eq $match;
      }
    }
  }
  return @ls;
}

our $AUTOLOAD;

# We handle the tile flyweighting.
sub AUTOLOAD {
  my ($self, $y, $x, $method, @args) = @_;
  my $do = $AUTOLOAD;
  $do =~ s/^.*:://;
  return if $do eq "DESTROY";
  die "This map can't flyweight $do!\n" unless $self->{Flyweight}{$do};
  my $key = $self->{Flyweight}{$do}{_tilekey};
  my $tile = $self->{Map}[$y][$x];

  if (my $handler = $tile->{$key}) {
    # No need to flyweight; a handler exists for this tile.
    $handler->$method(@args);
  } elsif (my $blank = $self->{Flyweight}{$do}{$method}) {
    # A blank method!
    return $blank->();
  } else {
    # An authentic method. "Autovivify" a handler and delegate.
    $tile->{$key} = $self->{Flyweight}{$do}{_handler}->new($tile);
    $tile->{$key}->$method(@args);
  }
}

42;