view release on metacpan or  search on metacpan

lib/Graph/Easy/Layout/Scout.pm  view on Meta::CPAN

use warnings;
use Graph::Easy::Node::Cell;
use Graph::Easy::Edge::Cell qw/
  EDGE_SHORT_E EDGE_SHORT_W EDGE_SHORT_N EDGE_SHORT_S

  EDGE_SHORT_BD_EW EDGE_SHORT_BD_NS
  EDGE_SHORT_UN_EW EDGE_SHORT_UN_NS

  EDGE_START_E EDGE_START_W EDGE_START_N EDGE_START_S

  EDGE_END_E EDGE_END_W EDGE_END_N EDGE_END_S

  EDGE_N_E EDGE_N_W EDGE_S_E EDGE_S_W

  EDGE_N_W_S EDGE_S_W_N EDGE_E_S_W EDGE_W_S_E

  EDGE_LOOP_NORTH EDGE_LOOP_SOUTH EDGE_LOOP_WEST EDGE_LOOP_EAST

  EDGE_HOR EDGE_VER EDGE_HOLE

  EDGE_S_E_W EDGE_N_E_W EDGE_E_N_S EDGE_W_N_S

  EDGE_LABEL_CELL
  EDGE_TYPE_MASK
  EDGE_ARROW_MASK
  EDGE_FLAG_MASK
  EDGE_START_MASK
  EDGE_END_MASK
  EDGE_NO_M_MASK
 /;

#############################################################################

# mapping edge type (HOR, VER, NW etc) and dx/dy to startpoint flag
my $start_points = {
#               [ dx == 1, 	dx == -1,     dy == 1,      dy == -1 ,
#                 dx == 1, 	dx == -1,     dy == 1,      dy == -1 ]
  EDGE_HOR() => [ EDGE_START_W, EDGE_START_E, 0,	    0 			,
		  EDGE_END_E,   EDGE_END_W,   0,	    0,			],
  EDGE_VER() => [ 0,		0, 	      EDGE_START_N, EDGE_START_S 	,
		  0,		0,	      EDGE_END_S,   EDGE_END_N,		],
  EDGE_N_E() => [ 0,		EDGE_START_E, EDGE_START_N, 0		 	,
		  EDGE_END_E,	0,	      0, 	    EDGE_END_N, 	],
  EDGE_N_W() => [ EDGE_START_W,	0, 	      EDGE_START_N, 0			,
		  0,	        EDGE_END_W,   0,	    EDGE_END_N,		],
  EDGE_S_E() => [ 0,		EDGE_START_E, 0,	    EDGE_START_S 	,
		  EDGE_END_E,   0,            EDGE_END_S,   0,			],
  EDGE_S_W() => [ EDGE_START_W,	0, 	      0,	    EDGE_START_S	,
		  0,		EDGE_END_W,   EDGE_END_S,   0,			],
  };

my $start_to_end = {
  EDGE_START_W() => EDGE_END_W(),
  EDGE_START_E() => EDGE_END_E(),
  EDGE_START_S() => EDGE_END_S(),
  EDGE_START_N() => EDGE_END_N(),
  };

sub _end_points
  {
  # modify last field of path to be the correct endpoint; and the first field
  # to be the correct startpoint:
  my ($self, $edge, $coords, $dx, $dy) = @_;

  return $coords if $edge->undirected();

  # there are two cases (for each dx and dy)
  my $i = 0;					# index 0,1
  my $co = 2;
  my $case;

  for my $d ($dx,$dy,$dx,$dy)
    {
    next if $d == 0;

    my $type = $coords->[$co] & EDGE_TYPE_MASK;

    $case = 0; $case = 1 if $d == -1;

    # modify first/last cell
    my $t = $start_points->{ $type }->[ $case + $i ];
    # on bidirectional edges, turn START_X into END_X
    $t = $start_to_end->{$t} || $t if $edge->{bidirectional};

    $coords->[$co] += $t;

    } continue {
    $i += 2; 					# index 2,3, 4,5 etc
    $co = -1 if $i == 4;			# modify now last cell
    }
  $coords;
  }

sub _find_path
  {
  # Try to find a path between two nodes. $options contains direction
  # preferences. Returns a list of cells like:
  # [ $x,$y,$type, $x1,$y1,$type1, ...]
  my ($self, $src, $dst, $edge) = @_;

  # one node pointing back to itself?
  if ($src == $dst)
    {
    my $rc = $self->_find_path_loop($src,$edge);
    return $rc unless scalar @$rc == 0;
    }

  # If one of the two nodes is bigger than 1 cell, use _find_path_astar(),
  # because it automatically handles all the possibilities:
  return $self->_find_path_astar($edge)
    if ($src->is_multicelled() || $dst->is_multicelled() || $edge->has_ports());

  my ($x0, $y0) = ($src->{x}, $src->{y});
  my ($x1, $y1) = ($dst->{x}, $dst->{y});
  my $dx = ($x1 - $x0) <=> 0;
  my $dy = ($y1 - $y0) <=> 0;

  my $cells = $self->{cells};
  my @coords;
  my ($x,$y) = ($x0,$y0);			# starting pos

lib/Graph/Easy/Layout/Scout.pm  view on Meta::CPAN

  my $cells = $self->{cells};
  my @places = $node->_near_places($cells, 1, # distance 1
   $flags, 'loose');

  my $i = 0;
  while ($i < @places)
    {
    my ($x,$y) = ($places[$i], $places[$i+1]); $i += 3;

    next unless exists $cells->{"$x,$y"};		# empty space?
    # found some cell, check that it is a EDGE_HOR or EDGE_VER
    my $cell = $cells->{"$x,$y"};
    next unless $cell->isa('Graph::Easy::Edge::Cell');

    my $cell_type = $cell->{type} & EDGE_TYPE_MASK;

    next unless $cell_type == EDGE_HOR || $cell_type == EDGE_VER;

    # the cell must belong to one of the shared edges
    my $e = $cell->{edge}; local $_;
    next unless scalar grep { $e == $_ } @$shared;

    # make the cell at the current pos a joint
    $cell->_make_joint($edge,$places[$i-1]);

    # The layouter will check that each edge has a cell, so add a dummy one to
    # $edge to make it happy:
    Graph::Easy::Edge::Cell->new( type => EDGE_HOLE, edge => $edge, x => $x, y => $y );

    return [];					# path is empty
    }

  undef;		# did not find an edge cell that can be used as joint
  }

sub _find_path_astar
  {
  # Find a path with the A* algorithm for the given edge (from node A to B)
  my ($self,$edge) = @_;

  my $cells = $self->{cells};
  my $src = $edge->{from};
  my $dst = $edge->{to};

  print STDERR "# A* from $src->{x},$src->{y} to $dst->{x},$dst->{y}\n" if $self->{debug};

  my $start_flags = [
    EDGE_START_W,
    EDGE_START_N,
    EDGE_START_E,
    EDGE_START_S,
  ];

  my $end_flags = [
    EDGE_END_W,
    EDGE_END_N,
    EDGE_END_E,
    EDGE_END_S,
  ];

  # if the target/source node is of shape "edge", remove the endpoint
  if ( ($edge->{to}->attribute('shape')) eq 'edge')
    {
    $end_flags = [ 0,0,0,0 ];
    }
  if ( ($edge->{from}->attribute('shape')) eq 'edge')
    {
    $start_flags = [ 0,0,0,0 ];
    }

  my ($s_p,@ss_p) = $edge->port('start');
  my ($e_p,@ee_p) = $edge->port('end');
  my (@A, @B);					# Start/Stop positions
  my @shared_start;
  my @shared_end;

  my $joint_type = {};
  my $joint_type_end = {};

  my $start_cells = {};
  my $end_cells = {};

  ###########################################################################
  # end fields first (because maybe an edge runs alongside the node)

  # has a end point restriction
  @shared_end = $edge->{to}->edges_at_port('end', $e_p, $ee_p[0]) if defined $e_p && @ee_p == 1;

  my @shared = ();
  # filter out all non-placed edges (this will also filter out $edge)
  for my $s (@shared_end)
    {
    push @shared, $s if @{$s->{cells}} > 0;
    }

  my $per_field = 5;			# for shared: x,y,undef, px,py
  if (@shared > 0)
    {
    # more than one edge share the same end port, and one of the others was
    # already placed

    print STDERR "#  edge from '$edge->{from}->{name}' to '$edge->{to}->{name}' shares end port with ",
	scalar @shared, " other edge(s)\n" if $self->{debug};

    # if there is one of the already-placed edges running alongside the src
    # node, we can just convert the field to a joint and be done
    my $path = $self->_join_edge($src,$edge,\@shared);
    return $path if $path;				# already done?

    @B = $self->_get_joints(\@shared, EDGE_START_MASK, $joint_type_end, $end_cells, $prev_fields);
    }
  else
    {
    # potential stop positions
    @B = $dst->_near_places($cells, 1, $end_flags, 1);	# distance = 1: slots

    # the edge has a port description, limiting the end places
    @B = $dst->_allowed_places( \@B, $dst->_allow( $e_p, @ee_p ), 3)
      if defined $e_p;

    $per_field = 3;			# x,y,type