my ( @fields, $field_str, $sql );
@fields = (
- "S_ID VARCHAR(256), INDEX S_ID_index (S_ID)",
- "S_BEG INT, INDEX S_BEG_index (S_BEG)",
- "S_END INT, INDEX S_END_index (S_END)",
- "Q_ID VARCHAR(256), INDEX Q_ID_index (Q_ID)",
- "SCORE FLOAT, INDEX SCORE_index (SCORE)",
- "STRAND CHAR(1), INDEX STRAND_index (STRAND)",
- "HITS INT, INDEX HITS_index (HITS)",
+ "S_ID VARCHAR(256)",
+ "S_BEG INT, INDEX S_BEG_index (S_BEG)",
+ "S_END INT, INDEX S_END_index (S_END)",
+ "Q_ID VARCHAR(256)",
+ "SCORE FLOAT",
+ "STRAND CHAR(1)",
+ "HITS INT",
"ALIGN VARCHAR(256)",
- "BLOCK_COUNT TINYINT, INDEX BLOCK_COUNT_index (BLOCK_COUNT)",
+ "BLOCK_COUNT TINYINT",
"BLOCK_BEGS VARCHAR(1024)",
"BLOCK_LENS VARCHAR(1024)",
"BLOCK_TYPE VARCHAR(1024)",
__END__
+
+ @fields = (
+ "S_ID VARCHAR(256), INDEX S_ID_index (S_ID)",
+ "S_BEG INT, INDEX S_BEG_index (S_BEG)",
+ "S_END INT, INDEX S_END_index (S_END)",
+ "Q_ID VARCHAR(256), INDEX Q_ID_index (Q_ID)",
+ "SCORE FLOAT, INDEX SCORE_index (SCORE)",
+ "STRAND CHAR(1), INDEX STRAND_index (STRAND)",
+ "HITS INT, INDEX HITS_index (HITS)",
+ "ALIGN VARCHAR(256)",
+ "BLOCK_COUNT TINYINT, INDEX BLOCK_COUNT_index (BLOCK_COUNT)",
+ "BLOCK_BEGS VARCHAR(1024)",
+ "BLOCK_LENS VARCHAR(1024)",
+ "BLOCK_TYPE VARCHAR(1024)",
+ );
# Insert comma in long numbers.
- my ( $num, # number reference to commify
+ my ( $num, # number to commify
) = @_;
- ${ $num } =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
+ # Returns a string.
+
+ my ( $copy );
+
+ $copy = $num;
+
+ $copy =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
+
+ return $copy;
}
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-# Routines for creating KISS graphics.
+# Routines for creating KISS graphics using Cairo and Pango.
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
use warnings;
use strict;
use Data::Dumper;
-use SVG;
+use Cairo;
+use Pango;
use vars qw( @ISA @EXPORT );
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-sub svg_init
+sub track_text
{
- # Martin A. Hansen, October 2005.
+ # Given a sequence list add this to
+ # a Cairo::Context object.
- # 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,
+ my ( $cr, # Cairo::Context object
+ $text, # List of hashrefs { txt =>, x => y => }
+ $color, # Color of features
) = @_;
# Returns nothing.
- my ( $track );
+ $cr->set_source_rgb( color_name2rgb( $color ) );
- $dna = 'GAACGACGAGCATCAGCGGACACTACATCATATACTACATC';
+ my ( $txt );
- $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',
- }
- );
+ $cr->set_font_size( 10 );
- $track->text(
- id => 'DNA',
- x => 0,
- y => 20,
- -cdata => $dna,
- );
+ foreach $txt ( @{ $text } )
+ {
+ $cr->move_to( $txt->{ 'x' }, $txt->{ 'y' } );
+ $cr->show_text( $txt->{ 'txt' } );
+ $cr->stroke();
+ }
}
-sub svg_track_feature
+sub 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++ )
- {
- $id = "FEAT_$i";
- $x = $features->[ $i ]->{ 'x' };
- $y = $features->[ $i ]->{ 'y' };
- $h = $features->[ $i ]->{ 'height' };
- $w = $features->[ $i ]->{ 'width' };
+ $cr->set_source_rgb( color_name2rgb( $color ) );
- # $track->rectangle( id => $id, x => $x, y => $y, width => $w, height => $h );
+ $cr->set_line_width( 5 );
- $track->line( id => $id, x1 => $x, y1 => $y, x2 => $x + $w, y2 => $y );
+ foreach $feature ( @{ $features } )
+ {
+ $cr->move_to( $feature->{ 'x1' }, $feature->{ 'y1' } );
+ $cr->line_to( $feature->{ 'x2' }, $feature->{ 'y2' } );
+ $cr->stroke;
}
}
-sub svg_track_histogram
+sub color_name2rgb
{
- # 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
+ my ( $color_name
) = @_;
- # Returns nothing.
-
- my ( $track, $i );
+ my ( %color_hash, $rgb );
- $track = $svg->group(
- id => $track_id,
- style => {
- 'stroke-width' => 5,
- stroke => $color,
- }
+ %color_hash = (
+ 'green' => [ 0, 255, 0 ],
);
- 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' },
- );
+ if ( exists $color_hash{ $color_name } ) {
+ $rgb = $color_hash{ $color_name };
+ } else {
+ $rgb = [ 0, 0, 0 ];
}
+
+ return wantarray ? @{ $rgb } : $rgb;
}
-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 );
}
my ( $sql, $entries );
- $sql = "SELECT * FROM $table WHERE S_BEG >= $s_beg AND S_END <= $s_end";
+ # $sql = "SELECT * FROM $table WHERE S_BEG >= $s_beg AND S_END <= $s_end ORDER BY S_BEG,S_END";
+ $sql = "SELECT S_BEG,S_END FROM $table WHERE S_BEG >= $s_beg AND S_END <= $s_end";
$entries = Maasha::SQL::query_hashref_list( $dbh, $sql );
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-sub entries_sort
+sub track_ruler
{
- my ( $entries, # list of KISS entries
+ my ( $width, # draw window width
+ $y_offset, # y axis draw offset
+ $beg, # base window beg
+ $end, # base window end
) = @_;
- # Returns nothing.
+ my ( $factor, $step, $i, $txt, $x, @ruler );
- @{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or
- $a->{ 'S_END' } <=> $b->{ 'S_END' } } @{ $entries };
+ $factor = $width / ( $end - $beg );
+
+ $step = 10;
+
+ while ( ( $end - $beg ) / $step > 20 )
+ {
+ $step *= 5;
+ }
+
+ for ( $i = $beg; $i < $end; $i++ )
+ {
+ if ( ( $i % $step ) == 0 )
+ {
+ $txt = "$i|";
+ $x = sprintf( "%.0f", ( $i - $beg - length $txt ) * $factor );
+
+ push @ruler, { txt => $txt, x => $x, y => $y_offset };
+ }
+ }
+
+ return wantarray ? @ruler : \@ruler;
+}
+
+
+sub track_seq
+{
+ my ( $width, # draw window width
+ $y_offset, # y axis draw offset
+ $seq, # sequence to draw
+ ) = @_;
+
+ my ( @chars, $factor, $i, @seq_list );
+
+ @chars = split //, $seq;
+
+ $factor = $width / @chars;
+
+ for ( $i = 0; $i < @chars; $i++ ) {
+ push @seq_list, { txt => $chars[ $i ], x => sprintf( "%.0f", $i * $factor ), y => $y_offset };
+ }
+
+ return wantarray ? @seq_list : \@seq_list;
}
$y_offset, # y axis draw offset
$beg, # base window beg
$end, # base window end
- $entries, # list of sorted KISS entries
+ $entries, # list of unsorted KISS entries
) = @_;
# Returns a list.
- my ( $factor, $entry, $y_step, @ladder, $i, $x, $y, $w, @features );
+ my ( $factor, $entry, $y_step, @ladder, $w, $x1, $y1, $x2, $y2, @features );
+
+ @{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or $a->{ 'S_END' } <=> $b->{ 'S_END' } } @{ $entries };
$factor = $width / ( $end - $beg );
$y_step = 0;
if ( $w >= 1 )
{
- $x = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor );
+ $x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor );
for ( $y_step = 0; $y_step < @ladder; $y_step++ )
{
- last if $x >= $ladder[ $y_step ] + 1;
+ last if $x1 >= $ladder[ $y_step ] + 1;
}
- $y = $y_offset + ( 5 * $y_step );
+ $y1 = $y_offset + ( 5 * $y_step );
push @features, {
-# id => $entry->{ 'Q_ID' },
- x => $x,
- y => $y,
- height => 5,
- width => $w,
+ x1 => $x1,
+ y1 => $y1,
+ x2 => $x1 + $w,
+ y2 => $y1,
};
- $ladder[ $y_step ] = $x + $w;
+ $ladder[ $y_step ] = $x1 + $w;
}
}
$y_offset, # y axis draw offset
$min, # minimum base position
$max, # maximum base position
- $entries, # list of sorted KISS entries
+ $entries, # list of unsorted KISS entries
) = @_;
# Returns a list.
- my ( $hist_height, $bucket_width, $factor_heigth, $factor_width, $entry, $max_height, $bucket_beg, $bucket_end, $i, @buckets, $bucket, @hist, $x, $h );
+ my ( $hist_height, $bucket_width, $factor_heigth, $factor_width, $entry, $min_bucket, $max_height, $bucket_beg, $bucket_end, $i, @buckets, $bucket, @hist, $x, $h );
return if $max == $min;
$factor_width = ( $width / $bucket_width ) / ( $max - $min );
+ $min_bucket = 999999999;
$max_height = 0;
foreach $entry ( @{ $entries } )
$bucket_beg = int( $entry->{ 'S_BEG' } * $factor_width );
$bucket_end = int( $entry->{ 'S_END' } * $factor_width );
- # print "$bucket_beg $bucket_end\n";
-
+ $min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg );
+
for ( $i = $bucket_beg; $i <= $bucket_end; $i++ )
{
$buckets[ $i ]++;
}
}
- # print Maasha::KISS::Draw::hdump( \@buckets );
- #print Dumper( $max_height );
-
if ( $max_height > 0 )
{
$factor_heigth = $hist_height / $max_height;
$x = 0;
- for ( $i = int( $entries->[ 0 ]->{ 'S_BEG' } * $factor_width ); $i < @buckets; $i++ )
+ for ( $i = $min_bucket; $i < @buckets; $i++ )
{
if ( defined $buckets[ $i ] )
{
use DBI;
use Data::Dumper;
-
+use Time::HiRes;
use Maasha::Common;
use vars qw( @ISA @EXPORT );
# Returns a list.
my ( $sth, $table, $errstr, @status );
-
if ( not $sth = $dbh->prepare( $sql ) )
{
$errstr = $DBI::errstr;
disconnect( $dbh );
die qq(ERROR: $errstr, "SQL EXECUTE ERROR" );
}
-
+
if ( $table = $sth->fetchall_arrayref( $out ) )
{
return wantarray ? @{ $table } : $table;
# Returns datastructure.
- my $table = $dbh->selectall_arrayref( $sql, { Slice => {} } ); # This call is slow! :o(
+ my $table = $dbh->selectall_arrayref( $sql, { Slice => {} } );
return wantarray ? @{ $table } : $table;
}
use lib "/Users/maasha/biopieces/code_perl/";
use CGI;
+use Cairo;
+use Pango;
use Data::Dumper;
use Time::HiRes;
use Maasha::Common;
use Maasha::Filesys;
+use Maasha::Calc;
use Maasha::XHTML;
use Maasha::Biopieces;
use Maasha::KISS::IO;
$dbh = Maasha::SQL::connect( $database, $user, $password );
-
$script = Maasha::Common::get_scriptname();
push @html, Maasha::XHTML::html_header(
$def_start = nav_def_start( $cgi );
$def_end = nav_def_end( $cgi );
- Maasha::Calc::commify( \$def_start );
- Maasha::Calc::commify( \$def_end );
-
push @html, Maasha::XHTML::table_beg( summary => "Navigation table" );
push @html, Maasha::XHTML::table_row_simple( tr => [ qw( Clade Genome Assembly Contig Start End ) ], align => 'center' );
push @html, Maasha::XHTML::table_row_simple( tr => [
Maasha::XHTML::menu( name => "nav_genome", options => $list_genome, selected => $def_genome ),
Maasha::XHTML::menu( name => "nav_assembly", options => $list_assembly, selected => $def_assembly ),
Maasha::XHTML::menu( name => "nav_contig", options => $list_contig, selected => $def_contig ),
- Maasha::XHTML::text( name => "nav_start", value => $def_start, size => 20 ),
- Maasha::XHTML::text( name => "nav_end", value => $def_end, size => 20 ),
+ Maasha::XHTML::text( name => "nav_start", value => Maasha::Calc::commify( $def_start ), size => 20 ),
+ Maasha::XHTML::text( name => "nav_end", value => Maasha::Calc::commify( $def_end ), size => 20 ),
Maasha::XHTML::submit( name => "nav_submit", value => "Submit" ),
] );
push @html, Maasha::XHTML::table_end;
# Returns a list.
- my ( $t0, $t1, $table, $entries, $features, $svg, $file, $fh, @html );
+ my ( $t0, $t1, $ruler, $index, $index_beg, $index_len, $fh, $seq, $dna, $table, $entries, $features, $surface, $cr, $file, @html );
+
+ $ruler = Maasha::KISS::Track::track_ruler( 1200, 25, $start, $end );
+
+ $index = Maasha::Fasta::index_retrieve( "$ENV{ 'BP_DATA' }/genomes/S_aur_COL/fasta/S_aur_COL.index" );
+
+ ( $index_beg, $index_len ) = @{ $index->{ 'S_aur_COL' } };
+
+ $fh = Maasha::Filesys::file_read_open( "$ENV{ 'BP_DATA' }/genomes/S_aur_COL/fasta/S_aur_COL.fna" );
+
+ $seq = Maasha::Filesys::file_read( $fh, $index_beg + $start, $end - $start + 1 );
+
+ close $fh;
+
+ $dna = Maasha::KISS::Track::track_seq( 1200, 50, $seq ) if length $seq <= 220;
$table = 'Solexa';
$entries = Maasha::KISS::IO::kiss_sql_get( $dbh, $table, $start, $end );
$t1 = Time::HiRes::gettimeofday();
- push @html, Maasha::XHTML::p( txt => "Feature count: " . scalar @$entries );
+ push @html, Maasha::XHTML::p( txt => "Feature count: " . Maasha::Calc::commify( scalar @$entries ) );
push @html, Maasha::XHTML::p( txt => "Time SQL: " . ( $t1 - $t0 ) );
$t0 = Time::HiRes::gettimeofday();
- Maasha::KISS::Track::entries_sort( $entries );
- $t1 = Time::HiRes::gettimeofday();
- push @html, Maasha::XHTML::p( txt => "Time sort: " . ( $t1 - $t0 ) );
-
- $t0 = Time::HiRes::gettimeofday();
-
- my $MAX = 4000; # FIXME should depend on hieght of track as well
+ my $MAX = 4000; # FIXME should depend on height of track as well
if ( @$entries > $MAX ) {
- $features = Maasha::KISS::Track::track_histogram( 1200, 50, $start, $end, $entries );
+ $features = Maasha::KISS::Track::track_histogram( 1200, 75, $start, $end, $entries );
} else {
- $features = Maasha::KISS::Track::track_feature( 1200, 50, $start, $end, $entries );
+ $features = Maasha::KISS::Track::track_feature( 1200, 75, $start, $end, $entries );
}
$t1 = Time::HiRes::gettimeofday();
push @html, Maasha::XHTML::p( txt => "Time Track: " . ( $t1 - $t0 ) );
- $file = "fisk.svg";
+ $file = "fisk.png";
- $fh = Maasha::Filesys::file_write_open( $file );
-
- $svg = Maasha::KISS::Draw::svg_init( 800, 1200 );
+ $surface = Cairo::ImageSurface->create( 'argb32', 1200, 800 );
+ $cr = Cairo::Context->create( $surface );
$t0 = Time::HiRes::gettimeofday();
- Maasha::KISS::Draw::svg_frame( 800, 1200, $svg );
- Maasha::KISS::Draw::svg_track_dna( 1200, $svg, 'dna', 'ATCG' );
+ Maasha::KISS::Draw::track_text( $cr, $ruler, "red" ) if $ruler;
+ Maasha::KISS::Draw::track_text( $cr, $dna, "red" ) if $dna;
- if ( @$entries > $MAX ) {
- Maasha::KISS::Draw::svg_track_histogram( $svg, $features, 'track id', 'green' ) if $features;
- } else {
- Maasha::KISS::Draw::svg_track_feature( 800, 1200, $svg, $features, 'track id2', 'green' ) if $features;
- }
+ Maasha::KISS::Draw::track_feature( $cr, $features, 'green' ) if $features;
+
+ Maasha::KISS::Draw::file_png( $surface, $file );
- Maasha::KISS::Draw::svg_print( $svg, $fh );
$t1 = Time::HiRes::gettimeofday();
push @html, Maasha::XHTML::p( txt => "Time Draw: " . ( $t1 - $t0 ) );
- close $fh;
-
- push @html, Maasha::XHTML::object( type => "image/svg+xml",
- # data => "/Users/maasha/test.svg",
- data => $file,
- name => "owMain",
- width => "1200",
- height => "800" );
+ push @html, Maasha::XHTML::p( txt => Maasha::XHTML::img( src => $file, alt => "Browser Tracks", height => 800, width => 1200, class => "foo", id => "pix_id", usemap => "map" ) );
return wantarray ? @html : \@html;
}
projects / biopieces.git / commitdiff