#
# This file is part of Curses-Toolkit
#
# This software is copyright (c) 2011 by Damien "dams" Krotkine.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use warnings;
use strict;

package Curses::Toolkit::Widget::Label;
{
  $Curses::Toolkit::Widget::Label::VERSION = '0.210';
}

# ABSTRACT: a widget to display text

use parent qw(Curses::Toolkit::Widget);

use Params::Validate qw(SCALAR ARRAYREF HASHREF CODEREF GLOB GLOBREF SCALARREF HANDLE BOOLEAN UNDEF validate validate_pos);
use List::Util qw(min max);
use Curses::Toolkit::Object::MarkupString;
use Curses::Toolkit::Object::Coordinates;

our @EXPORT_OK = qw(Label);
our %EXPORT_TAGS = (all => [qw(Label)]);

sub Label { 'Curses::Toolkit::Widget::Label' }


sub new {
    my $class = shift;
    my $self  = $class->SUPER::new();
    $self->{text}          = '';
    $self->{justification} = 'left';
    $self->{wrap_method}   = 'word';
    $self->{wrap_mode}     = 'lazy';
    return $self;
}


sub set_text {
    my $self = shift;

    my ($text) = validate_pos( @_, { type => SCALAR } );
    $self->{text}           = $text;
    $self->{_markup_string} = Curses::Toolkit::Object::MarkupString->new($text);
    $self->needs_redraw();
    return $self;

}


sub get_text {
    my ($self) = @_;
    return $self->{text};
}


sub set_justify {
    my $self = shift;
    my ($justification) = validate_pos( @_, { regex => qr/^(?:left|center|right)$/ } );
    $self->{justification} = $justification;
    return $self;
}


sub get_justify {
    my ($self) = @_;
    return $self->{justification};
}


sub set_wrap_mode {
    my $self = shift;
    my ($wrap_mode) = validate_pos( @_, { regex => qr/^(?:never|active|lazy)$/ } );
    $self->{wrap_mode} = $wrap_mode;
    return $self;
}


sub get_wrap_mode {
    my ($self) = @_;
    return $self->{wrap_mode};
}


sub set_wrap_method {
    my $self = shift;
    my ($wrap_method) = validate_pos( @_, { regex => qr/^(?:word|letter)$/ } );
    $self->{wrap_method} = $wrap_method;
    return $self;
}


sub get_wrap_method {
    my ($self) = @_;
    return $self->{wrap_method};
}

sub draw {
    my ($self) = @_;
    my $theme  = $self->get_theme();
    my $c      = $self->get_coordinates();
    my $text   = $self->{_markup_string}->stripped();

    my $justify = $self->get_justify();

    my $wrap_method = $self->get_wrap_method();

    my @text = _textwrap( $self->{_markup_string}, $c->width() );

    foreach my $y ( 0 .. min( $#text, $c->height() - 1 ) ) {
        my $t = $text[$y];
        $t->search_replace( '^\s+', '' );
        $t->search_replace( '\s+$', '' );
        if ( $justify eq 'left' ) {
            $theme->draw_string( $c->get_x1(), $c->get_y1() + $y, $t );
        }
        if ( $justify eq 'center' ) {
            $theme->draw_string(
                $c->get_x1() + ( $c->width() - $t->stripped_length() ) / 2,
                $c->get_y1() + $y,
                $t
            );
        }
        if ( $justify eq 'right' ) {
            $theme->draw_string(
                $c->get_x1() + $c->width() - $t->stripped_length(),
                $c->get_y1() + $y,
                $t
            );
        }
    }
}


sub _textwrap {
    my $text = shift;
    my $columns = shift || 1;
    my ( @tmp, @rv, $p );

    # Early exit if no text was passed
    return unless ( defined $text && $text->stripped_length() );

    # Split the text into paragraphs, but preserve the terminating newline
    @tmp = $text->split_string("\n");
    foreach my $t (@tmp) {
        $t->append("\n");
    }

    $tmp[-1]->chomp_string() unless $text->stripped() =~ /\n$/;

    # Split each paragraph into lines, according to whitespace
    for my $p (@tmp) {

        # Snag lines that meet column limits (not counting newlines
        # as a character)
        if ($p->stripped_length() <= $columns
            || (   $p->stripped_length() - 1 <= $columns
                && $p->stripped() =~ /\n$/s )
            )
        {
            push( @rv, $p );
            next;
        }

        # Split the line
        while ( $p->stripped_length() > $columns ) {
            if ( $p->substring( 0, $columns )->stripped() =~ /^(.+\s)(\S+)$/ ) {
                my ( $v1, $v2 ) = ( $1, $2 );
                push( @rv, $p->substring( 0, length($v1) ) );
                my $l  = $p->stripped_length();
                my $m1 = $p->substring( length($v1), length($v2) );
                my $m2 = $p->substring( $columns, $l - $columns );
                $m1->append($m2);
                $p = $m1;
            } else {
                push( @rv, $p->substring( 0, $columns ) );
                $p = $p->substring( $columns, $p->stripped_length() - $columns );
            }
        }

        push( @rv, $p );
    }

    if ( $text->stripped() =~ /\S\n(\n+)/ ) {
        my $l = length($1);
        foreach ( 1 .. $l ) { push( @rv, Curses::Toolkit::Object::MarkupString->new("\n") ) }
    }

    return @rv;
}



sub get_desired_space {
    my ( $self, $available_space ) = @_;

    defined $available_space
      or return $self->get_minimum_space();

    return $self->_get_space($available_space, $self->get_wrap_mode);
}


sub get_minimum_space {
    my ( $self, $available_space ) = @_;
#     defined $available_space
#       or return Curses::Toolkit::Object::Coordinates->new(
#           x1 => 0, y1 => 0,
#           x2 => 4, y2 => 2,
# );
    defined $available_space
      or return $self->_get_space(Curses::Toolkit::Object::Coordinates->new_zero(), 'lazy', 5000);
    return $self->_get_space($available_space, $self->get_wrap_mode);
}

sub _get_space {
    my ( $self, $available_space, $wrap_mode, $max_length ) = @_;
    $max_length ||= 0;

    $wrap_mode      ||= $self->get_wrap_mode();

    my $minimum_space = $available_space->clone();
    my $text          = $self->{_markup_string}->stripped();
    if ( $wrap_mode eq 'never' ) {
        $text =~ s/\n(\s)/$1/g;
        $text =~ s/\n/ /g;
        $minimum_space->set(
            x2 => $available_space->get_x1() + length $text,
            y2 => $available_space->get_y1() + 1,
        );
        return $minimum_space;
    } elsif ( $wrap_mode eq 'active' ) {
        my $width = 1;
        while (1) {
            my @text = _textwrap( $self->{_markup_string}, $width );
            if ( $width >= $self->{_markup_string}->stripped_length() ) {
                $minimum_space->set(
                    x2 => $minimum_space->get_x1() + $self->{_markup_string}->stripped_length() + 1,
                    y2 => $minimum_space->get_y1() + 1
                );
                last;
            }
            if ( @text < 1 || @text > $available_space->height() ) {
                $width++;
                next;
            }
            $minimum_space->set(
                x2 => $minimum_space->get_x1() + max( map { $_->stripped_length() } @text ) + 1,
                y2 => $minimum_space->get_y1() + scalar(@text)
            );
            last;
        }
        return $minimum_space;
    } elsif ( $wrap_mode eq 'lazy' ) {
        my @text = _textwrap( $self->{_markup_string}, max( $available_space->width(), 1, $max_length ) );
        $minimum_space->set( x2 => $minimum_space->get_x1() + max( map { $_->stripped_length() } @text ) + 1,
                             y2 => $minimum_space->get_y1() + scalar(@text)
                           );
        return $minimum_space;
    }
    die;

}


1;

__END__

=pod

=head1 NAME

Curses::Toolkit::Widget::Label - a widget to display text

=head1 VERSION

version 0.210

=head1 DESCRIPTION

This widget consists of a text label. This widget is more powerful than it
looks : it supports line wrapping, and color, bold, underline, etc.

=head1 MARKUPS SUPPORT

To be able to have more than simple text, the Label widget supports markup tags
in its text, for example :

  'foo <u>underlined bar</u> <span fgcolor="blue"> blue text <span
   bgcolor="red"> blue on red </span> normal on red </span> <b>bold</b>.'

=over

=item <u>

  <u>underlined string</u>

The <u> tag makes the enclosing text underlined

=item <b>

  <b>bold string</b>

The <b> tag makes the enclosing text bold

=item <span>

The <span> tag allows more attributes to be set. Attributes can of course be combined :

  <span wight="blink" fgcolor="black" bgcolor="red">Warning text!</span>

There is the list of attributes :

=over

=item weight

  <span weight="reverse">some reverse string</span>

Specifies display attributes. Weight values can be :

  normal : force some text back to normal
  standout : enable standout property
  underline : enable underline property
  blink : enable blink property
  dim : enable dim property
  bold : enable bold property

Somme properties may be unsupported on your terminal.

=item fgcolor

  <span fgcolor="blue">some blue text</span>

Change the foreground color. values can be :

  black
  red
  green
  yellow
  blue
  magenta
  cyan
  white

=item bgcolor

  <span bgcolor="red">some red background text</span>

Change the foreground color. values can be :

  black
  red
  green
  yellow
  blue
  magenta
  cyan
  white

=back

=back

=head1 CONSTRUCTOR

=head2 new

  input : none
  output : a Curses::Toolkit::Widget::Label object

=head1 METHODS

=head2 set_text

Set the text of the label. The text can be either normal text, or text with
markups, to display colors, bold, underline, etc., see Markup Support above

  input  : the text
  output : the label object

=head2 get_text

Get the text of the Label

  input  : none
  output : STRING, the Label text

=head2 set_justify

Set the text justification inside the label widget.

  input  : STRING, one of 'left', 'right', 'center'
  output : the label object

=head2 get_justify

Get the text justification inside the label widget.

  input  : none
  output : STRING, one of 'left', 'right', 'center'

=head2 set_wrap_mode

Set the wrap mode. 'never' means the label stay on one line (cut if not enough
space is available), paragraphs are not interpreted. 'active' means the label tries to occupy space vertically
(thus wrapping instead of extending to the right). 'lazy' means the label wraps
if it is obliged to (not enough space to display on the same line), and on paragraphs

  input  : STRING, one of 'never', 'active', 'lazy'
  output : the label widget

=head2 get_wrap_mode

Get the text wrap mode ofthe label widget.

  input  : none
  output : STRING, one of 'never', 'active', 'lazy'

=head2 set_wrap_method

Set the wrap method used. 'word' (the default) wraps on word. 'letter' makes
the label wrap but at any point.

  input  : STRING, one of 'word', 'letter'
  output : the label widget

=head2 get_wrap_method

Get the text wrap method inside the label widget.

  input  : none
  output : STRING, one of 'word', 'letter'

=head2 get_desired_space

Given a coordinate representing the available space, returns the space desired
The Label desires the minimum space that lets it display entirely

  input : a Curses::Toolkit::Object::Coordinates object
  output : a Curses::Toolkit::Object::Coordinates object

=head2 get_minimum_space

Given a coordinate representing the available space, returns the minimum space
needed to properly display itself

  input : a Curses::Toolkit::Object::Coordinates object
  output : a Curses::Toolkit::Object::Coordinates object

=head1 AUTHOR

Damien "dams" Krotkine

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Damien "dams" Krotkine.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut