package App::Asciio::stripes::editable_box2 ; use base App::Asciio::stripes::single_stripe ; use strict; 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, ) ; } #----------------------------------------------------------------------------- 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' ; } } #----------------------------------------------------------------------------- sub match_connector { my ($self, $x, $y) = @_ ; my $middle_width = int($self->{WIDTH} / 2) ; my $middle_height = int($self->{HEIGHT} / 2) ; if($x == $middle_width && $y == -1) { return {X => $x, Y => $y, NAME => 'top_center'} ; } elsif($x == $middle_width && $y == $self->{HEIGHT}) { return {X => $x, Y => $y, NAME => 'bottom_center'} ; } if($x == -1 && $y == $middle_height) { return {X => $x, Y => $y, NAME => 'left_center'} ; } elsif($x == $self->{WIDTH} && $y == $middle_height) { return {X => $x, Y => $y, NAME => 'right_center'} ; } elsif($x >= 0 && $x < $self->{WIDTH} && $y >= 0 && $y < $self->{HEIGHT}) { return {X => $middle_width, Y => -1, NAME => 'to_be_optimized'} ; } elsif($self->{ALLOW_BORDER_CONNECTION} && $x >= -1 && $x <= $self->{WIDTH} && $y >= -1 && $y <= $self->{HEIGHT}) { return {X => $x, Y => $y, NAME => 'border'} ; } else { return ; } } #----------------------------------------------------------------------------- sub get_connection_points { my ($self) = @_ ; my $middle_width = int($self->{WIDTH} / 2) ; my $middle_height = int($self->{HEIGHT} / 2) ; return ( {X => $middle_width, Y => -1, NAME => 'top_center'}, {X => $middle_width, Y => $self->{HEIGHT}, NAME => 'bottom_center'}, {X => -1, Y => $middle_height, NAME => 'left_center'}, {X => $self->{WIDTH}, Y => $middle_height, NAME => 'right_center'}, ) ; } #----------------------------------------------------------------------------- sub get_extra_points { my ($self) = @_ ; if($self->{RESIZABLE} && ! $self->is_auto_shrink()) { return {X => $self->{WIDTH} - 1, Y => $self->{HEIGHT} - 1, NAME => 'resize'} ; } else { return ; } } #----------------------------------------------------------------------------- sub get_named_connection { my ($self, $name) = @_ ; my $middle_width = int($self->{WIDTH} / 2) ; my $middle_height = int($self->{HEIGHT} / 2) ; if($name eq 'top_center') { return( {X => $middle_width, Y => -1, NAME => 'top_center'} ) ; } elsif($name eq 'bottom_center') { return( {X => $middle_width, Y => $self->{HEIGHT}, NAME => 'bottom_center'} ) ; } elsif($name eq 'left_center') { return {X => -1, Y => $middle_height, NAME => 'left_center'}, } elsif($name eq 'right_center') { return {X => $self->{WIDTH}, Y => $middle_height, NAME => 'right_center'}, } else { return ; } } #----------------------------------------------------------------------------- sub allow_border_connection { my($self, $allow) = @_ ; $self->{ALLOW_BORDER_CONNECTION} = $allow ; } #----------------------------------------------------------------------------- sub is_border_connection_allowed { my($self) = @_ ; return $self->{ALLOW_BORDER_CONNECTION} ; } #----------------------------------------------------------------------------- sub flip_auto_shrink { my($self) = @_ ; $self->{AUTO_SHRINK} ^= 1 ; } #----------------------------------------------------------------------------- sub is_auto_shrink { my($self) = @_ ; return $self->{AUTO_SHRINK} ; } #----------------------------------------------------------------------------- sub resize { my ($self, $reference_x, $reference_y, $new_x, $new_y) = @_ ; return(0, 0, $self->{WIDTH}, $self->{HEIGHT}) unless $self->{RESIZABLE} ; my $new_end_x = $new_x ; my $new_end_y = $new_y ; if($new_end_x >= 0 && $new_end_y >= 0) { $self->setup ( $self->{TEXT_ONLY}, $self->{TITLE}, $self->{BOX_TYPE}, $new_end_x + 1, $new_end_y + 1, $self->{RESIZABLE}, $self->{EDITABLE}, $self->{AUTO_SHRINK}, ) ; } return(0, 0, $self->{WIDTH}, $self->{HEIGHT}) ; } #----------------------------------------------------------------------------- sub get_text { my ($self) = @_ ; return($self->{TITLE}, $self->{TEXT_ONLY}) ; } #----------------------------------------------------------------------------- sub set_text { my ($self, $title, $text) = @_ ; my @displayed_elements = grep { $_->[$DISPLAY] } @{$self->{BOX_TYPE}} ; $text = 'edit_me' if($text eq '' && @displayed_elements == 0) ; $self->setup ( $text, $title, $self->{BOX_TYPE}, $self->{WIDTH}, $self->{HEIGHT}, $self->{RESIZABLE}, $self->{EDITABLE}, $self->{AUTO_SHRINK}, ) ; } #----------------------------------------------------------------------------- sub get_box_type { my ($self) = @_ ; return($self->{BOX_TYPE}) ; } #----------------------------------------------------------------------------- sub set_box_type { my ($self, $box_type) = @_ ; $self->setup ( $self->{TEXT_ONLY}, $self->{TITLE}, $box_type, $self->{WIDTH}, $self->{HEIGHT}, $self->{RESIZABLE}, $self->{EDITABLE}, $self->{AUTO_SHRINK}, ) ; } #----------------------------------------------------------------------------- sub edit { my ($self) = @_ ; return unless $self->{EDITABLE} ; my $text = $self->{TEXT_ONLY} ; $text = make_vertical_text($text) if $self->{VERTICAL_TEXT} ; ($text, my $title) = App::Asciio::display_box_edit_dialog($self->{BOX_TYPE}, $self->{TITLE}, $text) ; my $tab_as_space = $self->{TAB_AS_SPACES} || (' ' x 3) ; $text =~ s/\t/$tab_as_space/g ; $title=~ s/\t/$tab_as_space/g ; $text = make_vertical_text($text) if $self->{VERTICAL_TEXT} ; $self->set_text($title, $text) ; } #----------------------------------------------------------------------------- sub rotate_text { my ($self) = @_ ; my $text = make_vertical_text($self->{TEXT_ONLY}) ; $self->set_text($self->{TITLE}, $text) ; $self->shrink() ; $self->{VERTICAL_TEXT} ^= 1 ; } #----------------------------------------------------------------------------- sub shrink { my ($self) = @_ ; $self->setup ( $self->{TEXT_ONLY}, $self->{TITLE}, $self->{BOX_TYPE}, -5, -5, $self->{RESIZABLE}, $self->{EDITABLE}, $self->{AUTO_SHRINK}, ) ; } #----------------------------------------------------------------------------- sub make_vertical_text { my ($text) = @_ ; my @lines = map{[split '', $_]} split "\n", $text ; my $vertical = '' ; my $found_character = 1 ; my $index = 0 ; while($found_character) { my $line ; $found_character = 0 ; for(@lines) { if(defined $_->[$index]) { $line.= $_->[$index] ; $found_character++ ; } else { $line .= ' ' ; } } $line =~ s/\s+$//; $vertical .= "$line\n" if $found_character ; $index++ ; } return $vertical ; } #----------------------------------------------------------------------------- 1 ;