##########
# Engine #
##########

package Roguelike::Engine;

use strict;
use warnings;
use Roguelike::Game;
use Roguelike::Utility;

use Roguelike::UI;
use Roguelike::PriorityQueue;
use Roguelike::Object;
use Cwd;

# Well, we need em, OK? Geez.

use Roguelike::Area;
use Roguelike::Area::Dungeon;
use Roguelike::Area::Cellular;
use Roguelike::Area::Tunnel;
use Roguelike::Area::Building;
use Roguelike::Area::Maze;
use Roguelike::Area::Test;

sub new {
  my $class = shift;
  my $queue = new Roguelike::PriorityQueue;
  my $self = bless {
    UI        => Roguelike::UI->select,
    Queue     => $queue,
    Actions   => {},
    Messages  => [],
    MsgLog    => [],
    Silence   => 0,
    Templates => {
      Obj => bless {
        # Default attributes of any objects
        Name     => "Unknown",
        Qty      => 1,
        Category => "Default",
        ID       => 0,
        Type => "Object"
      }, "Roguelike::Object"
    },
    Content => {},  # For stuff we load in
    Config => { # These're all defaults, naturally
      Category => {
        Projectiles   => { Group => ["Mod", "Enchantment"] },
        Food          => { Group => ["Name"] },
        Scrolls       => { Group => ["Name"] },
        Potions       => { Group => ["Name"] },
        Weapons       => { Group => 0 },
        Armour        => { Group => 0 },
        Miscellaneous => { Group => ["Name"] },
        Default       => { Group => 0 },
      },
    },
    Random => {
      Queued => [],
      Used   => []
    },
    Levels => [],
    ItemPopulation => [],
    MonsterPopulation => [],
    MaxDepth => 1,  # The use for this is messy
    ActiveInv => [],
    Round => 0,
    Refresh => 1,
    Top => 0,
    LastTop => -1,
    Left => 0,
    LastLeft => -1,
    Bottom => 0,
    LastBottom => -1,
    Right => 0,
    LastRight => -1,
    ForceRefresh => -1,
    Containers => [],
    @_
  }, $class;
  push @{ $self->{IDs} }, $self->{Templates}{Obj};
  return $self;
}

sub start {
  my $self = shift;
  # Set up delayed reactions and such
  $_->() foreach @{ $self->{DelayedInit} };
  $self->{UI}->msgrefresh;
  # Do per-game initialization stuff. The UI will provide a pretty menu
  # interface.
  $self->main;
}

sub main {
  # Everybody's initial priority is always 1 for now.
  my $self = shift;
  my $queue = $self->{Queue};
  $queue->add( pop @{ $Player->{Queue} } );
  if ($Player->g("Area.Monsters")) {
    $queue->add( pop @{ $_->{Queue} } ) foreach $Player->a("Area.Monsters");
  }
  while (1) {
    my $node = $queue->extract;
    unless ($node) {
      debug "No scheduled actions! Bug!";
    }
    my $mod = $node->{Priority};
    foreach ($node, @{$queue}) {
      $_->{Priority} -= $mod unless $_->{Priority} == 0;
      $_->{Energy} += $mod;
    }
    # Maybe *we* should handle energy calculations as far as factoring in
    # speed...
    if ($node->{Energy} < $node->{Cost}) {
      # Delay it.
      $queue->add({
        %{ $node },
        Priority => $node->{Cost} - $node->{Energy},
      });
    } else {
      my @results = $node->{Action}->($node->{Actor}, @{ $node->{Args} });
      if ($node->{Type} == -42) {
        $queue->add(
          {
            %$node,
            Priority => $node->{OrigCost},
            Cost => $node->{OrigCost},
            Energy => 0
          }
        ) if $results[0] == -13;
      } else {
        if ($results[0] == -16) { # And another
          $node->{Actor} = $results[1];
        }
        $queue->add( shift @{ $node->{Actor}{Queue} } );
      }
    }
  }
}

sub save {
  my $self = shift;
  # File is hardcoded now! Haha. Overwritten, too. Nasty.
  my $path = "/home/dabreegster/perlrl/data";
  open SAVE, ">$path" or die "$path can't be modified! Gasp!";
  # Only thing we have to save so far is random numbers.
  print SAVE "$_\n" foreach @{ $Game->{Random}{Used} };
  close SAVE;
  # Now input!
  # File is hardcoded now! Haha. Overwritten, too. Nasty.
  $path = "/home/dabreegster/perlrl/indata";
  open SAVEL, ">$path" or die "$path can't be modified! Gasp!";
  print SAVEL "$_\n" foreach @{ $Game->{Input}{Used} };
  close SAVEL;
  return 1;
}

sub load {
  my $self = shift;
  # File is hardcoded now! Haha.
  my $path = "/home/dabreegster/perlrl/data";
  open LOAD, $path or return 0;
  # Only thing in there is random numbers.
  # Overwrite any in Queued.
  $Game->{Random}{Queued} = [];
  while (<LOAD>) {
    chomp($_);
    push @{ $Game->{Random}{Queued} }, $_;
  }
  close LOAD;
  # Now input
  # File is hardcoded now! Haha.
  $path = "/home/dabreegster/perlrl/indata";
  open LOAD, $path or return 0;
  # Overwrite any in Queued.
  $Game->{Input}{Queued} = [];
  while (<LOAD>) {
    chomp($_);
    push @{ $Game->{Input}{Queued} }, $_;
  }
  close LOAD;
  return 1;
}

sub addlevel {
  shift;
  my $map;
  my $populate;
  if ($_[0] =~ m/^</) {
    #say "<Green>Loading map...";
    #$Game->{UI}->msgrefresh;
    $populate = 0;
    $map = shift;
    $map =~ s/^<//;
    $map = loadmap($map);
    # loadmap will call populate() if necessary. Things might be fixed on the
    # external map!
  } else {
    say "<Green>Generating map...";
    $Game->{UI}->msgrefresh;
    $populate = 1;
    my $style = "Roguelike::Area::" . shift();
    $map = $style->generate(@_);
  }
  $map->{Monsters} ||= [];
  # Add the new level
  push @{ $Game->{Levels} }, $map;
  $map->{ID} = $#{ $Game->{Levels} };
  my $z = $#{ $Game->{Levels} };
  $map->{Depth} = $z;
  populate($map, $#{ $Game->{Levels}[-2]{StairsDown} }) if $populate;
  # Are we level 0 though? Nothing above us.
  return $z if $z == 0;
  # Connect $z's up staircases to $z-1's down staircases
  my $cnt = 0;
  foreach (0 .. $#{ $map->{StairsUp} }) {
    $cnt = 0 if $cnt > $#{ $Game->{Levels}[-2]{StairsDown} };
    $map->{Map}[ $map->{StairsUp}[$_][0] ][ $map->{StairsUp}[$_][1]]{Stair} = $cnt;
    $cnt++;
  }
  $cnt = 0;
  foreach (0 .. $#{ $Game->{Levels}[-2]{StairsDown} }) {
    $cnt = 0 if $cnt > $#{ $map->{StairsUp} };
    $Game->{Levels}[-2]{Map}[ $Game->{Levels}[-2]{StairsDown}[$_][0] ][ $Game->{Levels}[-2]{StairsDown}[$_][1] ]{Stair} = $cnt;
    $cnt++;
  }
  return $z;
}

sub parsecontent {
  my $self = shift;
  # Hardcoding, WHATEVER
  my $path = getcwd . "/" . shift;
  # First load and parse the data.
  my $entries = {};
  open LOAD, $path or die "Can't open $path! $!";
  my $current = 0;
  my $multi = 0;
  while (<LOAD>) {
    chomp($_);
    my $line = $_;
    # Description is the only weird thing, as it must have leading whitespace
    # to continue
    if ($multi eq "Desc") {
      if ($line =~ s/^\s+//) {
        $current->{Desc} .= " $line";
        next;
      } else {
        # Done!
        $multi = 0;
      }
    }
    $line =~ s/^\s+//;
    next unless $line;
    next if $line =~ m/^#/;
    if ($multi) {
      # Finished?
      if ($line eq ")>") {
        $multi = 0;
        next;
      }
      if ($multi eq "Behavior") {
        push @{ $current->{Behavior} }, $line;
      } else {
        $current->{$multi}{Code} .= "\n$line";
      }
      next;
    }
    # So what've we got here?
    if ($line =~ m/^<(\w+) = (\w+)>$/) {
      $current = { Type => $1, Base => $2 };
      next;
    }
    if ($line =~ m/<\/>/) {
      $entries->{ $current->{Type} } = $current;
      $current = 0;
      next;
    }
    if ($line eq "Behavior: <(") {
      $multi = "Behavior";
      $current->{Behavior} = [];
      next;
    }
    if ($line =~ m/^{/) { # Action code
      $line =~ s/ <\($//;
      # We MIGHT have data!
      $line =~ m/^{(\w+)}/;
      $multi = "ACT_$1";
      $current->{$multi} = { Code => "" };
      if ($line =~ m/\((\d+)\)$/) {
        $current->{$multi}{Cost} = $1;
      }
      next;
    }
    if ($line =~ m/ <\($/) {  # Event code
      # First we get the name.
      $line =~ s/^(\w+): //;
      $multi = "EVENT_$1";
      # Now the event.
      $line =~ s/\[(.+)\] //;
      $current->{$multi} = { Code => "", Event => $1 };
      unless ($line eq "<(") {
        $line =~ m/\((.+)\)/;
        my $data = $1;
        foreach my $property (split(/,/, $data)) {
          $property =~ s/^(.+)=//;
          $current->{$multi}{$1} = $property;
        }
      }
      next;
    }
    # A normal data property. BORING.
    $line =~ s/^(\w+): //;
    $current->{$1} = $line;
    $multi = "Desc" if $1 eq "Desc";
    next;
  }
  close LOAD;
  return $entries;
}

sub loadmons {
  my $self = shift;
  my $monsters = $Game->parsecontent( shift() );
  # Translate into actual objects...
  my @monsters;
  foreach my $dat (values %{ $monsters }) {
    my $char = $Game->{Templates}{ $dat->{Base} }->new(
      Name => $dat->{Name},
      Desc => $dat->{Desc},
      Rank => defined $dat->{Rank} ? $dat->{Rank} : undef,
      Type => $dat->{Type},
      Unique => defined $dat->{Unique} ? $dat->{Unique} : undef,
    );
    ($char->{Color}, $char->{Symbol}) = split(/ /, $dat->{Symbol});
    foreach my $stat (qw( Str Def HP TP Exp )) {
      next unless $dat->{$stat};
      if ($dat->{$stat} =~ m/^\d+$/) {
        $char->{$stat} = $dat->{$stat};
      } else {
        $dat->{$stat} =~ m/^(\d+)[.\s,]+(\d+)$/;
        $char->{$stat} = [$1, $2];
      }
    }
    # Actions and events anybody?
    foreach my $key (keys %$dat) {
      if ($key =~ m/^EVENT_(.+)/) {
        my $name = $1;
        my $event = delete $dat->{$key}{Event};
        my $react = eval "sub { $dat->{$key}{Code} }" or debug $@;
        delete $dat->{$key}{Code};
        push @{ $Game->{DelayedInit} }, sub {
          $char->react(
            to => [ split(/ /, $event) ],
            by => $react,
            Name => $name,
            %{ $dat->{$key} }
          )
        };
      } elsif ($key =~ m/^ACT_(.+)/) {
        my $name = $1;
        my $react = eval "sub { $dat->{$key}{Code} }" or debug $@;
        delete $dat->{$key}{Code};
        if ($name =~ s/^UTIL_//) {
          $char->{Routines}{$name} = $react;
        } elsif ($name =~ s/^PRE_//) {
          $char->{Checks}{$name} = $react;
        } else {
          # An attack, then.
          $char->{Attacks}{$name} = {
            Action => $react,
            TP     => $dat->{$key}{Cost} || 0
          };
        }
      } else {
        next;
      }
    }
    # Behavior?
    if ($dat->{Behavior}) {
      $char->{Behavior} = [];
      # Parse it... oh boy.
      my $state = undef;
      foreach my $line (@{ $dat->{Behavior} }) {
        if ($state) {
          # Parse $state
          if ($state eq "else") {
            push @{ $char->{Behavior} }, { Condition => [ [$state] ] };
          } else {
            push @{ $char->{Behavior} }, { Condition => [] };
            foreach my $condition (split(/ and /, $state)) {
              $condition =~ s/\)$//;
              $condition =~ s/^([^\(]+)\(//;
              push @{ $char->{Behavior}[-1]{Condition} }, [$1, split(/, /, $condition)];
            }
          }
          # Parse action
          $line =~ s/\)$//;
          $line =~ s/^([^\(]+)\(//;
          $char->{Behavior}[-1]{Action} = [$1, split(/, /, $line)];
          $state = undef;
        } else {
          $line =~ s/,$//;
          $line =~ s/^(if |else)//;
          if ($1 eq "else") {
            $state = "else";
          } else {
            $state = $line;
          }
        }
      }
    }
    # Lastly, set it up with some equipment.
    # We have to actually parse it first. Sucks.
    $char->{Wearing} = [];
    if ($dat->{Equipment}) {
      foreach (split(/, /, $dat->{Equipment})) {
        if (m/^(.+) \((\w+)\)/) {
          push @{ $char->{Wearing} }, [$Game->{Content}{$1}, $2];
        } else {
          push @{ $char->{Wearing} }, $Game->{Content}{$1};
        }
      }
    }
    $Game->{Content}{ $char->g("Type") } = $char;
    if ($char->is("Player")) {
      # $char is the Player template, we want the actual instance!
      $Player = $char->new(PCInstance => 1);
    } else {
      push @monsters, $char;
    }
  }
  # Its position in the population list depends upon Rank
  push @{ $Game->{MonsterPopulation} }, @monsters;
  return @monsters;
}

sub loaditems {
  my $self = shift;
  my $dat = $Game->parsecontent( shift() );
  # Translate into actual objects...
  my @items;
  foreach my $dat (values %{ $dat }) {
    my $item = $Game->{Templates}{ $dat->{Base} }->new(
      Name => $dat->{Name},
      Desc => $dat->{Desc},
      Durability => defined $dat->{Durability} ? $dat->{Durability} : undef,
      Power => defined $dat->{Power} ? $dat->{Power} : undef,
      Rank => defined $dat->{Rank} ? $dat->{Rank} : undef,
      MaxMod => defined $dat->{MaxMod} ? $dat->{MaxMod} : undef,
      Category => defined $dat->{Category} ? $dat->{Category} : undef,
      Wieldable => defined $dat->{Wieldable} ? $dat->{Wieldable} : undef,
      Readable => defined $dat->{Readable} ? $dat->{Readable} : undef,
      Fits => defined $dat->{Fits} ? [split(/, /, $dat->{Fits})] : undef,
      Ranged => defined $dat->{Ranged} ? $dat->{Ranged} : undef,
      Type => $dat->{Type},
      Unique => defined $dat->{Unique} ? $dat->{Unique} : undef,
    );
    ($item->{Color}, $item->{Symbol}) = split(/ /, $dat->{Symbol});
    # Event reactions!
    foreach my $key (keys %$dat) {
      next unless $key =~ m/^EVENT_(.+)/;
      my $name = $1;
      my $event = delete $dat->{$key}{Event};
      my $react = eval "sub { $dat->{$key}{Code} }" or debug $@;
      delete $dat->{$key}{Code};
      push @{ $Game->{DelayedInit} }, sub {
        $item->react(
          to => [ split(/ /, $event) ],
          by => $react,
          Name => $name,
          %{ $dat->{$key} }
        )
      };
    }
    push @items, $item;
    $Game->{Content}{ $item->g("Type") } = $item;
  }
  # Its position in the population list depends upon Rank
  push @{ $Game->{ItemPopulation} }, @items;
  return @items;
}

sub loadkeymap {
  my $self = shift;
  # Hardcoding, WHATEVER
  my $path = getcwd . "/" . shift;
  open LOAD, $path or die "Can't open $path! $!";
  while (<LOAD>) {
    chomp($_);
    my $line = $_;
    $line =~ m/^(.+):(.+)$/;
    my ($key, $action) = ($1, $2);
    $action =~ s/\s+//g;
    if ($Game->{UI}{Keymap}{$key}) {
      debug "Key $key remapped from $Game->{UI}{Keymap}{$key} to $action!";
    }
    $Game->{UI}{Keymap}{$key} = $action;
  }
  close LOAD;
  return 1;
}

42;
