view release on metacpan or  search on metacpan

lib/App/Asciio/stripes/editable_box2.pm  view on Meta::CPAN

use warnings;

use List::Util qw(min max) ;
use Readonly ;
use Clone ;

#-----------------------------------------------------------------------------

Readonly my $DEFAULT_BOX_TYPE => 
	[
	[1, 'top', '.', '-', '.', 1, ],
	[0, 'title separator', '|', '-', '|', 1, ],
	[1, 'body separator', '| ', '|', ' |', 1, ], 
	[1, 'bottom', '\'', '-', '\'', 1, ],
	]  ;

sub new
{
my ($class, $element_definition) = @_ ;

my $self = bless  {}, __PACKAGE__ ;
	
$self->setup
	(
	$element_definition->{TEXT_ONLY},
	$element_definition->{TITLE},
	$element_definition->{BOX_TYPE} || Clone::clone($DEFAULT_BOX_TYPE),
	1, 1,
	$element_definition->{RESIZABLE},
	$element_definition->{EDITABLE},
	$element_definition->{AUTO_SHRINK},
	) ;

return $self ;
}

#-----------------------------------------------------------------------------

sub setup
{
my ($self, $text_only, $title_text, $box_type, $end_x, $end_y, $resizable, $editable, $auto_shrink) = @_ ;

my ($text_width,  @lines) = (0) ;

for my $line (split("\n", $text_only))
	{
	$text_width  = max($text_width, length($line)) ;
	push @lines, $line ;
	}
	
my ($title_width,  @title_lines) = (0) ;

$title_text = '' unless defined $title_text ;

for my $title_line (split("\n", $title_text))
	{
	$title_width  = max($title_width, length($title_line)) ;
	push @title_lines, $title_line ;
	}

my ($extra_width, $extra_height) = get_box_frame_size_overhead($box_type) ;

my $display_title = (defined $title_text and $title_text ne '') ? 1 : 0 ;
$text_width  = max($text_width, $title_width)  if $display_title;

if($auto_shrink)
	{
	($end_x, $end_y) = (-5, -5) ;
	}

$end_x = max($end_x, $text_width + $extra_width, $title_width + $extra_width) ;
$end_y = max($end_y, scalar(@lines) + $extra_height + scalar(@title_lines)) ;

my ($box_top, $box_left, $box_right, $box_bottom, $title_separator, $title_left, $title_right) = get_box_frame_elements($box_type, $end_x) ;

my $text = $box_top ;

for my $title_line (@title_lines)
	{
	my $pading =  ($end_x - (length($title_left . $title_line . $title_right))) ;
	my $left_pading =  int($pading / 2) ;
	my $right_pading = $pading - $left_pading ;
	
	$text .= $title_left . (' ' x $left_pading) . $title_line . (' ' x $right_pading) . $title_right ."\n" ;
	}

$text .= $title_separator ;

for my $line (@lines)
	{
	$text .= $box_left . $line . (' ' x ($end_x - (length($line) + $extra_width))) . $box_right . "\n" ;
	}
	
for (1 .. ($end_y - (@lines + $extra_height + @title_lines)))
	{
	$text .= $box_left .  (' ' x ($end_x - $extra_width)) . $box_right . "\n" ;
	}

$text .= $box_bottom ;

$self->set
	(
	TEXT => $text,
	TITLE => $title_text,
	WIDTH => $end_x,
	HEIGHT => $end_y,
	TEXT_ONLY => $text_only,
	BOX_TYPE => $box_type,
	RESIZABLE => $resizable,
	EDITABLE => $editable,
	AUTO_SHRINK => $auto_shrink,
	) ;
}

#-----------------------------------------------------------------------------

use Readonly ;

Readonly my  $TOP => 0 ;
Readonly my  $TITLE_SEPARATOR => 1 ;
Readonly my  $BODY_SEPARATOR => 2 ;
Readonly my  $BOTTOM => 3;

Readonly my  $DISPLAY => 0 ;
Readonly my  $NAME => 1 ;
Readonly my  $LEFT => 2 ;
Readonly my  $BODY => 3 ;
Readonly my  $RIGHT => 4 ;

sub get_box_frame_size_overhead
{
my ($box_type) = @_ ;

my @displayed_elements = grep { $_->[$DISPLAY] } @{$box_type} ;
my $extra_width = max(0, map {length} map {$_->[$LEFT]}@displayed_elements)
				+ max(0, map {length} map {$_->[$RIGHT]}@displayed_elements) ;
				
my $extra_height = 0 ;

for ($TOP, $TITLE_SEPARATOR, $BOTTOM)
	{
	$extra_height++ if defined $box_type->[$_][$DISPLAY] && $box_type->[$_][$DISPLAY] ;
	}

return($extra_width, $extra_height) ;
}

sub get_box_frame_elements
{
my ($box_type, $width) = @_ ;

my ($box_top, $box_left, $box_right, $box_bottom, $title_separator, $title_left, $title_right) = map {''} (1 .. 7) ;

if($box_type->[$TOP][$DISPLAY])
	{
	my $box_left_and_right_length = length($box_type->[$TOP][$LEFT]) + length($box_type->[$TOP][$RIGHT]) ;
	$box_top = $box_type->[$TOP][$LEFT] 
			. ($box_type->[$TOP][$BODY] x ($width - $box_left_and_right_length))   
			. $box_type->[$TOP][$RIGHT] 
			. "\n" ;
	}
	
$title_left = $box_type->[$TITLE_SEPARATOR][$LEFT] if($box_type->[$BODY_SEPARATOR][$DISPLAY]) ;
$title_right = $box_type->[$TITLE_SEPARATOR][$RIGHT] if($box_type->[$BODY_SEPARATOR][$DISPLAY]) ;

if($box_type->[$TITLE_SEPARATOR][$DISPLAY])
	{
	my $title_left_and_right_length = length($title_left) + length($title_right) ;
	
	my $title_separator_body = $box_type->[$TITLE_SEPARATOR][$BODY] ;
	$title_separator_body = ' ' unless defined $title_separator_body ;
	$title_separator_body = ' ' if $title_separator_body eq '' ;
	
	$title_separator = $title_left
			. ($title_separator_body x ($width - $title_left_and_right_length))   
			. $title_right 
			. "\n" ;
	}
	
$box_left = $box_type->[$BODY_SEPARATOR][$LEFT] if($box_type->[$BODY_SEPARATOR][$DISPLAY]) ;
$box_right = $box_type->[$BODY_SEPARATOR][$RIGHT] if($box_type->[$BODY_SEPARATOR][$DISPLAY]) ;

if($box_type->[$BOTTOM][$DISPLAY])
	{
	my $box_left_and_right_length = length($box_type->[$BOTTOM][$LEFT]) + length($box_type->[$BOTTOM][$RIGHT]) ;
	$box_bottom = $box_type->[$BOTTOM][$LEFT] 
			. ($box_type->[$BOTTOM][$BODY] x ($width - $box_left_and_right_length))   
			. $box_type->[$BOTTOM][$RIGHT] ;
	}

return ($box_top, $box_left, $box_right, $box_bottom, $title_separator, $title_left, $title_right) ;
}

#-----------------------------------------------------------------------------

sub get_selection_action
{
my ($self, $x, $y) = @_ ;

if	(
	($x == $self->{WIDTH} - 1 && $y == $self->{HEIGHT} - 1)
	)
	{
	'resize' ;
	}
else
	{
	'move' ;