package MTerminal::ANSI;
use strict;
use integer;

use MCoreTools;

use constant PROMPT_DELAY => 0.10; # this ought to be configurable, maybe per-state?

# fg: 3x bg: 4x
# black: 0
# red:   1
# green: 2
# yellow:3
# blue:  4
# purple:5
# cyan:  6
# white: 7

#            en dis able
# bright:     1  22
# dark:       2  22
# italic*:    3  23
# underline:  4  24
# flash:      5  25
# fast flash*:6  26
# inverse:    7  27

# FIXME: this style info should be defined in Elements deflist

my %style = (
  out => {},
  
  report => {display => 'block',},
  log    => {display => 'block', attr => '34', before => '[', after => ']'},
  error  => {display => 'block', attr => '31;1'},
  action => {display => 'block',},

  group => {},
  division => {display => 'block', attr => '34', hr => 1},
  detail => {detail => 1},
  title => {
    attr => '36',
    after => ":",
    display => 'block',
  },
  line => {display => 'block',},
  
  ipre => {},
  obj  => {attr => '32'},
  key  => {attr => '4'},
  meta => {attr => '36'},
  quo  => {attr => '33'},
  weak => {attr => '34'},
  user => {attr => '33'},
  help => {},
  ucfirst => {ucfirst => 1},
  undef => {before => 'undef'},

  'html:ul'     => {display => 'block', list_container => 1},
  'html:blockquote' => {display => 'block'},
  'html:li'     => {display => 'list-item', list_style_type => 'disc'},
  'html:p'      => {display => 'block', before => '  '},
  'html:pre'    => {display => 'block'},
  'html:em'     => {display => 'inline', attr => '1'},
  'html:strong' => {display => 'inline', attr => '1;44;37'},
  'html:code'   => {display => 'inline', attr => '37'},
  'html:table'  => {display => 'table'    },
  'html:tr'     => {display => 'table-row'},
  'html:td'     => {display => 'table-cell'},
  'html:th'     => {display => 'table-cell', attr => 1},
);

my %listmarks = (
  disc => '  * ',
  indent => '  ',
  none => '',
);

my $ANSIMATCH = "(?:\c[\\[[0-9;]*?m)";


sub new {
  my ($class, $con) = @_;
  my $self = bless {
    lastprompt => '',
  }, $class;
  return $self;
}

sub init {
  my ($self, $con) = @_;
  $self->needs_prompt($con);
}


#sub display_character_width { $con->pref('scr_width') || 80 }


sub output {
  my ($self, $con, $sx) = @_;
  
  my $result = _sx2ansi($con, $sx, {
    userstyle => $con->pref('ansi_style'),
    max_width => $con->pref('scr_width') || 80,
  }, "\c[[0m");

  1 while $result =~ s/[\r\n ]+($ANSIMATCH*)\Z/$1/;
  return unless length $result;
  $result .= "\n";
  
  $result =~ s/$ANSIMATCH//g if $con->pref('ansi_off');

  $con->send_str(
    (!$self->{prompt_event} && length $self->{lastprompt} ? "\n" : '')
    . $result
    . "\c[[0m"
  );
  $con->needs_flush;
  $self->needs_prompt($con);
}

sub input {
  my ($self, $con, $input) = @_;
  
  for ($input) {
    1 while s/[^\cH]\cH//; # handle backspace
    s/\cH//g;

    s/^.*\c[//mg; # ESC kills preceding part of line

    #s/([\x00-\x1F])/$1 eq "\n" ? "\n" : '^' . chr(ord($1) + ord('@'))/ge; # eliminate control chars
    s/([\x80-\xFF])/sprintf "[%2x]", ord($1)/ge; # eliminate high-bit chars
    tr/\n\x20-\x7F//cd; # throw out any nonprintables left

    s/^\s+//; # remove leading and trailing spaces/line-ends
    s/\s+$//;
    
  }
  
  $self->needs_prompt($con);
  return $input;
}

sub input_post {
  my ($self, $con) = @_;
}  

sub needs_prompt {
  my ($self, $con) = @_;

  # $self->{next_prompt} = $con->get_prompt;
  my $time = PROMPT_DELAY; # ($self->{next_prompt} eq $self->{lastprompt} ? PROMPT_DELAY : 0);

  
  if ((!$self->{prompt_event} or $time < $self->{prompt_event_time}) and MScheduler->running) {
    #$con->send_str_raw(">debug: scheduling prompt time=$time<\n");

    $self->{prompt_event_time} = $time;
    if ($self->{prompt_event}) {
      MScheduler->remove_event($self->{prompt_event});
    } 
    ($self->{prompt_event} = MEvent::Message->new(
      name => "Prompt",
      owner => $self,
      target => $self,
      method => 'send_prompt',
      arguments => [$con],
      no_store => 1,
      is_real_time => 1,
      time => $time,
    ))->schedule;
    
  }
}

sub dispose {
  my ($self) = @_;
  MScheduler->remove_owned($self);
}

###

sub send_prompt {
  my ($self, $con) = @_;

  #my $p = $self->{lastprompt} = $self->{next_prompt};
  my $p = $self->{lastprompt} = $con->get_prompt;
  if (length $p) {
    $con->send_str_raw($con->pref('ansi_off') ? $p : "\c[[0;35m$p\c[[0m");
    $con->send_incomplete;
  }
  $self->{prompt_event} = undef;
  $self->{prompt_event_time} = undef;
  #$self->{next_prompt} = undef;
}

use constant WRAP_DEBUG => 0;

sub _sx2ansi {
  my ($con, $thing, $data, $prevf, @parents) = @_;

  ref $thing and ref $thing eq 'ARRAY' or return $thing;
  $#$thing >= SX_ATTR or die "sx: array too short";
  
  my $elem = $thing->[SX_ELEM];
  my $attr = $thing->[SX_ATTR];
  my @cont = @{$thing}[SX_CONT..$#$thing];

  # whitespace compression, like normal XML
  for (@cont) {
    $_ = 'undef' if not defined $_;
    next if ref;
    if (grep(($_->[SX_ATTR]{'xml:space'} || 'default') eq 'preserve', @parents, $thing)) {
      s/\cM\cJ?|\cJ/\n/;
    } else {
      s/\s+/ /g unless ref
    }
  }
  
  $data = {%$data}; # copy it so changes aren't propagated up the stack
  
  my $class = $attr->{'html:class'} || ''; # FIXME: what's the official CSS definition of class?
  
  exists $style{$elem} or mudlog "ANSI: Undeclared SX element '$elem'";
  
  # this is the 'stylesheet' data for this element
  my $style = $data->{userstyle}{$elem} || $style{$elem} || {};
  
  # find the ANSI color code for this element
  my $thisf = $style->{attr} ? "\c[[0;$style->{attr}m" : '';
  
  my $display = $style->{display} || 'inline';
  my $block_mode = $display =~ /^(block|table|table-row|list-item)$/;
  
  my $recurse = sub {join +($_[0]||''), map _sx2ansi($con, $_, $data, $thisf || $prevf, @parents, $thing), @cont};
  my $res;

  if ($style->{'detail'} and $con->pref('brief')) {
    $res = '';
    
  } elsif ($display eq 'table') {
    # FIXME: for now, we assume that the next two nesting levels are rows and cells,
    # but according to the CSS table model, rows and cells can be _implicit_
    # anonymous boxes if they do not explicitly exist. 
    my @maxwid;
    for my $erow (@{$thing}[SX_CONT..$#$thing]) {
      my $colnum = 0;
      for my $ecell (@{$erow}[SX_CONT..$#$erow]) {
	my $len = _display_length(_sx2ansi($con, $ecell, {%$data, sizetest => 1}, $thisf || $prevf, @parents, $thing, $erow));
	$maxwid[$colnum] = $len if ($maxwid[$colnum] || 0) <= $len;
        $colnum++;
      }
    }
    $res = '';
    #$res .= join(" ", @maxwid) . "\nrows:" . $#$thing . "\n";
    for (my $ixrow = 0; $ixrow <= ($#$thing - SX_CONT); $ixrow++) {
      my $erow = $thing->[SX_CONT+$ixrow];
      
      my @celltexts;
      for (my $ixcol = 0; $ixcol <= ($#$erow - SX_CONT); $ixcol++) {
        my $ecell = $erow->[SX_CONT+$ixcol];
        my $t = _sx2ansi($con, $ecell, {%$data, max_width => $maxwid[$ixcol]}, $thisf || $prevf, @parents, $thing, $erow);
        $t =~ s/(\n$ANSIMATCH*)+$//;
        $celltexts[$ixcol] = [split /\n/, $t];
      }
     
      while (grep scalar @$_, @celltexts) {
        for (my $ixcol = 0; $ixcol <= ($#$erow - SX_CONT); $ixcol++) {
          my $ecell = $erow->[SX_CONT+$ixcol];
          my $celltext = shift @{$celltexts[$ixcol]} || '';
          $res .= $celltext;
          $res .= ' ' x (1 + $maxwid[$ixcol] - _display_length($celltext));
        }
        $res .= "\n";
      }
    } 
  } elsif ($style->{list_container} and $class !~ /\blinear\b/) { # FIXME: remove special classes
    if ($class =~ /\bcompact\b/) {
      $res = $recurse->(', ');
      $res =~ s/\n//g;
    } else {
      $res = _format_multicol($data->{max_width}, $recurse->());
    }
    
  } else {
    $res = $recurse->();
  }
  $res =~ s/^((?:$ANSIMATCH|\W)*)(\w)/$1.uc($2)/e if $style->{ucfirst};
  
  my $mark;
  if ($display eq 'list-item') {
    my $listclass = $parents[-1][SX_ATTR]{'html:class'} || '';
    my $type = $style->{list_style_type} || 'disc';
    $type = 'none' if $listclass =~ /\b(layout|compact)\b/;
    $type = 'indent' if $listclass =~ /\bstructure\b/;
    $mark = $listmarks{$type} || '';
    my $indent = ' ' x length $mark;
    $res =~ s/\n/\n$indent/g;
  } else {
    $mark = '';
  }
  
  # add before/after items
  my $wrap_input = $mark
    . ($style->{before} || '')
    . ($style->{hr} && !$data->{sizetest} ? '-' x $data->{max_width} : '')
    . $res
    . ($style->{after} || '');
    
  my $wrapped;
  if ($block_mode) {
    $wrapped = '';
    my $line_remaining = $data->{max_width};
    my $do_break = sub {
      print "do_break\n" if WRAP_DEBUG;
      $wrapped .= "\n";
      $line_remaining = $data->{max_width};
    };
    while (length $wrap_input) {
      $wrap_input =~ s/^([^\n]*)//;
      my $plain_chunk = $1;
      print "extracted plain chunk: >>$plain_chunk<<\n" if WRAP_DEBUG;
      if (not length $plain_chunk) {
        print "plain chunk was empty, handling special\n" if WRAP_DEBUG;
        if ($wrap_input =~ s/^\n//) {
          print "hard return\n" if WRAP_DEBUG;
          $do_break->();
        } else {
          croak "shouldn't happen";
        }
      } else {
        print "processing plain chunk\n" if WRAP_DEBUG;
        while (length $plain_chunk) {
          $plain_chunk =~ s/^(\s*)(\S+)// or last;
          my ($whitespace, $word) = ($1, $2);
          my $wordlen = _display_length($word);
          #$wrapped .= "[$line_remaining]";
          if ($wordlen + length $whitespace > $line_remaining) {
            $do_break->();
          } else {
            $wrapped .= $whitespace;
            $line_remaining -= length $whitespace;
          }
          $wrapped .= $word;
          $line_remaining -= $wordlen;
        }
      }
    }
  } else {
    $wrapped = $wrap_input;
  }
  
  return
      $thisf
    . $wrapped
    . $prevf
    . ($block_mode
       && $res !~ /\n$ANSIMATCH*$/
       ? "\n" : ''
      )
    ;
}

=for disabled

this is a flawed wrapping algorithm; it doesn't realize that a style break
does not mean that the stuff before it is necessarily locked onto the line it's on

    $wrapped = '';
    my $line_remaining = $data->{max_width};
    my $do_break = sub {
      print "do_break\n" if WRAP_DEBUG;
      $wrapped .= "\n";
      $line_remaining = $data->{max_width};
    };
    while (length $wrap_input) {
      $wrap_input =~ s/^([^\c[\n]*)//;
      my $plain_chunk = $1;
      print "extracted plain chunk: >>$plain_chunk<<\n" if WRAP_DEBUG;
      if (not length $plain_chunk) {
        print "plain chunk was empty, handling special\n" if WRAP_DEBUG;
        if ($wrap_input =~ s/^\n//) {
          print "hard return\n" if WRAP_DEBUG;
          $do_break->();
        } elsif ($wrap_input =~ s/^($ANSIMATCH)//) {
          print "ansi code\n" if WRAP_DEBUG;
          $wrapped .= $1;
        } else {
          croak "shouldn't happen";
        }
      } else {
        print "processing plain chunk\n" if WRAP_DEBUG;
        # $plain_chunk now contains a length of plain text
        while (length $plain_chunk > $line_remaining) {
          my $chars_can_fit = my $chars_to_fit = length($plain_chunk) < $line_remaining ? length($plain_chunk) : $line_remaining;
          print "base chars_can_fit = $chars_can_fit\n" if WRAP_DEBUG;
          $chars_to_fit-- while substr($plain_chunk, $chars_to_fit - 1, 1) !~ /\s/
                                and $chars_to_fit > 0;
          $chars_to_fit = $chars_can_fit if $chars_to_fit == 0;
          print "chosen chars_can_fit = $chars_can_fit\n" if WRAP_DEBUG;
          $wrapped .= substr($plain_chunk, 0, $chars_to_fit);
          substr($plain_chunk, 0, $chars_to_fit) = '';
          $do_break->();
        }
        $wrapped .= $plain_chunk;
        $line_remaining -= length $plain_chunk;
      }
    }

=cut

sub _proctext { # not yet used, and currently not quite finished
                # this is supposed to be a line-wrapper that supports left/right floats
  my ($out, $newtext, $lfloat, $rfloat, $maxwid) = @_;
  my $lflen = @$lfloat ? length $$lfloat[0] : 0;
  my $rflen = @$rfloat ? length $$rfloat[0] : 0;
  while (my $len = min(index($$newtext, "\c["), index($$newtext, "\n")) + 1) {
    my $remain = length $$out - rindex($$out, "\n") + 1;
    my $lfi = @$lfloat ? shift(@$lfloat) . ' ' : '';
    my $rfi = @$rfloat ? ' ' . shift(@$rfloat) : '';
    my $pwid = max($len, $maxwid - length $lfi - length $rfi) - $remain;
    my $piece = substr($$newtext, 0, $pwid);
    substr($$newtext, 0, $pwid) = '';
    $$out .= $lfi . $piece . $rfi . "\n";
  }
}

sub _format_multicol {
  my $swid = shift;
  my @items = map {split /\n/} grep defined, @_;
  
  my $maxlen = 0;
  foreach (@items) {                                   # compute needed width of columns
    my $na = _display_length($_);
    $maxlen = $na if $na > $maxlen;
  }

  my ($cols, $lines);
  {
    no integer;
    $maxlen++;                                         # provide one space of separation between columns
    $cols = int($swid / $maxlen) || 1;                 # compute number of columns to use
    $lines = @items / $cols;                           # number of lines needed
    $lines = int($lines) + 1 if $lines != int($lines); # round line count up to integer
    $lines = @items if $lines <= 5 and @items <= 5;    # make sure we don't get columns with less than 6 items
  }                                                    # (for appearance's sake)

  my $buf = '';
  for (my $v = 0; $v < $lines; $v++) {
    for (my $h = 0; $h < $cols; $h++) {
      my $str = ($items[$v + $h * $lines] || '');
      my $padding = $maxlen - _display_length($str);
      $buf .= $str . ($h == $cols - 1 ? '' : ' ' x $padding);
    }
    $buf .= "\n";
  }
  return $buf;
}

sub _display_length {
  my $str = $_[0];
  $str =~ s/$ANSIMATCH//g;
  return length $str;
}

1;

__END__

# For reference purposes, here's the old &:formatcode; table

%EscapeTable = (
  n => "\x1B[0m", # normal

  sb => "\x1B[1m", # bold
  si => "\x1B[3m", # italic?
  su => "\x1B[4m", # underline
  sf => "\x1B[5m", # flash
  sv => "\x1B[7m", # inverse

  # fg colors
  fk => "\x1B[30m", k => "\x1B[30m",
  fr => "\x1B[31m", r => "\x1B[31m",
  fg => "\x1B[32m", g => "\x1B[32m",
  fy => "\x1B[33m",'y'=> "\x1B[33m",
  fb => "\x1B[34m", b => "\x1B[34m",
  fm => "\x1B[35m",'m'=> "\x1B[35m",
  fc => "\x1B[36m", c => "\x1B[36m",
  fw => "\x1B[37m", w => "\x1B[37m",

  # bg colors
  bk => "\x1B[40m",
  br => "\x1B[41m",
  bg => "\x1B[42m",
  by => "\x1B[43m",
  bb => "\x1B[44m",
  bm => "\x1B[45m",
  bc => "\x1B[46m",
  bw => "\x1B[47m",
  
  # symbolic colors
  title => "\x1B[36m", # titles of output, cyan
  'log' => "\x1B[32m", # log messages, green
  meta => "\x1B[32m", # help metasyntax, green
  oname => "\x1B[35m", # object names, purple
  key => "\x1B[1m", # keyword, bold
     # more to be added.
);
