www relayout

[biopieces.git] / code_perl / Maasha / KISS / Draw.pm

diff --git a/code_perl/Maasha/KISS/Draw.pm b/code_perl/Maasha/KISS/Draw.pm
index 100b330e3e320278b5c38fec6d98c3aba40070d9..e9ae40e5f167995e29079d080644aa8a8f799798 100644 (file)
--- a/code_perl/Maasha/KISS/Draw.pm
+++ b/code_perl/Maasha/KISS/Draw.pm
@@ -22,7 +22,7 @@ package Maasha::KISS::Draw;
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
 
-# Routines for creating KISS graphics.
+# Routines for creating KISS graphics using Cairo and Pango.
 
 
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -31,7 +31,8 @@ package Maasha::KISS::Draw;
 use warnings;
 use strict;
 use Data::Dumper;
-use SVG;
+use Cairo;
+use Pango;
 
 use vars qw( @ISA @EXPORT );
 
@@ -41,196 +42,65 @@ use vars qw( @ISA @EXPORT );
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
 
-sub svg_init
+sub draw_feature
 {
-    # Martin A. Hansen, October 2005.
-
-    # inititalizes SVG object, which is returned.
-
-    my ( $height,   # Height in pixels
-         $width,    # Width in pixels
-       ) = @_;
-
-    my $svg;
-
-    $svg = SVG->new(
-        id          => 'KISS',
-        height      => $height,
-        width       => $width,
-    );
-
-    return $svg;
-}
-
-
-sub svg_frame
-{
-    # Martin A. Hansen, October 2009.
-
-    # Adds a top level layer frame of given
-    # height and width to an SVG object.
-
-    my ( $height,   # Height in pixels
-         $width,    # Width in pixels
-         $svg,      # SVG objact
-       ) = @_;
-
-    # Returns nothing.
-
-    my ( $frame );
-
-    $frame = $svg->group(
-        id => 'GROUP_FRAME',
-    );
-
-    $frame->rectangle(
-        id     => 'FRAME',
-        x      => 0,
-        y      => 0,
-        width  => $width,
-        height => $height,
-        rx     => 10,
-        ry     => 10,
-        style  => {
-            fill           => 'none',
-            'stroke'       => 'red',
-            'stroke-width' => 3,
-        }
-    );
-}
-
-
-sub svg_track_dna
-{
-    # Martin A. Hansen, October 2009.
-
-    # Given a DNA sequence as a list add a string
-    # of chars to a SVG object.
-
-    my ( $width,   # width
-         $svg,     # SVG object
-         $dna,
-       ) = @_;
-
-    # Returns nothing.
-
-    my ( $track );
-
-    $dna = 'GAACGACGAGCATCAGCGGACACTACATCATATACTACATC';
-
-    $track = $svg->group(
-        id => 'TRACK_DNA',
-        style => {
-         #   'stroke-width' => 5,
-         #   stroke         => 'black',   # TODO can this be removed?
-            'font-family'       => 'Courier New',
-            'font-size'         => '15px',
-            'letter-spacing'    => '15',
-        }
-    );
-
-    $track->text(
-        id => 'DNA',
-        x  => 0,
-        y  => 20,
-        -cdata => $dna,
-    );
-}
-
-
-sub svg_track_feature
-{
-    # Martin A. Hansen, October 2009.
-
     # Given a list of features add these to
-    # a SVG object.
+    # a Cairo::Context object.
 
-    my ( $height,     # Height in pixels
-         $width,      # Width in pixels
-         $svg,        # SVG object
+    my ( $cr,         # Cairo::Context object
          $features,   # List of features
-         $track_id,   # Unique track id
-         $color,      # Color of features 
        ) = @_;
 
     # Returns nothing.
 
-    my ( $track, $i, $id, $x, $y, $w, $h );
-
-    $track = $svg->group(
-        id => $track_id,
-        style => {
-            'stroke-width' => 5,
-            stroke         => $color,
-        }
-    );
+    my ( $feature );
 
-    for ( $i = 0; $i < @{ $features }; $i++ )
+    foreach $feature ( @{ $features } )
     {
-        $id = "FEAT_$i";
-        $x  = $features->[ $i ]->{ 'x' };
-        $y  = $features->[ $i ]->{ 'y' };
-        $h  = $features->[ $i ]->{ 'height' };
-        $w  = $features->[ $i ]->{ 'width' };
-
-        # $track->rectangle( id => $id, x => $x, y => $y, width => $w, height => $h );
-
-        $track->line( id => $id, x1 => $x, y1 => $y, x2 => $x + $w, y2 => $y );
-    }
-}
+        $cr->set_source_rgb( @{ $feature->{ 'color' } } );
 
-
-sub svg_track_histogram
-{
-    # Given a list of features add these to
-    # a SVG object.
-
-    my ( $svg,        # SVG object
-         $features,   # List of features
-         $track_id,   # Unique track id
-         $color,      # Color of features 
-       ) = @_;
-
-    # Returns nothing.
-
-    my ( $track, $i );
-
-    $track = $svg->group(
-        id => $track_id,
-        style => {
-            'stroke-width' => 5,
-            stroke         => $color,
+        if ( $feature->{ 'type' } eq 'line' )
+        {
+            $cr->set_line_width( $feature->{ 'line_width' } );
+            $cr->move_to( $feature->{ 'x1' }, $feature->{ 'y1' } );
+            $cr->line_to( $feature->{ 'x2' }, $feature->{ 'y2' } );
+        }
+        elsif ( $feature->{ 'type' } eq 'rect' )
+        {
+            $cr->rectangle(
+                $feature->{ 'x1' },
+                $feature->{ 'y1' },
+                $feature->{ 'x2' } - $feature->{ 'x1' },
+                $feature->{ 'y2' } - $feature->{ 'y1' },
+            );
+
+            $cr->fill;
+        }
+        elsif ( $feature->{ 'type' } eq 'text' )
+        {
+            $cr->move_to( $feature->{ 'x1' }, $feature->{ 'y1' } );
+            $cr->set_font_size( $feature->{ 'font_size' } );
+            $cr->show_text( $feature->{ 'txt' } );
         }
-    );
 
-    for ( $i = 0; $i < @{ $features }; $i++ )
-    {
-        $track->line(
-            id => "HIST_$i",
-            x1 => $features->[ $i ]->{ 'x1' },
-            y1 => $features->[ $i ]->{ 'y1' },
-            x2 => $features->[ $i ]->{ 'x2' },
-            y2 => $features->[ $i ]->{ 'y2' },
-        );
+        $cr->stroke;
     }
 }
 
 
-sub svg_print
+sub file_png
 {
     # Martin A. Hansen, October 2009.
 
-    # Prints XML output from a SVG object.
+    # Prints a Cairo::Surface object to a PNG file.
 
-    my ( $svg,   # SVG object
-         $fh,    # file handle  -  OPTIONAL
+    my ( $surface,   # Cairo::Surface object
+         $file,      # path to PNG file
        ) = @_;
 
     # Returns nothing
 
-    $fh ||= \*STDOUT;
-
-    print $fh $svg->xmlify;
+    $surface->write_to_png( $file );
 }