package BDSM::Transform;

use strict;
use warnings;
use include;

use BDSM::Util;

use BDSM::Map;

use Exporter;
our @ISA = ("Exporter");
our @EXPORT = qw(
  bdsm_map place jigsaw clearout cellular fill transform border findwalls
  check_walls spawnwall carvepath excavate loadmap
);

# A nice little quick way to make a map with data suitable for only dungeon
# generation.
sub bdsm_map {
  my $height = shift;
  my $width = shift;
  my $tile = shift || " ";
  return BDSM::Map->new($height, $width, { ID => -1, _ => $tile }, "_");
}

# Attempts to place a shape onto an existing map.
sub place {
  my ($shape, $data) = @_;
  my $map = $data->{on};
  my ($Y, $X) = @{ $data->{at} }; # We're offsets.
  # No hope?
  return if $shape->height + $Y > $map->height;
  return if $shape->width + $X > $map->width;

  # Pass 1 is checking if placing the shape will overlap any nasties.
  foreach my $y (0 .. $shape->height) {
    foreach my $x (0 .. $shape->width) {
      # TODO: list of overlapables?
      return unless $map->{Map}[$Y + $y][$X + $x]{_} eq " ";
    }
  }

  # Pass 2 is merging the shape onto the map.
  foreach my $y (0 .. $shape->height) {
    foreach my $x (0 .. $shape->width) {
      my $tile = $map->{Map}[$Y + $y][$X + $x];
      %$tile = %{ $shape->{Map}[$y][$x] };
      $tile->{ID} = $#{ $map->{Shapes} } + 1;
    }
  }

  # Translate data too
  foreach my $dir (compass_dirs) {
    foreach my $wall (@{ $shape->{Exits}{$dir} }) {
      $wall->{Y1} += $Y;
      $wall->{X1} += $X;
      $wall->{Y2} += $Y;
      $wall->{X2} += $X;
    }
  }
  $shape->{ID} = $#{ $map->{Shapes} } + 1;
  push @{ $map->{Shapes} }, $shape->{Exits};
  return 1;
}

# Connect two shapes on a map.
sub jigsaw {
  # We can be a bit confusing. We connect two shapes on a map. The one already
  # there on the map is ID 'to'. We're branching off of the wall in direction
  # 'dir' of number 'to_wall'. The new shape's opposite wall number 'from_wall'
  # is connected. Got it?
  my ($new, $indat) = @_;
  my $map = $indat->{on};
  my $dir = $indat->{dir};
  my $align = $indat->{align} || "start";
  my $data = $map->{Shapes}[ $indat->{to} ]{$dir}[ $indat->{to_wall} ];
  my $newdata = $new->{Exits}{ oppdir($dir) }[ $indat->{from_wall} ];

  my ($y, $x, $skip);
  # We just place, actually.
  if ($dir eq "N") {
    $y = $data->{Y1} - $newdata->{Y1} - 1;
    $x = $data->{X1} - $newdata->{X1};
    $skip = ($data->{X2} - $data->{X1}) - ($newdata->{X2} - $newdata->{X1});
    $x += CONFIG->random($skip) if $align eq "middle";
    $x += $skip if $align eq "end";
  } elsif ($dir eq "S") {
    $y = $data->{Y1} + 1 - $newdata->{Y1};
    $x = $data->{X1} - $newdata->{X1};
    $skip = ($data->{X2} - $data->{X1}) - ($newdata->{X2} - $newdata->{X1});
    $x += CONFIG->random($skip) if $align eq "middle";
    $x += $skip if $align eq "end";
  } elsif ($dir eq "W") {
    $y = $data->{Y1} - $newdata->{Y1};
    $x = $data->{X1} - $newdata->{X1} - 1;
    $skip = ($data->{Y2} - $data->{Y1}) - ($newdata->{Y2} - $newdata->{Y1});
    $y += CONFIG->random($skip) if $align eq "middle";
    $y += $skip if $align eq "end";
  } elsif ($dir eq "E") {
    $y = $data->{Y1} - $newdata->{Y1};
    $x = $data->{X1} + 1 - $newdata->{X1};
    $skip = ($data->{Y2} - $data->{Y1}) - ($newdata->{Y2} - $newdata->{Y1});
    $y += CONFIG->random($skip) if $align eq "middle";
    $y += $skip if $align eq "end";
  }

  return unless place($new, { on => $map, at => [ $y, $x ] });
  clearout(
    on      => $map,
    between => [
                 [$indat->{to}, $indat->{to_wall}], 
                 [$#{ $map->{Shapes} }, $indat->{from_wall}]
               ],
    dir     => $dir
  );
  return 1;
}

# After two shapes have been connected, they need a path cleared between them.
sub clearout {
  my %data = @_;
  my $map = $data{on};
  my $dir = $data{dir};
  my $two = $data{between};
  my $data = $map->{Shapes}[ $two->[0][0] ]{$dir}[ $two->[0][1] ];
  my $newdata = $map->{Shapes}[ $two->[1][0] ]{oppdir $dir}[ $two->[1][1] ];

  my $small = is_vert($dir) ? "X" : "Y";

  # Which 
  my $new = (
             $newdata->{ "${small}2" } - $newdata->{ "${small}1" }
            <
             $data->{ "${small}2" } - $data->{ "${small}1" }
            );
  my $old = !$new;

  my $dat = ($new) ? $newdata : $data;
  my %dat = %$dat;
  my ($y1, $x1, $y2, $x2);
  ($y1, $x1, $y2, $x2) = @dat{"Y1", "X1", "Y1", "X2"} if is_vert($dir);
  ($y1, $x1, $y2, $x2) = @dat{"Y1", "X1", "Y2", "X1"} if is_horiz($dir);

  $dir = oppdir($dir) if $new;

  # Tough to refactor this. :(
  $y1--, $x1++, $x2-- if $dir eq "N";
  $x1++, $y2++, $x2-- if $dir eq "S";
  $y1++, $x1--, $y2-- if $dir eq "W";
  $y1++, $y2--, $x2++ if $dir eq "E";

  fill($map, [ $y1, $x1 ], [ $y2, $x2 ], ".");

  # TODO: the logical connect thing.
  return 1;
}

# Apply Conway's Game of Life rules to a map.
sub cellular {
  my ($map, $iters) = @_;
  my $old = [];
  # Each time they invert or something.
  foreach (1 .. $iters * 2) {
    # Store old copy!
    foreach my $y (0 .. $map->height) {
      foreach my $x (0 .. $map->width) {
        $old->[$y][$x] = $map->{Map}[$y][$x]{_};
      }
    }
    # Apply Game of Life rules
    foreach my $y (1 .. $map->height - 1) {
      foreach my $x (1 .. $map->width - 1) {
        # How many neighbors?
        my $neighbors = 0;
        $neighbors++ if $old->[$y - 1][$x - 1] eq "#";
        $neighbors++ if $old->[$y - 1][$x] eq "#";
        $neighbors++ if $old->[$y - 1][$x + 1] eq "#";
        $neighbors++ if $old->[$y][$x - 1] eq "#";
        $neighbors++ if $old->[$y][$x + 1] eq "#";
        $neighbors++ if $old->[$y + 1][$x - 1] eq "#";
        $neighbors++ if $old->[$y + 1][$x] eq "#";
        $neighbors++ if $old->[$y + 1][$x + 1] eq "#";
        $map->{Map}[$y][$x]{_} = $neighbors < 3 ? "#" : ".";
      }
    }
  }
  return 1;
}

# Fills the map with the specified tile from range [Y, X] to [Y, X].
sub fill {
  my ($self, $from, $to, $with) = @_;
  # We don't have to worry about the default TileKey and all nonsense since
  # this is internal BDSM stuff. What happens in the dungeon stays in the
  # dungeon...
  my ($y1, $x1) = @$from;
  my ($y2, $x2) = @$to;
  fix_coords($y1, $y2);
  fix_coords($x1, $x2);
  foreach my $y ($y1 .. $y2) {
    foreach my $x ($x1 .. $x2) {
      $self->{Map}[$y][$x]{_} = $with;
    }
  }
  return 1;
}

# Change every $from tile to a $to tile.
sub transform {
  my $map = shift;
  my %tr = @_;
  # We don't mess with the borders.
  foreach my $y (1 .. $map->height - 1) {
    foreach my $x (1 .. $map->width - 1) {
      foreach my $from (keys %tr) {
        $map->{Map}[$y][$x]{_} = $tr{$from} if $map->{Map}[$y][$x]{_} eq $from;
      }
    }
  }
  return 1;
}

# Properly border an entire map with some complex rules.
sub border {
  # TODO: Here be dragons... I've forgotten all of this. No really, this is
  # magick.
  my $self = shift;
  my $map = $self->{Map};
  my $cnty = 0;
  foreach my $y (0 .. $self->height) {
    my $cntx = 0;
    foreach my $x (0 .. $self->width) {
      $map->[$y][$x]{_} = "#"
      if
        $y != 0
      and
        $map->[$y - 1][$x]{_} eq "."
      and
        $map->[$y][$x]{_} eq " ";
      $map->[$y][$x]{_} = "#"
      if
        $y != 0
      and
        $x != 0
      and
        $map->[$y - 1][$x - 1]{_} eq "."
      and
        $map->[$y][$x]{_} eq " ";
      $map->[$y][$x]{_} = "#"
      if
        $y != 0
      and
        defined $map->[$y - 1][$x + 1]
      and
        $map->[$y - 1][$x + 1]{_} eq "."
      and
        $map->[$y][$x]{_} eq " ";
      next unless $map->[$y][$x]{_} eq ".";
      $map->[$y][$x]{_} = "#" if $cnty == 0 or $cntx == 0;
      $map->[$y][$x]{_} = "#" if $y != 0 and $map->[$y - 1][$x]{_} eq " ";
      $map->[$y][$x]{_} = "#" if $x != 0 and $map->[$y][$x - 1]{_} eq " ";
      $map->[$y][$x]{_} = "#"
      if
        defined $map->[$y][$x + 1]
      and
        $map->[$y][$x + 1]{_} eq " ";
      $map->[$y][$x]{_} = "#"
      if
        $y != 0
      and
        $x != 0
      and
        $map->[$y - 1][$x - 1]{_} eq " ";
      $map->[$y][$x]{_} = "#"
      if
        $y != 0
      and
        defined $map->[$y - 1][$x + 1]
      and
        $map->[$y - 1][$x + 1]{_} eq " ";
      $map->[$y][$x]{_} = "#" if $cnty == $self->height;
      $cntx++;
    }
    $map->[$y][-1]{_} = "#" if $map->[$y][-1]{_} eq ".";
    $cnty++;
  }
  return 1;
}

# Discovers the data for each wall in the shape, searching the specified number
# of tiles in each direction.
sub findwalls {
  my ($self, $ncut, $scut, $wcut, $ecut) = @_;
  $self->{Exits} = {};
  _walltrace($self, "N", [ 0 .. $ncut ]);
  _walltrace($self, "S", [ $self->height - $scut .. $self->height ]);
  _walltrace($self, "W", [ 0 .. $wcut] );
  _walltrace($self, "E", [ $self->width - $ecut .. $self->width] );
}

# Finds and records the coordinates of every wall of a shape in the specified
# direction. Needs a list of loopable big units.
sub _walltrace {
  # Here be meta-programming dragons...
  my ($self, $dir, $loop) = @_;
  my $measure = is_vert($dir) ? "width" : "height";
  my $uhoh = ($measure eq "width") ? $self->height : $self->width;
  $uhoh = 0 if $dir =~ m/[NW]/i;  # Careful
  # The trick is going to be figuring out which of $big and $small are y/x...
  my ($y, $x, $dat) = (undef, undef, {});
  ($y, $x) = ("big", "small") if is_vert($dir);
  ($x, $y) = ("big", "small") if is_horiz($dir);
  my $BIG = ($y eq "big") ? "Y" : "X" ;
  my $SMALL = ($BIG eq "Y") ? "X" : "Y" ;
  # Go through every row or column specified.
  foreach my $big (@$loop) {
    $dat->{big} = $big;
    my $cnt = 0;                # How long is the wall so far?
    my ($start, $end) = (0, 0); # Where does the wall start and end?
    my $mode = 0;               # == 1 if we have a wall right now
    # Go through the row or column.
    foreach my $small (0 .. $self->$measure) {
      $dat->{small} = $small;
      # Are we at a wall?
      if ($self->{Map}[ $dat->{$y} ][ $dat->{$x} ]{_} eq "#") {
        # Wall requirements below. Are we in a bad spot, basically?
        my ($Y, $X) = dircoord($dir, $dat->{$y}, $dat->{$x});
        next if $big != $uhoh and $self->{Map}[$Y][$X]{_} ne " ";
        $start = $small if $mode == 0;  # Is this our first tile?
        $mode = 1;  # Inevitably
        $end = $small;
        $cnt++;
      } elsif ($mode == 1) {  # We might have a chance!
        push @{ $self->{Exits}{$dir} }, {
          "${BIG}1" => $big,
          "${BIG}2" => $big,
          "${SMALL}1" => $start,
          "${SMALL}2" => $end,
        } if $cnt >= CONFIG->MinWallLength;
        $cnt = $mode = $start = $end = 0;   # Clear things.
      }
    }
    # There might be a wall at the very end we didn't add yet.
    push @{ $self->{Exits}{$dir} }, {
      "${BIG}1" => $big,
      "${BIG}2" => $big,
      "${SMALL}1" => $start,
      "${SMALL}2" => $end,
    } if $cnt >= CONFIG->MinWallLength;
  }
}

# A testing routine to make sure the correct walls were marked.
sub check_walls {
  my $self = shift;
  foreach my $dir (compass_dirs) {
    print STDERR "\n$dir walls:\n";
    foreach my $wall (@{ $self->{Exits}{$dir} }) {
      $self->{Map}[ $wall->{Y1} ][ $wall->{X1} ]{_} = "<";
      $self->{Map}[ $wall->{Y2} ][ $wall->{X2} ]{_} = ">";
      $self->dump;
      $self->{Map}[ $wall->{Y1} ][ $wall->{X1} ]{_} = "#";
      $self->{Map}[ $wall->{Y2} ][ $wall->{X2} ]{_} = "#";
    }
  }
}

# Picks a random point on a wall.
sub spawnwall {
  my ($wall, $dir, $map) = @_;
  my ($y, $x);
  if (is_vert($dir)) {
    $y = $wall->{Y1};
    $x = CONFIG->random($wall->{X1} + 1, $wall->{X2} - 1);
  } else {
    $y = CONFIG->random($wall->{Y1} + 1, $wall->{Y2} - 1);
    $x = $wall->{X1};
  }

  # With the wall coordinates chosen, see if the tile right off it is valid.
  ($y, $x) = dircoord($dir, $y, $x);
  if ($y <= 0 or $y >= $map->height or $x <= 0 or $x >= $map->width) {
    return -1;
  }
  return ($y, $x);
}

# Draws a corridor along the given path.
sub carvepath {
  my ($map, @path) = @_;
  foreach my $tile (@path) {
    my ($y, $x) = @$tile;
    $map->{Map}[$y][$x]{_} = ".";
    # Put up some walls, hmm?
    foreach my $dir (vi_dirs) {
      ($y, $x) = keycoord($dir, @$tile);
      die "PATH BUG!\n" if $y < 0 or $y > $map->height or $x < 0
                           or $x > $map->width;
      # This was a problem in some ancient version. Probably gone now, but just
      # a sanity check.
      $map->{Map}[$y][$x]{_} = "#" if $map->{Map}[$y][$x]{_} eq " ";
    }
  }
  return 1;
}

# Forge additional pathways between adjacent shapes with walls otherwise
# blocking them.
sub excavate {
  my $map = shift;
  foreach my $y (1 .. $map->height - 1) {
    WALL: foreach my $x (1 .. $map->width - 1) {
      next unless $map->{Map}[$y][$x]{_} eq "#";
      foreach my $dir (vi_dirs) {
        my ($Y, $X) = keycoord($dir, $y, $x);
        next WALL if $map->{Map}[$Y][$X]{_} eq " ";
      }
      $map->{Map}[$y][$x]{_} = ".";
    }
  }
  return 1;
}

# We are such cruft.
sub loadmap {
  my $file = shift;
  open FH, "<$file" or die "Can't open $file: $!\n";
  my $grid = [];
  while (<FH>) {
    $_ =~ s/\n//;;
    my $row = [];
    foreach my $char (split '', $_) {
      push @$row, $char;
    }
    push @$grid, $row;
  }
  my $map = bdsm_map($#{$grid}, $#{ $grid->[0] }, ".");
  foreach my $y (0 .. $#{ $grid }) {
    foreach my $x (0 .. $#{ $grid->[0] }) {
      $map->mod($y, $x, $grid->[$y][$x]);
    }
  }
  close FH;
  return $map;
}

42;