The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

use List::MoreUtils qw(any minmax first_value) ;
use Readonly ;

use App::Asciio::stripes::section_wirl_arrow ;

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

register_action_handlers
	(
	'Quick link' => ['C0S-button_press-1', \&quick_link] ,
	#~ 'C00-button_release' => ['', ] ,
	#~ 'C00-motion_notify' =>['', ] ,
	) ;


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

Readonly my $PREFERED_DIRECTION => 'right-down' ; # or 'down-right' ;

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

sub quick_link
{
my ($self, $event) = @_ ;

$self->create_undo_snapshot() ;

if($event->button == 1) 
	{
	my ($x, $y) = $self->closest_character($event->coords()) ;
	my ($destination_element) = first_value {$self->is_over_element($_, $x, $y)} reverse @{$self->{ELEMENTS}} ;
	
	if($destination_element)
		{
		connect_to_destination_element($self, $destination_element, $x, $y) ;
		}
	else
		{
		# user clicked in void or un-linkable object
		no_destination_element($self, $x, $y) ;
		}
	}
	
#~ if($event->type eq '2button-press')
	#~ {
	#~ }

#~ if($event->button == 3) 
	#~ {
	#~ }
}

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

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

my $new_box = $self->add_new_element_named('stencils/asciio/box', $x, $y) ;
connect_to_destination_element($self, $new_box, $x, $y) ;
}

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

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

my @destination_connections = grep {$_->{NAME} ne 'resize'} $destination_element->get_connection_points() ;

if(@destination_connections)
	{
	my @selected_elements = grep {$_ != $destination_element} $self->get_selected_elements(1) ;
	my $destination_connection = $destination_connections[0] ;
	
	if(@selected_elements)
		{
		$self->select_elements(0, @{$self->{ELEMENTS}}) ;
		
		for my $element (@selected_elements)
			{
			# link $element to $destination_element
			my @source_connections = grep {$_->{NAME} ne 'resize'} $element->get_connection_points() ;
			
			if(@source_connections)
				{
				connect_from_box($self,  $element, $source_connections[0], $destination_element, $destination_connection) ;
				}
			else
				{
				connect_from_arrow($self,  $element, $destination_element, $destination_connection) ;
				}
			}

		$self->select_elements(1, @selected_elements) ;
		}
	else
		{
		$self->select_elements(1, $destination_element) ;
		}
		
	$self->update_display() ; # will also canonize the connections
	}
}

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

sub connect_from_box
{
my ($self,  $element, $source_connection, $destination_element, $destination_connection) = @_ ;

my $wirl_arrow = new App::Asciio::stripes::section_wirl_arrow
					({
					POINTS => 
					[
						[
						($destination_element->{X} + $destination_connection->{X})
						 - ($element->{X} + $source_connection->{X}),
								
						($destination_element->{Y} + $destination_connection->{Y})
						- ($element->{Y} + $source_connection->{Y}),
						
						$PREFERED_DIRECTION,
						],
					],		 
					DIRECTION => $PREFERED_DIRECTION,
					ALLOW_DIAGONAL_LINES => 0,
					EDITABLE => 1,
					RESIZABLE => 1,
					}) ;
					
$self->add_element_at_no_connection
		(
		$wirl_arrow, 
		$element->{X} + $source_connection->{X},
		$element->{Y} + $source_connection->{Y},
		) ;
		
$self->add_connections
	({
	CONNECTED => $wirl_arrow,
	CONNECTOR => $wirl_arrow->get_named_connection('startsection_0'),
	CONNECTEE => $element,
	CONNECTION => $source_connection,
	}) ;
	
$self->add_connections
	({
	CONNECTED => $wirl_arrow,
	CONNECTOR => $wirl_arrow->get_named_connection('endsection_0'),
	CONNECTEE => $destination_element,
	CONNECTION => $destination_connection,
	}) ;
}

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

sub connect_from_arrow
{
my ($self,  $element, $destination_element, $destination_connection) = @_ ;

my %source_connectors = map {$_->{NAME} => $_} grep {$_->{NAME} ne 'resize'} $element->get_connector_points() ;

for(grep {$_->{CONNECTED} == $element } @{$self->{CONNECTIONS}})
	{
	delete $source_connectors{$_->{CONNECTOR}{NAME}} ;
	}

my ($unconnected_connector_name) = reverse sort keys %source_connectors ;

print "$unconnected_connector_name\n" ;
if($unconnected_connector_name)
	{
	my $unconnected_connector = $source_connectors{$unconnected_connector_name} ;
		
	my ($x_offset, $y_offset) = 
		$element->move_connector
				(
				$unconnected_connector_name, 
				
				($destination_element->{X} + $destination_connection->{X}) - ($element->{X} + $unconnected_connector->{X}),
				($destination_element->{Y} + $destination_connection->{Y}) - ($element->{Y} + $unconnected_connector->{Y}),
				) ;
			
	$element->{X} += $x_offset ;
	$element->{Y} += $y_offset ;
	
	my $new_connection = 
		{
		CONNECTED => $element,
		CONNECTOR =>$unconnected_connector,
		CONNECTEE => $destination_element,
		CONNECTION => $destination_connection,
		} ;
		
	$self->add_connections($new_connection) ;
	}
}

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