package BDSM::Area::Dungeon;

use strict;
use warnings;
use include;

use BDSM::Util;

use BDSM::Transform;
use BDSM::Shape::Room;
use BDSM::Shape::Hall;

use List::Util ("shuffle");

# Returns a dungeon of specified height and width.
sub generate {
  shift;  # We know who we are!
  my ($height, $width) = @_;
  inform "Creating blank map...";
  my $map = bdsm_map($height, $width, ".");
  $map->{Shapes} = [];  # List of data. (Type, NSWE walls, remember?)
  border($map);
  fill($map, [ 1, 1 ], [ $height - 1, $width - 1 ], " ");
  my $depth = CONFIG->SpawnRecurse;

  die "Depth < 1!\n" if $depth < 1;
  my @dead = shuffle( spawn($map, { First => 1 }, $depth) );
  # Build (hopefully) twisty corridors to link the remaining dead-ends.
  while (@dead > 1) {
    last; # TODO: TMP
    my $one = shift @dead;
    my ($y1, $x1) = spawnwall($one, $one->{Dir}, $map);
    # Another corridor may have merged into the deadend. Save some time, eh?
    next if $y1 == -1 or $map->{Map}[$y1][$x1]{_} ne " ";
    # do we want a full check? not always...

    # Instead of randomly pairing deadends and repeatedly failing, try to pair
    # $one with any and all. If they all fail, consider stretching it.
    foreach (0 .. $#dead) {
      inform "Cleaning up " . $#dead . " dead-ends... (try $_)";
      my $two = $dead[$_];
      my ($y2, $x2) = spawnwall($two, $two->{Dir}, $map);
      next if $y2 == -1;

      my @path = $map->pathfind($y1, $x1, $y2, $x2,
                                {
                                  Diags => 0,
                                  Pass  => sub {
                                    # We can't traverse wall!
                                    return if shift()->{_} eq "#";
                                    return 1;
                                  }
                                }
                               );
      unless ($path[0] == -1) {
        carvepath($map, @path);
        splice(@dead, $_, 1);
        last;
      }
    }
  }

  inform "Connecting adjacent paths...";
  excavate($map); # screws logical connections right now
  inform "Done!";

  return $map;
}

sub spawn {
  my ($map, $dat, $depth) = @_;
  inform "Spawning for depth $depth...";
  my @dead;
  # We connect a room to the specified hallway (or place the first one), build
  # hallways off the room, and recursively call ourselves on each hallway.

  # Gimme a room!
  my $room = new_room( CONFIG->RoomDims );
  if ($dat->{First}) {
    place($room, {
      on => $map,
      at => [ CONFIG->FirstRoomYX($map, $room) ]
    }) or die "Whoa, first room place failed. Small map?\n";
  } else {
    # Connect to the specified exit
    jigsaw($room, {
      on        => $map,
      to_wall   => 0,  # Halls only have one wall on each side
      from_wall => CONFIG->random(0,
                                 $#{ $room->{Exits}{ oppdir($dat->{dir}) } }
                                ),
        # A random wall on the room ^
      align     => "middle",
      %$dat   # 'to' (ID) and 'dir'
    }) or return {
      ID => $dat->{to}, Wall => 0, Dir => $dat->{dir},
      %{ $map->{Shapes}[ $dat->{to} ]{ $dat->{dir} }[0] }
    };
  }

  # Build all halls then recurse or recurse first?
  my @spawn;

  # Branch hallways off of (TODO: right now) every wall
  foreach my $dir (compass_dirs) {
    foreach my $wall (0 .. $#{ $room->{Exits}{$dir} }) {
      # TODO: the corridor style too!
      my $hall = new_hall(
        is_vert($dir) ? CONFIG->VertHallDims : CONFIG->HorizHallDims
      );
      jigsaw($hall, {
        on          => $map,
        to          => $room->{ID},
        dir         => $dir,
        to_wall     => $wall,
        from_wall   => 0,  # Halls only have one wall on each side
        align       => "middle"
      }) and push @spawn, { to => $#{ $map->{Shapes} }, dir => $dir };
    }
  }

  # Recurse?
  $depth--;
  if ($depth) {
    push(@dead, spawn($map, $_, $depth)) foreach @spawn;
  } else {
    push @dead, {
      ID => $_->{to}, Wall => 0, Dir => $_->{dir},
      %{ $map->{Shapes}[ $_->{to} ]{ $_->{dir} }[0] }
    } foreach @spawn;
  }
  return @dead;
}

42;
