added arrows to BGB

git-svn-id: http://biopieces.googlecode.com/svn/trunk@872 74ccb610-7750-0410-82ae-013aeee3265d

diff --git a/code_perl/Maasha/BGB/Draw.pm b/code_perl/Maasha/BGB/Draw.pm
index ab4498f53823ce8e97b55799eec63130f7d738b9..f3dd63dd00902192558dfd68b61ae16e9af9c51e 100644 (file)
--- a/code_perl/Maasha/BGB/Draw.pm
+++ b/code_perl/Maasha/BGB/Draw.pm
@@ -69,6 +69,18 @@ sub draw_feature
             $cr->move_to( $feature->{ 'x1' }, $feature->{ 'y1' } );
             $cr->line_to( $feature->{ 'x2' }, $feature->{ 'y2' } );
         }
+        elsif ( $feature->{ 'type' } eq 'arrow' )
+        {
+            draw_arrow_horizontal(
+                $cr,
+                $feature->{ 'x1' },
+                $feature->{ 'y1' },
+                $feature->{ 'x2' },
+                $feature->{ 'y2' },
+                $feature->{ 'strand' },
+            );
+
+        }
         elsif ( $feature->{ 'type' } eq 'rect' )
         {
             $cr->rectangle(
@@ -92,6 +104,71 @@ sub draw_feature
 }
 
 
+sub draw_arrow_horizontal
+{
+    # Draws a horizontal arraw that
+    # consists of a shaft and arrow head.
+
+    my ( $cr,   # Cairo::Context object
+         $x1,
+         $y1,
+         $x2,
+         $y2,
+         $strand,
+       ) = @_;
+
+    # Returns nothing.
+
+    my ( $x_diff, $y_diff, $mid, $width, $s_width );
+
+    $x_diff = abs( $x2 - $x1 );
+    $y_diff = abs( $y2 - $y1 );
+
+    $mid = $y_diff / 2;
+
+    if ( $x_diff < $mid ) {
+        $width = $x_diff;
+    } else {
+        $width = $mid;
+    }
+
+    # Draw arrow head
+
+    $cr->set_line_width( 1 );
+
+    if ( $strand eq '+' )
+    {
+        $cr->move_to( $x2 - $width, $y1 );
+        $cr->line_to( $x2, $y1 + $mid );
+        $cr->line_to( $x2 - $width, $y2 );
+    }
+    else
+    {
+        $cr->move_to( $x1 + $width, $y1 );
+        $cr->line_to( $x1, $y1 + $mid );
+        $cr->line_to( $x1 + $width, $y2 );
+    }
+    
+    $cr->close_path;
+    $cr->fill_preserve;
+    $cr->stroke;
+
+    # Draw arrow shaft
+
+    if ( $x_diff > $mid )
+    {
+        if ( $strand eq '+' ) {
+            $cr->rectangle( $x1, $y1, ( $x2 - $width ) - $x1, $y2 - $y1 );    
+        } else {
+            $cr->rectangle( $x1 + $width, $y1, $x2 - ( $x1 + $width ), $y2 - $y1 );    
+        }
+
+        $cr->fill_preserve;
+        $cr->stroke;
+    }
+}
+
+
 sub palette
 {
     # Martin A. Hansen, November 2009.

diff --git a/code_perl/Maasha/BGB/Track.pm b/code_perl/Maasha/BGB/Track.pm
index 7376d47c30c980a850b22d47bdcfcedfafacb83f..0b3531d2ca9ce2cf7d57fda51924b74e59340153 100644 (file)
--- a/code_perl/Maasha/BGB/Track.pm
+++ b/code_perl/Maasha/BGB/Track.pm
@@ -228,9 +228,7 @@ sub track_feature_linear
 
     # Returns a list.
     
-    my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, @features );
-
-    # @{ $entries } = sort { $a->[ S_BEG ] <=> $b->[ S_BEG ] or $b->[ S_END ] <=> $a->[ S_END ] } @{ $entries };
+    my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, $feature, @features );
 
     $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
     $y_step = 0;
@@ -250,11 +248,10 @@ sub track_feature_linear
 
             $y1 = $cookie->{ 'TRACK_OFFSET' } + ( ( 0.1 + $cookie->{ 'FEAT_WIDTH' } ) * $y_step );
 
-            push @features, {
-                type       => 'rect',
+            $feature = {
                 line_width => $cookie->{ 'FEAT_WIDTH' },
                 color      => $cookie->{ 'FEAT_COLOR' },
-                title      => "Q_ID: $entry->[ Q_ID ] S_BEG: $entry->[ S_BEG ] S_END: $entry->[ S_END ] STRAND: $entry->[ STRAND ]",
+                title      => "Q_ID: $entry->[ Q_ID ] S_BEG: $entry->[ S_BEG ] S_END: $entry->[ S_END ]",
                 q_id       => $entry->[ Q_ID ],
                 s_beg      => $entry->[ S_BEG ],
                 s_end      => $entry->[ S_END ],
@@ -265,6 +262,14 @@ sub track_feature_linear
                 y2         => $y1 + $cookie->{ 'FEAT_WIDTH' },
             };
 
+            if ( $entry->[ STRAND ] eq '+' or $entry->[ STRAND ] eq '-' ) {
+                $feature->{ 'type' } = 'arrow';
+            } else {
+                $feature->{ 'type' } = 'rect';
+            }
+
+            push @features, $feature;
+
             $y_max = Maasha::Calc::max( $y_max, $y_step * ( 0.1 + $cookie->{ 'FEAT_WIDTH' } ) );
 
             push @features, feature_align( $entry, $beg, $y1, $factor, $cookie->{ 'FEAT_WIDTH' } ) if $entry->[ ALIGN ] ne '.';