libgraph-easy-perl 0.76-1 / usr / share / perl5 / Graph / Easy / Edge.pm

#############################################################################
# An edge connecting two nodes in Graph::Easy.
#
#############################################################################

package Graph::Easy::Edge;

use Graph::Easy::Node;
@ISA = qw/Graph::Easy::Node/;		# an edge is just a special node
$VERSION = '0.76';

use strict;
use warnings;

use constant isa_cell => 1;

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

sub _init
  {
  # generic init, override in subclasses
  my ($self,$args) = @_;

  $self->{class} = 'edge';

  # leave this unitialized until we need it
  # $self->{cells} = [ ];

  foreach my $k (sort keys %$args)
    {
    if ($k !~ /^(label|name|style)\z/)
      {
      require Carp;
      Carp::confess ("Invalid argument '$k' passed to Graph::Easy::Node->new()");
      }
    my $n = $k; $n = 'label' if $k eq 'name';

    $self->{att}->{$n} = $args->{$k};
    }

  $self;
  }

#############################################################################
# accessor methods

sub bidirectional
  {
  my $self = shift;

  if (@_ > 0)
    {
    my $old = $self->{bidirectional} || 0;
    $self->{bidirectional} = $_[0] ? 1 : 0;

    # invalidate layout?
    $self->{graph}->{score} = undef if $old != $self->{bidirectional} && ref($self->{graph});
    }

  $self->{bidirectional};
  }

sub undirected
  {
  my $self = shift;

  if (@_ > 0)
    {
    my $old = $self->{undirected} || 0;
    $self->{undirected} = $_[0] ? 1 : 0;

    # invalidate layout?
    $self->{graph}->{score} = undef if $old != $self->{undirected} && ref($self->{graph});
    }

  $self->{undirected};
  }

sub has_ports
  {
  my $self = shift;

  my $s_port = $self->{att}->{start} || $self->attribute('start');

  return 1 if $s_port ne '';

  my $e_port = $self->{att}->{end} || $self->attribute('end');

  return 1 if $e_port ne '';

  0;
  }

sub start_port
  {
  # return the side and portnumber if the edge has a shared source port
  # undef for none
  my $self = shift;

  my $s = $self->{att}->{start} || $self->attribute('start');
  return undef if !defined $s || $s !~ /,/;	# "south, 0" => ok, "south" => no

  return (split /\s*,\s*/, $s) if wantarray;

  $s =~ s/\s+//g;		# remove spaces to normalize "south, 0" to "south,0"
  $s;
  }

sub end_port
  {
  # return the side and portnumber if the edge has a shared source port
  # undef for none
  my $self = shift;

  my $s = $self->{att}->{end} || $self->attribute('end');
  return undef if !defined $s || $s !~ /,/;	# "south, 0" => ok, "south" => no

  return split /\s*,\s*/, $s if wantarray;

  $s =~ s/\s+//g;		# remove spaces to normalize "south, 0" to "south,0"
  $s;
  }

sub style
  {
  my $self = shift;

  $self->{att}->{style} || $self->attribute('style');
  }

sub name
  {
  # returns actually the label
  my $self = shift;

  $self->{att}->{label} || '';
  }

#############################################################################
# cell management - used by the cell-based layouter

sub _cells
  {
  # return all the cells this edge currently occupies
  my $self = shift;

  $self->{cells} = [] unless defined $self->{cells};

  @{$self->{cells}};
  }

sub _clear_cells
  {
  # remove all belonging cells
  my $self = shift;

  $self->{cells} = [];

  $self;
  }

sub _unplace
  {
  # Take an edge, and remove all the cells it covers from the cells area
  my ($self, $cells) = @_;

  print STDERR "# clearing path from $self->{from}->{name} to $self->{to}->{name}\n" if $self->{debug};

  for my $key (@{$self->{cells}})
    {
    # XXX TODO: handle crossed edges differently (from CROSS => HOR or VER)
    # free in our cells area
    delete $cells->{$key};
    }

  $self->clear_cells();

  $self;
  }

sub _distance
  {
  # estimate the distance from SRC to DST node
  my ($self) = @_;

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

  # one of them not yet placed?
  return 100000 unless defined $src->{x} && defined $dst->{x};

  my $cells = $self->{graph}->{cells};

  # get all the starting positions
  # distance = 1: slots, generate starting types, the direction is shifted
  # by 90° counter-clockwise

  my @start = $src->_near_places($cells, 1, undef, undef, $src->_shift(-90) );

  # potential stop positions
  my @stop = $dst->_near_places($cells, 1);		# distance = 1: slots

  my ($s_p,@ss_p) = $self->port('start');
  my ($e_p,@ee_p) = $self->port('end');

  # the edge has a port description, limiting the start places
  @start = $src->_allowed_places( \@start, $src->_allow( $s_p, @ss_p ), 3)
    if defined $s_p;

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

  my $stop = scalar @stop;

  return 0 unless @stop > 0 && @start > 0;	# no free slots on one node?

  my $lowest;

  my $i = 0;
  while ($i < scalar @start)
    {
    my $sx = $start[$i]; my $sy = $start[$i+1]; $i += 2;

    # for each start point, calculate the distance to each stop point, then use
    # the smallest as value

    for (my $u = 0; $u < $stop; $u += 2)
      {
      my $dist = Graph::Easy::_astar_distance($sx,$sy, $stop[$u], $stop[$u+1]);
      $lowest = $dist if !defined $lowest || $dist < $lowest;
      }
    }

  $lowest;
  }

sub _add_cell
  {
  # add a cell to the list of cells this edge covers. If $after is a ref
  # to a cell, then the new cell will be inserted right after this cell.
  # if after is defined, but not a ref, the new cell will be inserted
  # at the specified position.
  my ($self, $cell, $after, $before) = @_;

  $self->{cells} = [] unless defined $self->{cells};
  my $cells = $self->{cells};

  # if both are defined, but belong to different edges, just ignore $before:
  $before = undef if ref($before) && $before->{edge} != $self;
  $after = undef if ref($after) && $after->{edge} != $self;
  if (!defined $after && ref($before))
    {
    $after = $before; $before = undef;
    }

  if (defined $after)
    {
    # insert the new cell right after $after
    my $ofs = $after;
    if (ref($after) && !ref($before))
      {
      # insert after $after
      $ofs = 1;
      for my $cell (@$cells)
        {
        last if $cell == $after;
        $ofs++;
        }
      }
    elsif (ref($after) && ref($before))
      {
      # insert between after and before (or before/after for "reversed edges)
      $ofs = 0;
      my $found = 0;
      while ($ofs < scalar @$cells - 1)		# 0,1,2,3 => 0 .. 2
        {
        my $c1 = $cells->[$ofs];
        my $c2 = $cells->[$ofs+1];
	$ofs++;
        $found++, last if (($c1 == $after && $c2 == $before) ||
                 ($c1 == $before && $c2 == $after));
        }
      if (!$found)
	{
        # XXX TODO: last effort

        # insert after $after
        $ofs = 1;
        for my $cell (@$cells)
          {
          last if $cell == $after;
          $ofs++;
          }
        $found++;
	}
      $self->_croak("Could not find $after and $before") unless $found;
      }
    splice (@$cells, $ofs, 0, $cell);
    }
  else
    {
    # insert new cell at the end
    push @$cells, $cell;
    }

  $cell->_update_boundaries();

  $self;
  }

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

sub from
  {
  my $self = shift;

  $self->{from};
  }

sub to
  {
  my $self = shift;

  $self->{to};
  }

sub nodes
  {
  my $self = shift;

  ($self->{from}, $self->{to});
  }

sub start_at
  {
  # move the edge's start point from the current node to the given node
  my ($self, $node) = @_;

  # if not a node yet, or not part of this graph, make into one proper node
  $node = $self->{graph}->add_node($node);

  $self->_croak("start_at() needs a node object, but got $node")
    unless ref($node) && $node->isa('Graph::Easy::Node');

  # A => A => nothing to do
  return $node if $self->{from} == $node;

  # delete self at A
  delete $self->{from}->{edges}->{ $self->{id} };

  # set "from" to B
  $self->{from} = $node;

  # add to B
  $self->{from}->{edges}->{ $self->{id} } = $self;

  # invalidate layout
  $self->{graph}->{score} = undef if ref($self->{graph});

  # return new start point
  $node;
  }

sub end_at
  {
  # move the edge's end point from the current node to the given node
  my ($self, $node) = @_;

  # if not a node yet, or not part of this graph, make into one proper node
  $node = $self->{graph}->add_node($node);

  $self->_croak("start_at() needs a node object, but got $node")
    unless ref($node) && $node->isa('Graph::Easy::Node');

  # A => A => nothing to do
  return $node if $self->{to} == $node;

  # delete self at A
  delete $self->{to}->{edges}->{ $self->{id} };

  # set "to" to B
  $self->{to} = $node;

  # add to node B
  $self->{to}->{edges}->{ $self->{id} } = $self;

  # invalidate layout
  $self->{graph}->{score} = undef if ref($self->{graph});

  # return new end point
  $node;
  }

sub edge_flow
  {
  # return the flow at this edge  or '' if the edge itself doesn't have a flow
  my $self = shift;

  # our flow comes from ourselves
  my $flow = $self->{att}->{flow};
  $flow = $self->raw_attribute('flow') unless defined $flow;

  $flow;
  }

sub flow
  {
  # return the flow at this edge (including inheriting flow from node)
  my ($self) = @_;

  # print STDERR "# flow from $self->{from}->{name} to $self->{to}->{name}\n";

  # our flow comes from ourselves
  my $flow = $self->{att}->{flow};
  # or maybe our class
  $flow = $self->raw_attribute('flow') unless defined $flow;

  # if the edge doesn't have a flow, maybe the node has a default out flow
  $flow = $self->{from}->{att}->{flow} if !defined $flow;

  # if that didn't work out either, use the parents flows
  $flow = $self->parent()->attribute('flow') if !defined $flow;
  # or finally, the default "east":
  $flow = 90 if !defined $flow;

  # absolute flow does not depend on the in-flow, so can return early
  return $flow if $flow =~ /^(0|90|180|270)\z/;

  # in-flow comes from our "from" node
  my $in = $self->{from}->flow();

# print STDERR "# in: $self->{from}->{name} = $in\n";

  my $out = $self->{graph}->_flow_as_direction($in,$flow);
  $out;
  }

sub port
  {
  my ($self, $which) = @_;

  $self->_croak("'$which' must be one of 'start' or 'end' in port()") unless $which =~ /^(start|end)/;

  # our flow comes from ourselves
  my $sp = $self->attribute($which);

  return (undef,undef) unless defined $sp && $sp ne '';

  my ($side, $port) = split /\s*,\s*/, $sp;

  # if absolut direction, return as is
  my $s = Graph::Easy->_direction_as_side($side);

  if (defined $s)
    {
    my @rc = ($s); push @rc, $port if defined $port;
    return @rc;
    }

  # in_flow comes from our "from" node
  my $in = 90; $in = $self->{from}->flow() if ref($self->{from});

  # turn left in "south" etc:
  $s = Graph::Easy->_flow_as_side($in,$side);

  my @rc = ($s); push @rc, $port if defined $port;
  @rc;
  }

sub flip
  {
  # swap from and to for this edge
  my ($self) = @_;

  ($self->{from}, $self->{to}) = ($self->{to}, $self->{from});

  # invalidate layout
  $self->{graph}->{score} = undef if ref($self->{graph});

  $self;
  }

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

  # invisible nodes, or very small ones
  return '' if $self->{w} == 0 || $self->{h} == 0;

  my $fb = $self->_framebuffer($self->{w}, $self->{h});

  ###########################################################################
  # "draw" the label into the framebuffer (e.g. the edge and the text)
  $self->_draw_label($fb, $x, $y, '');

  join ("\n", @$fb);
  }

sub as_txt
  {
  require Graph::Easy::As_ascii;

  _as_txt(@_);
  }

1;
__END__

=head1 NAME

Graph::Easy::Edge - An edge (a path connecting one ore more nodes)

=head1 SYNOPSIS

        use Graph::Easy;

	my $ssl = Graph::Easy::Edge->new(
		label => 'encrypted connection',
		style => 'solid',
	);
	$ssl->set_attribute('color', 'red');

	my $src = Graph::Easy::Node->new('source');

	my $dst = Graph::Easy::Node->new('destination');

	$graph = Graph::Easy->new();

	$graph->add_edge($src, $dst, $ssl);

	print $graph->as_ascii();

=head1 DESCRIPTION

A C<Graph::Easy::Edge> represents an edge between two (or more) nodes in a
simple graph.

Each edge has a direction (from source to destination, or back and forth),
plus a style (line width and style), colors etc. It can also have a label,
e.g. a text associated with it.

During the layout phase, each edge also contains a list of path-elements
(also called cells), which make up the path from source to destination.

=head1 METHODS

=head2 error()

	$last_error = $edge->error();

	$cvt->error($error);			# set new messages
	$cvt->error('');			# clear error

Returns the last error message, or '' for no error.

=head2 as_ascii()

	my $ascii = $edge->as_ascii();

Returns the edge as a little ascii representation.

=head2 as_txt()

	my $txt = $edge->as_txt();

Returns the edge as a little Graph::Easy textual representation.

=head2 label()

	my $label = $edge->label();

Returns the label (also known as 'name') of the edge.

=head2 name()

	my $label = $edge->name();

To make the interface more consistent, the C<name()> method of
an edge can also be called, and it will returned either the edge
label, or the empty string if the edge doesn't have a label.

=head2 style()

	my $style = $edge->style();

Returns the style of the edge, like 'solid', 'dotted', 'double', etc.

=head2 nodes()

	my @nodes = $edge->nodes();

Returns the source and target node that this edges connects as objects.

=head2 bidirectional()

	$edge->bidirectional(1);
	if ($edge->bidirectional())
	  {
	  }

Returns true if the edge is bidirectional, aka has arrow heads on both ends.
An optional parameter will set the bidirectional status of the edge.

=head2 undirected()

	$edge->undirected(1);
	if ($edge->undirected())
	  {
	  }

Returns true if the edge is undirected, aka has now arrow at all.
An optional parameter will set the undirected status of the edge.

=head2 has_ports()

	if ($edge->has_ports())
	  {
	  ...
	  }

Return true if the edge has restriction on the starting or ending
port, e.g. either the C<start> or C<end> attribute is set on
this edge.

=head2 start_port()

	my $port = $edge->start_port();

Return undef if the edge does not have a fixed start port, otherwise
returns the port as "side, number", for example "south, 0".

=head2 end_port()

	my $port = $edge->end_port();

Return undef if the edge does not have a fixed end port, otherwise
returns the port as "side, number", for example "south, 0".

=head2 from()

	my $from = $edge->from();

Returns the node that this edge starts at. See also C<to()>.

=head2 to()

	my $to = $edge->to();

Returns the node that this edge leads to. See also C<from()>.

=head2 start_at()

	$edge->start_at($other);
	my $other = $edge->start_at('some node');

Set the edge's start point to the given node. If given a node name,
will add that node to the graph first.

Returns the new edge start point node.

=head2 end_at()

	$edge->end_at($other);
	my $other = $edge->end_at('some other node');

Set the edge's end point to the given node. If given a node name,
will add that node to the graph first.

Returns the new edge end point node.

=head2 flip()

	$edge->flip();

Swaps the C<start> and C<end> nodes on this edge, e.g. reverses the direction
of the edge.

X<transpose>

=head2 flow()

	my $flow = $edge->flow();

Returns the flow for this edge, honoring inheritance. An edge without
a specific flow set will inherit the flow from the node it comes from.

=head2 edge_flow()

	my $flow = $edge->edge_flow();

Returns the flow for this edge, or undef if it has none set on either
the object itself or its class.

=head2 port()

	my ($side, $number) = $edge->port('start');
	my ($side, $number) = $edge->port('end');

Return the side and port number where this edge starts or ends.

Returns undef for $side if the edge has no port restriction. The
returned side will be one absolute direction of C<east>, C<west>,
C<north> or C<south>, depending on the port restriction and
flow at that edge.

=head2 get_attributes()

        my $att = $object->get_attributes();

Return all effective attributes on this object (graph/node/group/edge) as
an anonymous hash ref. This respects inheritance and default values.

See also L<raw_attributes()>.

=head2 raw_attributes()

        my $att = $object->get_attributes();

Return all set attributes on this object (graph/node/group/edge) as
an anonymous hash ref. This respects inheritance, but does not include
default values for unset attributes.

See also L<get_attributes()>.

=head2 attribute related methods

You can call all the various attribute related methods like C<set_attribute()>,
C<get_attribute()>, etc. on an edge, too. For example:

	$edge->set_attribute('label', 'by train');
	my $attr = $edge->get_attributes();
	my $raw_attr = $edge->raw_attributes();

You can find more documentation in L<Graph::Easy>.

=head1 EXPORT

None by default.

=head1 SEE ALSO

L<Graph::Easy>.

=head1 AUTHOR

Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>.

See the LICENSE file for more details.

=cut