package Hexed::Util;

use strict;
use warnings;
use include;

use Exporter;
our @ISA = ("Exporter");
our @EXPORT = (qw( &strip &wrap &center &paint ));

use Curses;

use Memoize;

# Strip the formatting tags out of a string.
sub strip {
  my $orig = shift;
  $orig =~ s/<[^>]+>//g;
  return $orig;
}

# Turns a string into a list of strings by word wrapping to the specified
# number of fixed-width columns. Any embedded formatting tags (denoted by
# <string>) are preserved, but do not count towards a line's width.
sub wrap {
  my ($width, $in) = @_;
  $width = length($in) if $width == -1;
  my @msgs;
  my ($real, $line) = ("", "");

  # Leading whitespace SHOULD be preserved!!!
  my $lead;
  if ($in =~ s/^(\s+)//) {
    $real = $line = $1;
    $lead = length($line);
  } else {
    $lead = 0;
  }

  # Formatting and wrapping... mmm, text bondage.
  $in =~ s/\n/ /g;    # Collapse editor-inserted newlines
  $in =~ s/\s+/ /g;   # Crunch extra whitespace

  # My homegrown word wrap disregards <formatting> tags!
  foreach my $realword (split(/\s/, $in)) {
    # Strip the word first.
    my $word = strip $realword;
    if (length($line) + length($word) + 1 <= $width) {
      # We have enough room on this line.
      unless (length($line) == 0 or $lead) {
        # If we're at the start of the line (including leading whitespace),
        # don't add another space.
        $word = " $word";
        $realword = " $realword";
      }
      $line .= $word;
      $real .= $realword;
    } elsif (length($line) == $lead) {
      # If we're at the beginning of a line (including leading whitespace) and
      # the next word is just too big for one line, put as much of it as we can
      # on this line and the rest on the next.

      # TODO: WARNING. If we encounter a huge line like this and there are
      # formatting tags, just give up.

      # First get as much of $word as we can handle for this line.

      # TODO: On second thought...
      die "Word wrap exploded. Too big. Ugh.\n";
    } else {
      # We've hit the edge and have to wrap.
      push @msgs, $real;
      # Start a new line with this current word.
      $line = $word;
      $real = $realword;
    }
    $lead = 0;
  }
  push @msgs, $real;  # Leftovers?

  return @msgs;
}

# Tells where a string of the specified length should start on a line segment
# of the specified length so that the string is centered. May be one space off
# due to the fixed-width nature of terminal fonts.
sub center {
  my ($strlen, $total) = @_;
  return int($total / 2) - int($strlen / 2);
}

# Caching color codes is highly useful in big maps. Believe me.
memoize("paint");

# Returns the attribute for the specified color.
sub paint {
  my ($fg, $bg);
  if (@_ == 1) {
    ($fg, $bg) = ($_[0] eq "/") ? ("grey", "black") : (split("/", shift));
  } else {
    ($fg, $bg) = @_;
  }
  # If the foreground and background color are the same, something screws up.
  # So prevent that.
  # Used to be "if (!$fg)"... but that'd be something!
  $bg ||= "black";
  $fg = "black" if $bg =~ m/(grey|grey|white)/i;
  #debug [$fg, $bg];
  return trans_color($fg, $bg);
}

sub trans_color {
  my ($fg, $bg) = @_;
  # The only brightness we worry about now is the '!green' form.
  my $bright = 0;
  my %colors = (
    blue   => 5,
    red    => 2,
    green  => 3,
    aqua   => 7,
    cyan   => 7,
    purple => 6,
    orange => 4,
    yellow => 4,
    black  => 1,
    grey   => 8,
    gray   => 8,
    white  => 8
  );
  my $color = $colors{lc $fg};
  # Now we determine whether we're bright or dim.
  # If our first letter is capitalized, we're bright.
  $bright = 1 if substr($fg, 0, 1) eq uc substr($fg, 0, 1);
  # But then we have all these special cases. Simplify fg.
  $fg = lc $fg;
  $bright = 0 if $fg eq "orange";
  $bright = 1 if $fg eq "yellow";
  $bright = 0 if $fg eq "grey" or $fg eq "gray";
  $bright = 1 if $fg eq "white";
  my $attrib = $bright ? A_BOLD() : A_NORMAL();
  return $attrib | COLOR_PAIR($color);
}

42;