Add a direction attribute to a collation for its graph display. Fixes #40

diff --git a/base/lib/Text/Tradition/Collation.pm b/base/lib/Text/Tradition/Collation.pm
index 08ac94f..9fa832a 100644 (file)
--- a/base/lib/Text/Tradition/Collation.pm
+++ b/base/lib/Text/Tradition/Collation.pm
@@ -46,6 +46,7 @@ has _data => (
                baselabel
                linear
                wordsep
+               direction
                start
                end
                cached_table
@@ -213,7 +214,7 @@ sub BUILDARGS {
        my %args = @args == 1 ? %{ $args[0] } : @args;
        # TODO determine these from the Moose::Meta object
        my @delegate_attrs = qw(sequence relations readings wit_list_separator baselabel 
-               linear wordsep start end cached_table _graphcalc_done);
+               linear wordsep direction start end cached_table _graphcalc_done);
        my %data_args;
        for my $attr (@delegate_attrs) {
                $data_args{$attr} = delete $args{$attr} if exists $args{$attr};
@@ -1038,9 +1039,11 @@ sub as_dot {
     $graph_name = join( '_', split( /\s+/, $graph_name ) );
 
     my %graph_attrs = (
-       'rankdir' => 'LR',
        'bgcolor' => 'none',
        );
+    unless( $self->direction eq 'BI' ) {
+       $graph_attrs{rankdir} = $self->direction;
+    }
     my %node_attrs = (
        'fontsize' => 14,
        'fillcolor' => 'white',

diff --git a/base/lib/Text/Tradition/Collation/Data.pm b/base/lib/Text/Tradition/Collation/Data.pm
index 88a5c9b..ecea870 100644 (file)
--- a/base/lib/Text/Tradition/Collation/Data.pm
+++ b/base/lib/Text/Tradition/Collation/Data.pm
@@ -1,6 +1,7 @@
 package Text::Tradition::Collation::Data;
 use Moose;
 use Graph;
+use Text::Tradition::Datatypes;
 
 has 'sequence' => (
     is => 'ro',
@@ -69,6 +70,13 @@ has 'wordsep' => (
        isa => 'Str',
        default => ' ',
        );
+       
+has 'direction' => (
+       is => 'ro',
+       isa => 'TextDirection', 
+       default => 'LR',
+       writer => 'change_direction',
+       );
     
 has 'start' => (
        is => 'ro',

diff --git a/base/lib/Text/Tradition/Datatypes.pm b/base/lib/Text/Tradition/Datatypes.pm
index 50ed1a1..9b21578 100644 (file)
--- a/base/lib/Text/Tradition/Datatypes.pm
+++ b/base/lib/Text/Tradition/Datatypes.pm
@@ -7,6 +7,8 @@ enum 'Ternary' => [ qw( yes maybe no ) ];
 
 enum 'RelationshipScope' => [ qw( local document global ) ];
 
+enum 'TextDirection' => [ qw( LR RL BI ) ];
+
 subtype 'ReadingID',
        as 'Str',
        where { $_ =~ /\A$xml10_name_rx\z/ },

diff --git a/base/script/make_tradition.pl b/base/script/make_tradition.pl
index 4ebfa39..c90075b 100755 (executable)
--- a/base/script/make_tradition.pl
+++ b/base/script/make_tradition.pl
@@ -1,6 +1,6 @@
 #!/usr/bin/env perl
 
-use lib 'lib';
+#use lib 'lib';
 use strict;
 use warnings;
 use Getopt::Long;

diff --git a/base/t/graph.t b/base/t/graph.t
index f580465..73a80fc 100644 (file)
--- a/base/t/graph.t
+++ b/base/t/graph.t
@@ -2,7 +2,6 @@
 
 use strict; use warnings;
 use Test::More;
-use lib 'lib';
 use File::Which;
 use Text::Tradition;
 use XML::LibXML;
@@ -71,6 +70,43 @@ is( scalar( @svg_nodes ), 7,
 is( scalar( @svg_edges ), 7,
        "Correct number of edges in the subgraph" );
 
+# Test a right-to-left graph
+my $arabic = Text::Tradition->new(
+       input => 'Tabular',
+       sep_char => ',',
+       name => 'arabic',
+       direction => 'RL',
+       file => 't/data/arabic_snippet.csv' );
+my $rl_svg = $parser->parse_string( $arabic->collation->as_svg() );
+is( $rl_svg->documentElement->nodeName(), 'svg', "Got an svg subgraph from start" );
+my $rl_xpc = XML::LibXML::XPathContext->new( $rl_svg->documentElement() );
+$rl_xpc->registerNs( 'svg', 'http://www.w3.org/2000/svg' );
+my %node_cx;
+foreach my $node ( $rl_xpc->findnodes( '//svg:g[@class="node"]' ) ) {
+       my $nid = $node->getAttribute('id');
+       $node_cx{$nid} = $rl_xpc->findvalue( './svg:ellipse/@cx', $node );
+}
+my @sorted = sort { $node_cx{$a} <=> $node_cx{$b} } keys( %node_cx );
+is( $sorted[0], '__END__', "End node is the leftmost" );
+is( $sorted[$#sorted], '__START__', "Start node is the rightmost" );
+
+=note 
+
+<g id="__END__" class="node"><title>__END__</title>
+<ellipse fill="white" stroke="black" cx="38.3466" cy="-47" rx="38.1938" ry="18"/>
+<text text-anchor="middle" x="38.3466" y="-43.3" font-family="Times,serif" font-size="14.00">#END#</text>
+</g>
+
+<g id="__START__" class="node"><title>__START__</title>
+<ellipse fill="white" stroke="black" cx="1366.52" cy="-47" rx="48.9926" ry="18"/
+>
+<text text-anchor="middle" x="1366.52" y="-43.3" font-family="Times,serif" font-
+size="14.00">#START#</text>
+</g>
+
+=cut
+
+
 SKIP: {
        skip "lemmatization disabled for now", 1;
        # Test for the correct common nodes