######
# UI #
######

package Roguelike::UI;

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

use Roguelike::Interface::Curses;

sub select {
  # I guess we can actually define other windows and stuff, but for now we only
  # use these standard three.
  my $layout = {
    Display => { At => [0, 0], Size => ["100% - 7", "60%"], Border => 0 },
    #Display => { At => [0, 0], Size => ["60%", "60%"], Border => 1 },
    Status  => { At => [0, "60%"], Size => ["100% - 7", "40%"], Border => 0 },
    MsgConsole => { At => ["100% - 7", 0], Size => [7, "100%"], Border => 0 },
    Console => { At => [0, 0], Size => ["100%", "100%"], Border => 0 }
  };
  my $tiles = {
    " " => {
      Symbol => " ",
      Type   => "space",
    },
    "." => {
      Symbol => ".",
      Type   => "ground",
    },
    "#" => {
      Symbol  => "#",
      Color   => "orange",
      Type    => "wall",
      Barrier => 1
    },
    "+" => {
      Symbol  => "+",
      Type    => "closed door",
      Barrier => 1
    },
    "'" => {
      Symbol => "'",
      Type   => "open door"
    },
    "<" => {
      Symbol => "<",
      Type   => "staircase up"
    },
    ">" => {
      Symbol => ">",
      Type   => "staircase down"
    },
    "*" => {
      Symbol => "*",
      Color => "Yellow",
      Type => "debug"
    },
    "~" => {
      Symbol => "~",
      Color  => "Blue",
      Type   => "wave"
    },
    "-" => {
      Symbol => "-",
      Color  => "Black",
      Type   => "railing",
      Barrier => 1
    },
  };
  my $statbar = sub {
    my $weapon = $Player->g("Equipment.Weapon") ? $Player->g("Equipment.Weapon")->invname : "Unarmed";
    $weapon =~ s/ \(wielded\)$//;
    my $width = $Game->{UI}{Interface}{StatusX};
    my @print = (
      " " x (int(($width - 6) / 2) + 1) . "<Green>PerlRL",
      "",
    );
    # Initialize strings.
    my $hp = "<purple>HP:<grey> $Player->{HP}/" . $Player->g("MaxHP");
    my $tp = "<purple>TP:<grey> $Player->{TP}/" . $Player->g("MaxTP");
    my $str = "<purple>Str:<grey> $Player->{Str}";
    my $def = "<purple>Def:<grey> $Player->{Def}";
    my $lvl = "<aqua>Level:<grey> $Player->{Level}";
    my $turns = "<red>Turns:<grey> $Player->{Turns}";
    my $exp = "<aqua>Exp:<grey> $Player->{Exp}/$Player->{ExpNeeded}";
    my $mons = "<green>Monsters:<grey> " . $Player->a("Area.Monsters");
    my $l;  # Always - the difference between the current line and monster line.

    $l = $width - (length($hp) - 14) - (length($tp) - 14);
    $l += (length($tp) - 14) - (length($mons) - 13);
    push @print, $hp . " " x $l . $tp;

    $l = $width - (length($str) - 14) - (length($def) - 14);
    $l += (length($def) - 14) - (length($mons) - 13);
    push @print, $str . " " x $l . $def;

    $l = $width - (length($lvl) - 12) - (length($mons) - 13);
    push @print, $lvl . " " x $l . $mons;

    $l = $width - (length($exp) - 12) - (length($turns) - 11);
    $l += (length($turns) - 11) - (length($mons) - 13);
    push @print, $exp . " " x $l . $turns;

    push @print, ($Player->g("Laughing") ? "<yellow>Laughing" : "<orange>Calm");
    push @print, "<Red>$weapon";
    push @print, "<LINE>";
    push @print, @{ $Game->{ActiveInv} };
    return @print;
  };
  # For lack of a better way to do this...
  $tiles->{space} = $tiles->{" "};
  $tiles->{ground} = $tiles->{"."};
  $tiles->{wall} = $tiles->{"#"};
  my $self = bless {
    Tiles      => $tiles,
    StatLayout => $statbar,
    MsgFilters => [
      sub { my $msg = shift; $msg =~ s/\[DEBUG\]/<RED>[DEBUG]/g; return $msg; },
      sub { my $msg = shift; $msg =~ s/\[WARN\]/<RED>[WARN]/g; return $msg; }
    ],
    Layout     => $layout,  # For later reference
    # Real intelligent choosing of interface, eh? There's just so much
    # selection right now.
    Interface  => Roguelike::Interface::Curses->create($layout)
  }, shift;
  # Well I guess we do this.
  $self->{Interface}{TilesN} = int (($self->{Interface}{DisplayY} - 1) / 2);
  $self->{Interface}{TilesS} = $self->{Interface}{DisplayY} -
                               $self->{Interface}{TilesN} - 1;
  $self->{Interface}{TilesE} = int (($self->{Interface}{DisplayX} - 1) / 2);
  $self->{Interface}{TilesW} = $self->{Interface}{DisplayX} -
                               $self->{Interface}{TilesE} - 1;
  return $self;
}

sub refresh {
  my $self = shift;
  my $refreshy = 0;
  my $refreshx = 0;
  ($refreshy, $refreshx) = (1, 1) if $Game->{Centered};
  my $force = 0;
  if ($Game->{ForceRefresh}) {
    $force = 1;
    ($refreshy, $refreshx) = (1, 1);
    $Game->{ForceRefresh} = 0;
  }
  # Are we near the edge?
  if (!$Game->{UI}{Rows} or !@{ $Game->{UI}{Rows} }) {
    $refreshy = 1;
  } elsif ($Player->{Y} - $Game->{LastTop} <= 3) {
    $refreshy = 1;
  } elsif ($Game->{LastBottom} - $Player->{Y} <= 3) {
    $refreshy = 1;
  }
  if (!$Game->{UI}{Cols} or !@{ $Game->{UI}{Cols} }) {
    $refreshx = 1;
  } elsif ($Player->{X} - $Game->{LastLeft} <= 5) {
    $refreshx = 1;
  } elsif ($Game->{LastRight} - $Player->{X} <= 5) {
    $refreshx = 1;
  }
  my $map = $Player->g("Area");
  # Are we even recalculating the display?
  my (@rows, @cols);
  my $wrap = $Player->g("Area.Wrap");
  my $y = $Player->g("Y");
  my $x = $Player->g("X");
  my $n = $self->{Interface}{TilesN};
  my $s = $self->{Interface}{TilesS};
  my $e = $self->{Interface}{TilesE};
  my $w = $self->{Interface}{TilesW};
  if ($refreshy) {
    # Calculate the Y offsets.
    @rows = ();
    if ($map->height >= $self->{Interface}{DisplayY}) {
      my ($start, $end);
      if ($y - $n < 0 and (!$wrap)) {
        $start = 0;
      } else {
        $start = $y - $n;
      }
      push @rows, $start .. $y;
      if ($y + $s > $map->height) {
        $end = $map->height;
      } else {
        $end = $y + $n;
      }
      push @rows, $y + 1 .. $end;
      # I can't remember what all this is supposed to do; all I know is that it
      # works and that it took me a while to get going.
      my $spare = $self->{Interface}{DisplayY} - scalar @rows;
      my $sparewrap = 0;
      foreach (1 .. $spare) {
        if ($wrap) {
          push(@rows, $sparewrap++);
        } else {
          if ($map->{Map}[ $rows[-1] + 1 ]) {
            push @rows, $rows[-1] + 1;
          } else {
            unshift @rows, $rows[0] - 1;
          }
        }
      }
    } else {
      @rows = (0 .. $map->height);
    }
  } else {
    @rows = @{ $Game->{UI}{Rows} };
  }
  if ($refreshx) {
    # Calculate the X offsets.
    @cols = ();
    if ($map->width >= $self->{Interface}{DisplayX}) {
      my ($start2, $end2);
      if ($x - $w < 0 and (!$wrap)) {
        $start2 = 0;
      } else {
        $start2 = $x - $w;
      }
      push @cols, $start2 .. $x;
      if ($x + $e > $map->width) {
        $end2 = $map->width;
      } else {
        $end2 = $x + $e;
      }
      push @cols, $x + 1 .. $end2;
      # I can't remember what all this is supposed to do; all I know is that it
      # works and that it took me a while to get going.
      my $spare2 = $self->{Interface}{DisplayX} - scalar @cols;
      my $sparewrap2 = 0;
      foreach (1 .. $spare2) {
        if ($wrap) {
          push(@cols, $sparewrap2++);
        } else {
          if ($map->{Map}[0][ $cols[-1] + 1 ]) {
            push @cols, $cols[-1] + 1;
          } else {
            unshift @cols, $cols[0] - 1;
          }
        }
      }
    } else {
      @cols = (0 .. $map->width);
    }
  } else {
    @cols = @{ $Game->{UI}{Cols} };
  }
  # No we draw, gentlemen.
  # Since $wrap might be on and the list unordered, making select obselete,
  # we'll just do it ourselves.
  my @tilerows;
  my %list;
  $Game->{Round}++;
  # Update line-of-sight! But only if we need to.
  my $trick = 0;
  if ($Game->{Moved} or $force) {
    foreach my $y ($Player->{Y} - 3 .. $Player->{Y} + 3) {
      foreach my $x ($Player->{X} - 4 .. $Player->{X} + 4) {
        next if $y == $Player->{Y} - 3 and $x == $Player->{X} - 4;
        next if $y == $Player->{Y} - 3 and $x == $Player->{X} + 4;
        next if $y == $Player->{Y} + 3 and $x == $Player->{X} - 4;
        next if $y == $Player->{Y} + 3 and $x == $Player->{X} + 4;
        next if $y < 0 or $y > $map->height;
        next if $x < 0 or $x > $map->width;
        $map->{Map}[$y][$x]{Seen} = 1;
        $map->{Map}[$y][$x]{Visible} = $Game->{Round};
        $map->{Map}[$y][$x]{Changed} = 1;
        $list{ $map->{Map}[$y][$x]{Char}{ID} } = 1 if $map->{Map}[$y][$x]{Char} and !$map->{Map}[$y][$x]{Char}->is("Player");
      }
    }
    $trick = 1;
    $Game->{Moved} = 0;
  } else {
    %list = %{ $Game->{Active} };
  }
  my $iy = 0;
  foreach my $Y (@rows) {
    my $ix = 1;
    my $cols = [];
    foreach my $X (@cols) {
      if ($map->{Map}[$Y][$X]{Changed}) {
        next if $map->{Map}[$Y][$X]{Changed} == 2 and !$trick;
        $map->{Map}[$Y][$X]{Changed} = 2 if $trick;
        $map->{Map}[$Y][$X]{Changed} = 0 if $map->{Map}[$Y][$X]{Visible} ==
        $Game->{Round} - 1;
        render($map->{Map}[$Y][$X]);
        # Draw it if there are no shifts.
        if ($Game->{Top} == $Game->{LastTop} and $Game->{Left} == $Game->{LastLeft}) {
          $Game->{UI}{Interface}{Display}->addch(2 + $iy, 2 + $ix, $map->{Map}[$Y][$X]{_DISPLAY_});
        }
      }
      push @$cols, $map->{Map}[$Y][$X];
      $ix++;
    }
    $iy++;
    push @tilerows, $cols;
  }
  $Game->{Top} = $rows[0];
  $Game->{Bottom} = $rows[-1];
  $Game->{Left} = $cols[0];
  $Game->{Right} = $cols[-1];
  $Game->{Active} = \%list;
  # Refresh unless shifts.
  if ($force == 0 and $Game->{Top} == $Game->{LastTop} and $Game->{Left} == $Game->{LastLeft}) {
    $Game->{UI}{Interface}{Display}->refresh;
  } else {
    $self->{Interface}->draw(@tilerows);
  }
  if ($refreshy) {
    $Game->{LastTop} = $Game->{Top};
    $Game->{LastBottom} = $Game->{Bottom};
  }
  if ($refreshx) {
    $Game->{LastLeft} = $Game->{Left};
    $Game->{LastRight} = $Game->{Right};
  }
  $Game->{UI}{Rows} = \@rows;
  $Game->{UI}{Cols} = \@cols;
}

sub msgrefresh {
  my $self = shift;
  my $keep = shift || 0;  # Move this turn's messages to the log?
  # We only want to display 6 physical lines. So we have to factor in word wrap!
  # It's always 6 physical lines because of the layout. I'll make it
  # customizable later.
  # First we get the last 6 messages.
  # I wrote this code ages ago and, like the 'spare' bit in refresh(), I have
  # no clue how it works anymore, only that it does and that it wasn't fun to
  # write.
  # Apply filters before word wrap.
  my @msgs;
  foreach my $line (@{ $Game->{Messages} }) {
    foreach my $filter (@{$self->{MsgFilters}}) {
      $line = $filter->($line);
    }
    # Always reset color for completely new lines!
    push @msgs, "<grey>$line";
  }
  # Now factor in word wrap.
  my @lines = wrap($self->{Interface}{MsgConsoleX}, @msgs);
  # Finally we have lines to display. Get the last 6, literally.
  my @sayme;
  if (@lines > 6) {
    @sayme = @lines[-6 .. -1];
  } else {
    @sayme = @lines;
  }
  # Now we talk to the player, gentlemen. Gah, doesn't sound cool.
  $self->{Interface}->msgdraw(@sayme);
  unless ($keep) {
    # Don't repeatedly log messages!
    push @{ $Game->{MsgLog} }, @{ $Game->{Messages} };
    # Are we full?
    if (@{ $Game->{MsgLog} } > 100) {
      my $times = @{ $Game->{MsgLog} } - 100;
      splice @{ $Game->{MsgLog} }, 0, $times;
    }
    $Game->{Messages} = [];
  }
}

sub statrefresh {
  my $self = shift;
  $self->{Interface}->statdraw( $self->{StatLayout}->() );
}

sub prompt {
  my $self = shift;
  return $self->{Interface}->prompt;
}

sub display {
  my $self = shift;
  $self->{Interface}->display(0);
  my $mode = shift;
  my @msgs;
  foreach my $line (@_) {
    foreach my $filter (@{$self->{MsgFilters}}) {
      $line = $filter->($line);
    }
    # Always reset color for completely new lines!
    push @msgs, "<grey>$line";
  }
  # Now factor in word wrap.
  my @lines = wrap($self->{Interface}{MsgConsoleX}, @msgs);
  # Factor in word wrap.
  # Now @lines contains the formatted lines to display. Use a simplified
  # version of the refresh routine to figure out which lines to display.
  my $y = 0;
  my $return = 1;
  my $first = 1;
  while (1) {
    my $y1 = 0;
    my $y2 = scalar @lines;
    if (scalar @lines > $self->{Interface}{ConsoleY}) {
      $y1 = $y;
      $y2 = $y1 + $self->{Interface}{ConsoleY} - 1;
      if ($first) {
        $first = 0;
        $y = $y1 = scalar @lines - $self->{Interface}{ConsoleY};
        $y2 = scalar @lines;
      }
    }
    # Select the lines.
    my @draw = @lines[$y1 .. $y2];
    $self->{Interface}->display(1, @draw);
    # Now, finally do input.
    my $in = $Game->{UI}->prompt;
    if ($mode == 0) {
      $y++ if $in eq "j";
      $y-- if $in eq "k";
      $y++ if $y < 0;
      $y-- if $y > $#lines;
      last if $in eq "x" or $in eq " " or $in eq "\e";
    } else {
      $return = $in;
      last;
    }
  }
  $Player->recenter;
  $Game->{ForceRefresh} = 1;
  $self->{Interface}->display(2);
  return $return;
}

sub selectinv {
  my $self = shift;
  my $obj = shift;
  my $msg = shift;
  my $categories = shift || [];
  my $literal = shift || [];
  my %literal = map { $_ => 1 } @$literal;
  # Not a bad idea... use statusbar to display choices!
  my @cats = @$categories;
  @cats = keys %{ $Game->{Config}{Category} } unless @cats;
  foreach my $cat (@cats) {
    if ($Player->h("Inv.Category.$cat")) {
      push @{ $Game->{ActiveInv} }, "<Blue>$cat";
      foreach (sort keys %{ $Player->g("Inv.Category.$cat") }) {
        push @{ $Game->{ActiveInv} }, "$_ - " . $Player->{Inv}->get($_)->shortinvname;
        $Game->{ActiveInv}[-1] =~ s/\(worn\)$//;
        $Game->{ActiveInv}[-1] =~ s/\(wielded\)$//;
      }
    }
  }
  $self->statrefresh;
  my $return;
  while (1) {
    rsay $msg;
    my $in = $self->prompt;
    if ($in eq "\e" or $in eq " ") {
      say "Never mind.";
      $return = -1;
      last;
    } else {
      if ($in eq "?") {
        if (scalar @$categories) {
          # Do we have anything in the categories?
          my $any = 0;
          foreach (@$categories) {
            my $cat = $obj->g("Inv.Category.$_") || {};
            $any++, last if keys %$cat;
          }
          unless ($any) {
            say "You don't have anything like that!";
            $return = -1;
            last;
          }
          $in = $Player->inv(1, @{ $categories });
        } else {
          $in = $Player->inv(1);
        }
      }
      if ($in eq " " or $in eq "\e") {
        say "Never mind.";
        $return = -1;
        last;
      }
      if ($literal{$in}) {
        $return = $in;
        last;
      }
      my $returni = $obj->{Inv}->get($in);
      unless ($returni) {
        rsay "You don't have that.";
        next;
      }
      $return = $returni;
      last;
    }
  }
  $Game->{ActiveInv} = [];
  $self->statrefresh;
  return $return;
}

sub selectchoice {
  my $self = shift;
  my $choices = shift;
  my $msg = shift;
  while (1) {
    rsay $msg;
    my $in = $self->prompt;
    if ($in eq "\e" or $in eq " ") {
      say "Never mind.";
      return -1;
    } else {
      if (defined $choices->{$in}) {
        return $choices->{$in};
      } else {
        rsay "Huh?";
        next;
      }
    }
  }
}

sub selecttech {
  my $self = shift;
  push @{ $Game->{ActiveInv} }, "<Blue>Techniques";
  foreach my $letter (sort keys %{ $Player->g("Techniques") }) {
    my $tech = $Player->g("Techniques.$letter");
    push @{ $Game->{ActiveInv} }, "$letter - $tech->{Name} (" . $Player->g("Attacks.$tech->{Name}.TP") . ")";
  }
  $self->statrefresh;
  my $return;
  while (1) {
    rsay "Perform which technique?";
    my $in = $self->prompt;
    if ($in eq "\e" or $in eq " ") {
      say "Never mind.";
      $return = -1;
      last;
    } else {
      if ($in eq "?") {
        my @lines = ("<yellow>Techniques", "");
        my $letter = "a";
        foreach (sort keys %{ $Player->g("Techniques") }) {
          # $letter - Name (Cost: $cost) [Success: $success]
          # Desc
          #
          # Easy.
          my $letter = $_;
          $_ = $Player->g("Techniques.$letter");
          my $line = "$letter - $_->{Name} (Cost: ";
          $line .= $Player->g("Attacks.$_->{Name}.TP");
          $line .= ") [Success: ";
          $line .= "Bad" if $_->{Success} == 1;
          $line .= "Good" if $_->{Success} == 2;
          $line .= "Perfect" if $_->{Success} == 3;
          $line .= "]";
          push @lines, $line, $Player->g("Techniques.$letter.Desc"), "";
        }
        $in = $self->display(1, @lines);
      }
      if ($in eq " " or $in eq "\e") {
        say "Never mind.";
        $return = -1;
        last;
      }
      # Do we have technique $in?
      unless ($Player->g("Techniques.$in")) {
        rsay "You don't possess that technique.";
        next;
      }
      $return = $in;
      last;
    }
  }
  $Game->{ActiveInv} = [];
  $self->statrefresh;
  return $return;
}

sub msgbox {
  my $self = shift;
  my $mode = shift;
  if ($mode != 1 and $mode != 5) {
    $Player->recenter if $mode == 2;
    $self->{Interface}->msgbox($mode);
    return 1;
  }
  # It'll be the same for the Console
  $Text::Wrap::columns = $self->{Interface}{MsgConsoleX} - 8;
  # Blasted vim editing style.
  my @lines;
  foreach (@_) {
    my $line = $_;
    $line =~ s/\n/ /g;
    $line =~ s/\s+/ /g;
    # Always reset color for new stuff.
    push @lines, "<black>$line";
  }
  my @msgs = wrap($self->{Interface}{MsgConsoleX} - 8, @lines);
  # Display. Whew.
  return $self->{Interface}->msgbox($mode, @msgs);
}

sub target {
  my $self = shift;
  my @monsters = map { $Game->{IDs}[$_] } keys %{ $Game->{Active} };
  say "Use hjklyunm to move, ? to examine a baddie, + to advance to the next monster, and space or escape to quit.";
  $self->msgrefresh;
  # We interact directly with the Interface for simplicity. Sorry.
  # Start the cursor at the Player.
  my $map = $Player->g("Area.Map");
  my ($mapY, $mapX) = ($Player->g("Y"), $Player->g("X"));
  my $screeny = (2 + $mapY - $Game->{Top});
  my $screenx = (3 + $mapX - $Game->{Left});
  $self->{Interface}->cursor(
    $screeny,
    $screenx,
    $self->{Interface}->trans_color("Blue", "white"),
    $map->[$mapY][$mapX]{_SYMBOL_},
  );
  while (1) {
    my $key = $Game->{UI}->prompt;
    if ($key eq "?") {
      # NOW we can examine something! But is there a character there?
      if ($map->[$mapY][$mapX]{Char}) {
        $Player->examinemons($map->[$mapY][$mapX]{Char});
        # Redraw current cursor.
        $screeny = (2 + $mapY - $Game->{Top});
        $screenx = (3 + $mapX - $Game->{Left});
        $self->{Interface}->cursor(
          $screeny,
          $screenx,
          $self->{Interface}->trans_color("Blue", "white"),
          $map->[$mapY][$mapX]{_SYMBOL_},
        );
        next;
      } else {
        say "There isn't an actor here!";
      }
    }
    # Erase old character.
    $self->{Interface}->cursor(
      $screeny,
      $screenx,
      $map->[$mapY][$mapX]{_COLOR_},
      $map->[$mapY][$mapX]{_SYMBOL_},
    );
    if ($key eq " " or $key eq "\e" or $key eq "x" or $key eq "") {
      # Bye!
      last;
    }
    if ($key eq "+") {
      unless (@monsters) {
        say "Er, sorry. No monsters around here.";
      } else {
        ($mapY, $mapX) = ($monsters[-1]->{Y}, $monsters[-1]->{X});
        push @monsters, shift @monsters;
      }
    }
    # OK, so we move.
    ($mapY, $mapX) = keycoords($key, $mapY, $mapX);
    # Out of boundaries?
    if ($mapY > $Game->{Bottom}) {
      $mapY--;
    } elsif ($mapY < $Game->{Top}) {
      $mapY++;
    }
    if ($mapX > $Game->{Right}) {
      $mapX--;
    } elsif ($mapX < $Game->{Left}) {
      $mapX++;
    }
    # Right, so calculate the new screen offset and display the cursor.
    $screeny = (2 + $mapY - $Game->{Top});
    $screenx = (3 + $mapX - $Game->{Left});
    $self->{Interface}->cursor(
      $screeny,
      $screenx,
      $self->{Interface}->trans_color("Blue", "white"),
      $map->[$mapY][$mapX]{_SYMBOL_},
    );
    # Finally, display what we've got on the current tile in the messagebar.
    say $map->[$mapY][$mapX]{Char} ? $map->[$mapY][$mapX]{Char}->invname : "";
    $self->msgrefresh;
  }
  return ($mapY, $mapX);
}

42;
