# sit on unmatched partial esc[30m etc




# Copyright 2007, 2008, 2009, 2010 Kevin Ryde

# This file is part of Chart.
#
# Chart is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3, or (at your option) any later version.
#
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Chart.  If not, see <http://www.gnu.org/licenses/>.


package App::Chart::Pango::Ex::ANSItoMarkup;
use 5.008;
use strict;
use warnings;

my %shorthand = ('<span weight=bold'        => 'b',
                 '<span style=italic'       => 'i',
                 '<span strikethrough=true' => 's',
                 '<span underline=single'   => 'u');

my @colour = ('black',
              'red',
              'green',
              'yellow',
              'blue',
              'magenta',
              'cyan',
              'white');

use constant { _A_FOREGROUND    => 0,
               _A_BACKGROUND    => 1,
               _A_STRIKETHROUGH => 2,
               _A_STYLE         => 3,
               _A_UNDERLINE     => 4,
               _A_WEIGHT        => 5,
               _A_RISE          => 6,
             };

sub new {
  my ($class) = @_;
  return bless { attr => [],
               }, $class;
}

sub convert {
  my ($class_or_self, $str) = @_;
  my $self = (ref $class_or_self ? $class_or_self : $class_or_self->new);

  my $attr = $self->{'attr'};
  if (defined (my $prev = delete $self->{'previous'})) {
    $str = $prev . $str;
  }

  defined (my $pos = index ($str, "\e"))
    or return $str;

  pos($str) = $pos;
  my $ret = substr ($str, 0, $pos);

  while ($str =~ /\G
                  (                 # $1 whole esc+text
                    (?:\e(          # $2 after esc
                      \[([0-9;]*)   # $3 SGR numbers
                      m
                    |
                      [KL])?)?
                  ([^\e]*))          # $4 plain text after
                 /gx) {
    my $part = $4;
    if (defined $3) {
      foreach my $num (split /;/, $3) {
        if ($num == 0) {
          @$attr = ();

        } elsif ($num == 1) {
          # bold
          $attr->[_A_WEIGHT] = 'weight=bold';

        } elsif ($num == 2) {
          # faint, or dark, or something
          $attr->[_A_WEIGHT] = 'weight=light';

        } elsif ($num == 3) {
          # italic
          $attr->[_A_STYLE] = 'style=italic';

        } elsif ($num == 4) {
          # single underline
          $attr->[_A_UNDERLINE] = 'underline=single';

          # 5 slow blink
          # 6 fast blink
          #    nothing for these in pango

          # 7 "negative image", reverse video
          #    would kinda need to know what the normal colours are

          # 8 concealed
          #    does this mean invisible?

        } elsif ($num == 9) {
          $attr->[_A_STRIKETHROUGH] = 'strikethrough=true';

          # 10 primary font
          # 11 first alternative font
          # ...
          # 19 ninth alternative font
          # 20 fraktur gothic

        } elsif ($num == 21) {
          # double underline
          $attr->[_A_UNDERLINE] = 'underline=double';

        } elsif ($num == 22) {
          # normal colour/intensity, ie. neither bold nor faint
          $attr->[_A_WEIGHT] = undef;

        } elsif ($num == 23) {
          # not italic
          $attr->[_A_STYLE] = undef;

        } elsif ($num == 24) {
          # not underlined
          $attr->[_A_UNDERLINE] = undef;

          # 25 not blinking
          #     nothing for blinking in pango
          # 26 reserved (for proportional spacing)
          # 27 positive image, ie. not reverse video
          # 28 revealled chars, ie. not concealed

        } elsif ($num == 29) {
          # not strikethrough
          $attr->[_A_STRIKETHROUGH] = undef;

        } elsif ($num >= 30 && $num <= 37) {
          $attr->[_A_FOREGROUND] = 'foreground=' . $colour[$num-30];

          # 38 reserved (for foreground colour)

        } elsif ($num == 39) {
          # default foreground colour
          $attr->[_A_FOREGROUND] = undef;

        } elsif ($num >= 40 && $num <= 47) {
          $attr->[_A_BACKGROUND] = 'background=' . $colour[$num-40];

          # 48 reserved (for background colour)

        } elsif ($num == 49) {
          # default background colour
          $attr->[_A_BACKGROUND] = undef;

          # 50 reserved (for cancelling 26 proportional spacing)
          # 51 framed
          # 52 encircled
          # 53 overlined
          #     no overline in pango markup
          # 54 not framed or encircled
          # 55 not overlined
          # 56-59 reserved
          # 60 ideogram underline right side line
          # 61 ideogram double underline right side line
          # 62 ideogram overline left side line
          # 63 ideogram double overline left side
          # 64 ideogram stress
          # 65 ideogram normal, ie. undo 60-64
        }
      }
    } elsif (defined $2) {
      # sub/sup rise 5000, meaning 0.5 em, same as pango-markup.c does for
      # <sub>, <sup> shorthands
      if ($2 eq 'K') {
        # PLD partial line down subscript or cancel superscript
        $self->{'rise'} -= 5000;

      } elsif ($2 eq 'L') {
        # PLU partial line up superscript or cancel subscript
        $self->{'rise'} += 5000;
      }
      $attr->[_A_RISE] = (($self->{'rise'}||0) == 0 ? undef
                          : "rise=".$self->{'rise'});

    } else {
      $part = $1;
    }

    my $span = join (' ', '<span', grep {defined} @$attr);
    if ($span eq '<span') {
      # no markup at all
      $ret .= $part;
    } elsif (my $short = $shorthand{$span}) {
      $ret .= "<$short>$part</$short>";
    } else {
      $ret .= "$span>$part</span>";
    }
  }
  return $ret;
}

# print __PACKAGE__->convert("\eKsub\eLn\eZorm\e[1mxyz\e[0mabc\e[30mxyz\e[0m");

1;
__END__