view release on metacpan or  search on metacpan

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

package App::Asciio::stripes::wirl_arrow ;

use base App::Asciio::stripes::stripes ;

use strict;
use warnings;

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

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

Readonly my $DEFAULT_ARROW_TYPE => 
	[
	#name: $start, $body, $connection, $body_2, $end
	
	['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, ],
	] ;

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

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

return $self ;
}

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

sub setup
{
my ($self, $arrow_type, $end_x, $end_y, $direction, $allow_diagonal_lines, $editable) = @_ ;

my ($stripes, $width, $height) ;

($stripes, $width, $height, $direction) = get_arrow($arrow_type, $end_x, $end_y, $direction, $allow_diagonal_lines) ;

$self->set
	(
	STRIPES => $stripes,
	WIDTH => $width,
	HEIGHT => $height,
	DIRECTION => $direction,
	ARROW_TYPE => $arrow_type,
	END_X => $end_x,
	END_Y => $end_y,
	ALLOW_DIAGONAL_LINES => $allow_diagonal_lines,
	) ;
}

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

my %direction_to_arrow = 
	(
	'origin' => \&draw_origin,
	'up' => \&draw_up,
	'down' => \&draw_down,
	'left' => \&draw_left,
	'up-left' => \&draw_upleft,
	'left-up' => \&draw_leftup,
	'down-left' => \&draw_downleft,
	'left-down' => \&draw_leftdown,
	'right' => \&draw_right,
	'up-right' => \&draw_upright,
	'right-up' => \&draw_rightup,
	'down-right' => \&draw_downright,
	'right-down' => \&draw_rightdown,
	) ;
	
sub get_arrow
{
my ($arrow_type, $end_x, $end_y, $direction, $allow_diagonal_lines) = @_ ;

use constant CENTER => 1 ;
use constant LEFT => 0 ;
use constant RIGHT => 2 ;
use constant UP => 0 ;
use constant DOWN => 2 ;

my @position_to_direction =
	(
	[$direction =~ /^up/ ? 'up-left' : 'left-up', 'left',  $direction =~ /^down/ ? 'down-left' : 'left-down'] ,
	['up', 'origin', 'down'],
	[$direction =~ /^up/ ? 'up-right' : 'right-up', 'right', $direction =~ /^down/ ? 'down-right' : 'right-down'],
	) ;

$direction = $position_to_direction
			[$end_x == 0 ? CENTER : $end_x < 0 ? LEFT : RIGHT]
			[$end_y == 0 ? CENTER : $end_y < 0 ? UP : DOWN] ;

return($direction_to_arrow{$direction}->($arrow_type, $end_x, $end_y, $allow_diagonal_lines), $direction) ;
}

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

		$self->resize(-1, -1, $self->{END_X} + $x_offset, $self->{END_Y} + $y_offset, $hint) ;

	return 
		$x_offset, $y_offset, $width, $height,
		{X => $self->{END_X}, Y => $self->{END_Y}, NAME => 'end'} ;
	}
else
	{
	die "unknown connector '$connector_name'!\n" ;
	}
}

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

sub resize
{
my ($self, $reference_x, $reference_y, $new_x, $new_y, $hint, $connector_name) = @_ ;

my $is_start ;

if(defined $connector_name)
	{
	if($connector_name eq 'start')
		{
		$is_start++ ;
		}
	}
else
	{
	if($reference_x == 0 && $reference_y == 0)
		{
		$is_start++ ;
		}
	}

if($is_start)
	{
	my $x_offset = $new_x ;
	my $y_offset = $new_y ;
	
	my $new_end_x = $self->{END_X} - $x_offset ;
	my $new_end_y = $self->{END_Y} - $y_offset ;
	
	$self->setup($self->{ARROW_TYPE}, $new_end_x, $new_end_y, $hint || $self->{DIRECTION},$self ->{ALLOW_DIAGONAL_LINES}, $self->{EDITABLE}) ;

	return($x_offset, $y_offset, $self->{WIDTH}, $self->{HEIGHT}, 'start') ;
	}
else
	{
	my $new_end_x = $new_x ;
	my $new_end_y = $new_y ;

	$self->setup($self->{ARROW_TYPE}, $new_end_x, $new_end_y, $hint || $self->{DIRECTION}, $self ->{ALLOW_DIAGONAL_LINES}, $self->{EDITABLE}) ;

	return(0, 0, $self->{WIDTH}, $self->{HEIGHT}, 'end') ;
	}
}

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

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

return unless $self->{EDITABLE} ;

$self->display_arrow_edit_dialog() ;

my ($stripes, $width, $height, $x_offset, $y_offset) =
	$direction_to_arrow{$self->{DIRECTION}}->($self->{ARROW_TYPE}, $self->{END_X}, $self->{END_Y}) ;

$self->set(STRIPES => $stripes,) ;
}

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

1 ;