various things; headline change is reworking of node positions

[scpubgit/stemmatology.git] / lib / Text / Tradition / Collation / Segment.pm

diff --git a/lib/Text/Tradition/Collation/Segment.pm b/lib/Text/Tradition/Collation/Segment.pm
index b3a6204..ddfec9e 100644 (file)
--- a/lib/Text/Tradition/Collation/Segment.pm
+++ b/lib/Text/Tradition/Collation/Segment.pm
@@ -2,6 +2,7 @@ package Text::Tradition::Collation::Segment;
 
 use Moose;
 use MooseX::NonMoose;
+use Text::Tradition::Collation::Position;
 
 extends 'Graph::Easy::Node';
 
@@ -15,6 +16,12 @@ has 'members' => (
     required => 1,
 );
 
+has 'position' => (
+    is => 'rw',
+    isa => 'Text::Tradition::Collation::Position',
+    predicate => 'has_position',
+);
+
 sub FOREIGNBUILDARGS {
     my $class = shift;
     my %args = @_;
@@ -27,17 +34,63 @@ sub FOREIGNBUILDARGS {
 sub BUILD {
     my( $self, $args ) = @_;
     $self->set_attribute( 'class', 'segment' );
+    my $ctr = 1;
+    foreach my $r ( @{$args->{members}} ) {
+        my $seg_edge = $r->parent->add_edge( $r, $self, $ctr++ );
+        $seg_edge->set_attribute( 'class', 'segment' );
+    }
+    unless ( grep { !$_->has_position } @{$args->{members}} ) {
+        $self->set_position;
+    }
+}
 
+# We use our 'members' array for the initialization, but afterward we
+# go by graph edges.  This ensures that merged nodes stay merged.
+around 'members' => sub {
+    my $orig = shift;
+    my $self = shift;
+    my @members;
+    foreach my $sl ( sort { $a->name <=> $b->name } 
+                     grep { $_->sub_class eq 'segment' } $self->incoming ) {
+        push( @members, $sl->from );
+    }
+    return \@members;
+};
+
+sub set_position {
+    my $self = shift;
+    my( $common, $min, $max );
+    my $readings = $self->members;
     foreach my $r ( @{$self->members} ) {
-       my $seg_edge = $r->parent->add_edge( $r, $self, 'segment' );
-       $seg_edge->set_attribute( 'class', 'segment' );
+        if( $r->has_position ) {
+            if( $common && $common != $r->position->common ) {
+                warn "Segment adding node with position skew";
+            } elsif( !$common ) {
+                $common = $r->position->common;
+            }
+            $min = $r->position->min unless $min && $min < $r->position->min;
+            $max = $r->position->max unless $max && $max > $r->position->max;
+        } else {
+            warn "Called set_position on segment which has an unpositioned reading";
+        }
     }
+    $self->position( Text::Tradition::Collation::Position->new( 
+        common => $common, min => $min, max => $max
+        ) );
 }
-
-# For now, a segment has no position in the graph.  Eventually it might
-# have the position of its first member.
-sub has_position {
-    return undef;
+sub neighbor_readings {
+    my( $self, $direction ) = @_;
+    $direction = 'both' unless $direction;
+    my @answer;
+    if( $direction !~ /^back/ ) {
+        # We want forward readings.
+        push( @answer, $self->members->[0]->neighbor_readings( 'forward' ) );
+    }
+    if( $direction ne 'forward' ) {
+        # We want backward readings.
+        push( @answer, $self->members->[0]->neighbor_readings( 'back' ) );
+    }
+    return @answer;
 }
 
 no Moose;