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) ;
}
}
#----------------------------------------------------------------------------------------------