From: Tara L Andrews <tla@mit.edu>
Date: Thu, 7 May 2015 10:22:16 +0000 (+0200)
Subject: Add a direction attribute to a collation for its graph display. Fixes #40
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d1afb4b5ef78eccbdbc4b92487811e843046bbbf;p=scpubgit%2Fstemmatology.git

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
--- 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
--- 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
--- 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
--- 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
--- 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