view release on metacpan or  search on metacpan

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

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

# the idea is to reuse wirl arrow implementation as much as possible

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

Readonly my $DEFAULT_ARROW_TYPE =>
			[
			['origin', '', '*', '', '', '', 1],
			['up', '|', '|', '', '', '^', 1],
			['down', '|', '|', '', '', 'v', 1],
			['left', '-', '-', '', '', '<', 1],
			['upleft', '|', '|', '.', '-', '<', 1],
			['leftup', '-', '-', '\'', '|', '^', 1],
			['downleft', '|', '|', '\'', '-', '<', 1],
			['leftdown', '-', '-', '.', '|', 'v', 1],
			['right', '-', '-','', '', '>', 1],
			['upright', '|', '|', '.', '-', '>', 1],
			['rightup', '-', '-', '\'', '|', '^', 1],
			['downright', '|', '|', '\'', '-', '>', 1],
			['rightdown', '-', '-', '.', '|', 'v', 1],
			['45', '/', '/', '', '', '^', 1, ],
			['135', '\\', '\\', '', '', 'v', 1, ],
			['225', '/', '/', '', '', 'v', 1, ],
			['315', '\\', '\\', '', '', '^', 1, ],
			] ;

# constants for connector overlays
Readonly my $body_index => 2 ;
Readonly my $connection_index => 3 ;

Readonly my $up_index=> 1 ;
Readonly my $left_index=> 3 ;
Readonly my $leftup_index => 5 ;
Readonly my $leftdown_index => 7 ;

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

my $self = bless  {}, __PACKAGE__ ;
	
$self->setup
	(
	$element_definition->{ARROW_TYPE} || Clone::clone($DEFAULT_ARROW_TYPE),
	$element_definition->{POINTS},
	$element_definition->{DIRECTION},
	$element_definition->{ALLOW_DIAGONAL_LINES},
	$element_definition->{EDITABLE},
	$element_definition->{NOT_CONNECTABLE_START},
	$element_definition->{NOT_CONNECTABLE_END},
	) ;

return $self ;
}

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

sub setup
{
my ($self, $arrow_type, $points, $direction, $allow_diagonal_lines, $editable, $not_connectable_start, $not_connectable_end) = @_ ;

if('ARRAY' eq ref $points && @{$points} > 0)
	{
	my ($start_x, $start_y, $arrows) = (0, 0, []) ;
	
	my $points_offsets ;
	my $arrow_index = 0 ; # must have a numeric index or 'undo' won't work
	
	for my $point (@{$points})
		{
		my ($x, $y, $point_direction) = @{$point} ;
		
		my $arrow = new App::Asciio::stripes::wirl_arrow
					({
					ARROW_TYPE => $arrow_type,
					END_X => $x - $start_x,
					END_Y => $y - $start_y,
					DIRECTION => $point_direction || $direction,
					ALLOW_DIAGONAL_LINES => $allow_diagonal_lines,
					EDITABLE => $editable,
					}) ;
						
		$points_offsets->[$arrow_index++] = [$start_x, $start_y] ;
		
		push @{$arrows},  $arrow ;
		($start_x, $start_y) = ($x, $y) ;
		}
		
	$self->set
		(
		POINTS_OFFSETS => $points_offsets,
		ARROWS => $arrows,
		
		# keep data to allow section insertion later
		ARROW_TYPE => $arrow_type,
		DIRECTION => $direction,
		ALLOW_DIAGONAL_LINES => $allow_diagonal_lines,
		EDITABLE => $editable,
		NOT_CONNECTABLE_START => $not_connectable_start,
		NOT_CONNECTABLE_END => $not_connectable_end,
		) ;
		
	my ($width, $height) = $self->get_width_and_height() ;
	$self->set
			(
			WIDTH => $width,
			HEIGHT => $height,
			) ;
	}
else
	{
	die "Bad 'section wirl arrow' defintion! Expecting points array." ;
	}
}

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

my %diagonal_direction_to_overlay_character =
	(
	(map {$_ => q{\\}} qw( down-right right-down up-left left-up)), 
	(map {$_ => q{/}} qw( down-left left-down up-right right-up)), 
	) ;

my %diagonal_non_diagonal_to_overlay_character =
	(
	(map {$_ => q{.}} qw( down-right right-down up-left left-up)), 
	(map {$_ => q{'}} qw( down-left left-down up-right right-up)), 
	) ;
	
sub get_mask_and_element_stripes
{
my ($self) = @_ ;

my @mask_and_element_stripes ;

my $arrow_index = 0 ;
for my $arrow(@{$self->{ARROWS}})
	{
	push @mask_and_element_stripes, 
		map 
		{
		$_->{X_OFFSET} += $self->{POINTS_OFFSETS}[$arrow_index][0] ;
		$_->{Y_OFFSET} += $self->{POINTS_OFFSETS}[$arrow_index][1];
		$_ ;
		} $arrow->get_mask_and_element_stripes() ;
		
	$arrow_index++ ;
	}

# handle connections
my ($previous_direction) = ($self->{ARROWS}[0]{DIRECTION} =~ /^([^-]+)/) ;

my $previous_was_diagonal ;

$arrow_index = 0 ;
for my $arrow(@{$self->{ARROWS}})
	{
	last if @{$self->{ARROWS}} == 1 ;

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

	
	my ($start_connector, $end_connector) = $self->{ARROWS}[$arrow_index]->get_connector_points() ;
	$x += $end_connector->{X} ;
	$y += $end_connector->{Y} ;
	
	$smallest_x = min($smallest_x, $x) ;
	$smallest_y = min($smallest_y, $y) ;
	$biggest_x = max($biggest_x, $x) ;
	$biggest_y = max($biggest_y, $y) ;
	
	$arrow_index++ ;
	}

return(($biggest_x - $smallest_x) + 1, ($biggest_y - $smallest_y) + 1) ;
}

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

sub get_arrow_type
{
my ($self) = @_ ;
return($self->{ARROW_TYPE})  ;
}

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

sub set_arrow_type
{
my ($self, $arrow_type) = @_ ;
$self->setup($arrow_type, $self->get_points(), $self->{DIRECTION}, $self->{ALLOW_DIAGONAL_LINES}, $self->{EDITABLE}) ;
}

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

sub get_points
{
my ($self) = @_ ;

my @points ;
my $arrow_index = 0 ;

for my $point_offset (@{$self->{POINTS_OFFSETS}})
	{
	my ($x_offset, $y_offset) = @{$point_offset} ;
	my ($start_connector, $end_connector, $direction) 
		= (
			$self->{ARROWS}[$arrow_index]->get_connector_points(),
			$self->{ARROWS}[$arrow_index]->get_direction()
		) ;
	
	push @points, [$x_offset + $end_connector->{X}, $y_offset + $end_connector->{Y}, $direction] ;
	
	$arrow_index++ ;
	}

return \@points ;
}

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

sub edit
{
my ($self) = @_ ;

return unless $self->{EDITABLE} ;

# add section
# remove section

# handle offset array
}

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

1 ;