#~ use Data::TreeDumper ;
#----------------------------------------------------------------------------------------------
register_hooks
(
['CANONIZE_CONNECTIONS' => \&canonize_connections],
) ;
#----------------------------------------------------------------------------------------------
=pod
.-------.
| |
| .---.
| | C | start connector (first character)
| C | o | /
| O | n | /
| N | n | .---. end connector (last character)
| N | e | | --------------------------------. /
| E | c | '---' | /
| C | t | CONNECTED .-|-./
| T | i | | v |
| E | o | '---'
| E | n |
| '---' .------------.
| | | Connection |
'-------' .----'------------'-----.
| |
| CONNECTEE |
| |
'-----------------------'
=cut
sub canonize_connections
{
my ($connections) = @_ ;
for my $connection (@{$connections})
{
if
(
ref $connection->{CONNECTED} eq 'App::Guiio::stripes::section_wirl_arrow'
&& $connection->{CONNECTED}->is_autoconnect_enabled()
)
{
reconnect_section_wirl_arrow($connection) ;
}
}
}
sub reconnect_section_wirl_arrow
{
my ($connection) = @_ ;
my ($connected, $connectee) = ($connection->{CONNECTED}, $connection->{CONNECTEE}) ;
my @connectors = $connected->get_all_points() ;
my ($start_name, $end_name) = ($connectors[0]{NAME}, $connectors[-1]{NAME}) ;
if($connection->{CONNECTOR}{NAME} eq $end_name)
{
# end connector
my ($connectee_x, $connectee_y, $connectee_width, $connectee_hight) =
($connectee->{X}, $connectee->{Y}, $connectee->get_size()) ;
my $connected_x = $connected->{X} + $connectors[-2]{X};
my $connected_y = $connected->{Y} + $connectors[-2]{Y};
if($connected_x < $connectee_x)
{
# arrow starts on left of the box
if($connected->get_section_direction(-1) =~ /^right/)
{
if($connected_y < $connectee_y)
{
reconnect($connection, 'top_center', $end_name) ;
}
else
{
if($connected_y < $connectee_y + $connectee_hight)
{
reconnect($connection, 'left_center', $end_name) ;
}
else
{
# arrow below, right-up to bottom_center
reconnect($connection, 'bottom_center', $end_name) ;
}
}
}
else
{
# arrow going up or down
reconnect($connection, 'left_center', $end_name) ;
}
}
elsif($connected_x < $connectee_x + $connectee_width)
{
# arrow starts within width of the box
if($connected_y < $connectee_y)
{
#arrow above, right-down to top_center
reconnect($connection, 'top_center', $end_name, 'right') ;
}
else
{
reconnect($connection, 'bottom_center', $end_name) ;
}
}
else
{
# arrow starts on right of the box
if($connected->get_section_direction(-1) =~ /^left/)
{
if($connected_y < $connectee_y)
{
reconnect($connection, 'top_center', $end_name) ;
}
else
{
if($connected_y < $connectee_y + $connectee_hight)
{
reconnect($connection, 'right_center', $end_name) ;
}
else
{
reconnect($connection, 'bottom_center', $end_name) ;
}
}
}
else
{
# arrow going up or down
reconnect($connection, 'right_center', $end_name) ;
}
}
}
else
{
# start connector
my ($connectee_x, $connectee_y, $connectee_width, $connectee_hight) =
($connectee->{X}, $connectee->{Y}, $connectee->get_size()) ;
my $end_connector_x = $connected->{X} + $connectors[1]{X};
my $end_connector_y = $connected->{Y} + $connectors[1]{Y} ;
if($end_connector_x < $connectee_x)
{
# arrow ends on left of the box
if($connected->get_section_direction(0) !~ /^left/)
{
if($end_connector_y < $connectee_y)
{
reconnect($connection, 'top_center', $start_name) ;
}
else
{
if($end_connector_y < $connectee_y + $connectee_hight)
{
reconnect($connection, 'left_center', $start_name) ;
}
else
{
reconnect($connection, 'bottom_center', $start_name) ;
}
}
}
else
{
reconnect($connection, 'left_center', $start_name) ;
}
}
elsif($end_connector_x < $connectee_x + $connectee_width)
{
# arrow starts within width of the box
if($end_connector_y < $connectee_y)
{
reconnect($connection, 'top_center', $start_name) ;
}
else
{
reconnect($connection, 'bottom_center', $start_name) ;
}
}
else
{
# arrow ends on right of the box
if($connected->get_section_direction(0) !~ /^right/)
{
if($end_connector_y < $connectee_y)
{
reconnect($connection, 'top_center', $start_name) ;
}
else
{
if($end_connector_y < $connectee_y + $connectee_hight)
{
reconnect($connection, 'right_center', $start_name) ;
}
else
{
reconnect($connection, 'bottom_center', $start_name) ;
}
}
}
else
{
reconnect($connection, 'right_center', $start_name) ;
}
}
}
}
sub reconnect
{
my($guiio_connection, $connection_name, $connector_name, $hint) = @_ ;
if($guiio_connection->{CONNECTION}{NAME} ne $connection_name)
{
my ($connected, $connectee) = ($guiio_connection->{CONNECTED}, $guiio_connection->{CONNECTEE}) ;
my ($connection) = $connectee->get_named_connection($connection_name) ;
my ($connector) = $connected->get_named_connection($connector_name) ;
my $x_offset_to_connection = ($connectee->{X} + $connection->{X}) - ($connected->{X} + $connector->{X}) ;
my $y_offset_to_connection = ($connectee->{Y} + $connection->{Y}) - ($connected->{Y} + $connector->{Y}) ;
# move connector
#~ print "reconnect: $connection_name $connector_name\n" ;
my ($x_offset, $y_offset, $width, $height, $new_connector) =
$connected->move_connector($connector_name, $x_offset_to_connection, $y_offset_to_connection, $hint) ;
$connected->{X} += $x_offset ;
$connected->{Y} += $y_offset ;
$guiio_connection->{CONNECTOR} = $new_connector ;
$guiio_connection->{CONNECTION} = $connection ;
}
}