@ISA = qw( Exporter );
use constant {
- S_ID => 0,
- S_BEG => 1,
- S_END => 2,
- Q_ID => 3,
- SCORE => 4,
- STRAND => 5,
- HITS => 6,
- ALIGN => 7,
- BLOCK_COUNT => 8,
- BLOCK_BEGS => 9,
- BLOCK_LENS => 10,
- BLOCK_TYPE => 11,
+ S_ID => 0,
+ S_BEG => 1,
+ S_END => 2,
+ Q_ID => 3,
+ SCORE => 4,
+ STRAND => 5,
+ HITS => 6,
+ ALIGN => 7,
+ BLOCK_COUNT => 8,
+ BLOCK_BEGS => 9,
+ BLOCK_LENS => 10,
+ BLOCK_TYPE => 11,
+ INDEX_BLOCK_SIZE => 100,
+ INDEX_LEVEL => 100_000_000,
+ INDEX_FACTOR => 100,
};
@fields = split /\t/, $line;
- Maasha::Common::error( qq( BAD kiss entry: $line) ) if not @fields == 12;
+ Maasha::Common::error( qq(BAD kiss entry: $line) ) if not @fields == 12;
$entry{ 'S_ID' } = $fields[ S_ID ];
$entry{ 'S_BEG' } = $fields[ S_BEG ];
my ( @fields );
- if ( defined $entry->{ 'S_ID' } and
+ if ( defined $entry->{ 'S_ID' } and
defined $entry->{ 'S_BEG' } and
defined $entry->{ 'S_END' }
)
sub kiss_index
{
- # Martin A, Hansen, October 2009.
+ # Martin A, Hansen, November 2009.
- # Creates an index of a sorted KISS file that
- # allowing the location of the byte position
- # from where records can be read given a
- # specific S_BEG position. The index consists of
- # triples: [ beg, end, bytepos ], where beg and
- # end denotes the interval where the next KISS
- # record begins at bytepos.
+ # Creates an index of a sorted KISS file.
- my ( $fh, # filehandle to KISS file
+ my ( $file, # KISS file to index
) = @_;
- # Returns a list.
+ # Returns a hashref.
- my ( $line, @fields, $beg, $end, $pos, @index );
+ my ( $tree, $offset, $fh, $line, $beg );
- $beg = 0;
- $pos = 0;
+ $tree = {};
+ $offset = 0;
+
+ $fh = Maasha::Filesys::file_read_open( $file );
while ( $line = <$fh> )
{
- chomp $line;
+ ( undef, $beg ) = split "\t", $line, 3;
- @fields = split /\t/, $line, 3;
+ kiss_index_node_add( $tree, INDEX_LEVEL, INDEX_FACTOR, $beg, $offset );
+
+ $offset += length $line;
+ }
+
+ close $fh;
+
+ kiss_index_store( "$file.index", $tree );
+}
+
+
+sub kiss_index_node_add
+{
+ # Martin A, Hansen, November 2009.
+
+ # Recursive routine to add nodes to a tree.
+
+ my ( $node,
+ $level,
+ $factor,
+ $beg,
+ $offset,
+ $sum,
+ ) = @_;
+
+ my ( $bucket );
+
+ $sum ||= 0;
+ $bucket = int( $beg / $level );
+
+ if ( $level >= $factor )
+ {
+ $sum += $bucket * $level;
+ $beg -= $bucket * $level;
- $end = $fields[ S_BEG ];
+ $node->{ 'CHILDREN' }->[ $bucket ]->{ 'COUNT' }++;
+ # $node->{ 'CHILDREN' }->[ $bucket ]->{ 'LEVEL' } = $level;
+ # $node->{ 'CHILDREN' }->[ $bucket ]->{ 'BUCKET' } = $bucket;
+ $node->{ 'CHILDREN' }->[ $bucket ]->{ 'BEG' } = $sum;
+ $node->{ 'CHILDREN' }->[ $bucket ]->{ 'END' } = $sum + $level - 1;
+ $node->{ 'CHILDREN' }->[ $bucket ]->{ 'OFFSET' } = $offset if not defined $node->{ 'CHILDREN' }->[ $bucket ]->{ 'OFFSET' };
+
+ kiss_index_node_add( $node->{ 'CHILDREN' }->[ $bucket ], $level / $factor, $factor, $beg, $offset, $sum );
+ }
+}
- if ( $end == 0 )
- {
- push @index, [ $beg, $end, $pos ];
- $beg = 1;
- }
- elsif ( $end > $beg )
+
+sub kiss_index_offset
+{
+ # Martin A. Hansen, November 2009.
+
+ # Given a KISS index and a begin position,
+ # locate the offset closest to the begin position,
+ # and return this.
+
+ my ( $index, # KISS index
+ $beg, # begin position
+ $level, # index level - OPTIONAL
+ $factor, # index factor - OPTIONAL
+ ) = @_;
+
+ # Returns a number.
+
+ my ( $child, $offset );
+
+ $level ||= INDEX_LEVEL;
+ $factor ||= INDEX_FACTOR;
+
+ foreach $child ( @{ $index->{ 'CHILDREN' } } )
+ {
+ next if not defined $child;
+
+ if ( $child->{ 'BEG' } <= $beg and $beg <= $child->{ 'END' } )
{
- push @index, [ $beg, $end - 1, $pos ];
- $beg = $end;
+ if ( $level == $factor ) {
+ $offset = $child->{ 'OFFSET' };
+ } else {
+ $offset = kiss_index_offset( $child, $beg, $level / $factor, $factor );
+ }
}
- elsif( $end < $beg )
+ }
+
+ return $offset;
+}
+
+
+sub kiss_index_count
+{
+ # Martin A. Hansen, November 2009.
+
+ # Given a KISS index and a begin/end interval
+ # sum the number of counts in that interval,
+ # and return this.
+
+ my ( $index, # KISS index
+ $beg, # Begin position
+ $end, # End position
+ $level, # index level - OPTIONAL
+ $factor, # index factor - OPTIONAL
+ ) = @_;
+
+ # Returns a number.
+
+ my ( $count, $child );
+
+ $level ||= INDEX_LEVEL;
+ $factor ||= INDEX_FACTOR;
+ $count ||= 0;
+
+ foreach $child ( @{ $index->{ 'CHILDREN' } } )
+ {
+ next if not defined $child;
+
+ if ( $level >= $factor )
{
- Maasha::Common::error( qq(KISS file not sorted: $end < $beg) );
+ if ( Maasha::Calc::overlap( $beg, $end, $child->{ 'BEG' }, $child->{ 'END' } ) )
+ {
+ $count += $child->{ 'COUNT' } if $level == $factor;
+ $count += kiss_index_count( $child, $beg, $end, $level / $factor, $factor );
+ }
}
-
- $pos += 1 + length $line;
}
- return wantarray ? @index : \@index;
+ return $count;
}
}
-sub kiss_index_search
+sub kiss_index_get_entries
{
- my ( $index,
- $num,
+ my ( $file,
+ $index,
+ $beg,
+ $end,
) = @_;
- # Returns a number.
+ my ( $offset, $fh, $entry, @entries );
- my ( $high, $low, $try );
+ $offset = kiss_index_offset( $index, $beg );
- $low = 0;
- $high = scalar @{ $index };
+ $fh = Maasha::Filesys::file_read_open( $file );
- while ( $low <= $high )
+ sysseek( $fh, $offset, 0 );
+
+ while ( $entry = kiss_entry_get( $fh ) )
{
- $try = int( ( $high + $low ) / 2 );
-
- if ( $num < $index->[ $try ]->[ 0 ] ) {
- $high = $try;
- } elsif ( $num > $index->[ $try ]->[ 1 ] ) {
- $low = $try + 1;
- } else {
- return $index->[ $try ]->[ 2 ];
- }
+ push @entries, $entry if $entry->{ 'S_END' } > $beg;
+
+ last if $entry->{ 'S_BEG' } > $end;
}
- Maasha::Common::error( "Could not find number->$num in index" );
+ close $fh;
+
+ return wantarray ? @entries : \@entries;
}
-sub kiss_index_get
+sub kiss_index_get_blocks
{
- my ( $file,
+ my ( $index,
$beg,
$end,
+ $level, # index level - OPTIONAL
+ $factor, # index factor - OPTIONAL
+ $size,
) = @_;
- my ( $index, $offset, $fh, $entry, @entries );
-
- $index = Maasha::KISS::IO::kiss_index_retrieve( "$file.index" );
-
- $offset = Maasha::KISS::IO::kiss_index_search( $index, $beg );
-
- $fh = Maasha::Filesys::file_read_open( $file );
-
- sysseek( $fh, $offset, 0 );
-
- while ( $entry = kiss_entry_get( $fh ) )
+ # Returns a list.
+
+ my ( $len, @blocks, $child );
+
+ $level ||= INDEX_LEVEL;
+ $factor ||= INDEX_FACTOR;
+
+ $size ||= 100; # TODO: lazy list loading?
+
+# if ( not defined $size )
+# {
+# $len = $end - $beg + 1;
+#
+# if ( $len > 100_000_000 ) {
+# $size = 1_000_000;
+# } elsif ( $len > 1_000_000 ) {
+# $size = 10_000;
+# } else {
+# $size = 100;
+# }
+# }
+
+ if ( $level >= $size )
{
- push @entries, $entry;
+ foreach $child ( @{ $index->{ 'CHILDREN' } } )
+ {
+ next if not defined $child;
- last if $entry->{ 'S_END' } > $end;
+ if ( Maasha::Calc::overlap( $beg, $end, $child->{ 'BEG' }, $child->{ 'END' } ) )
+ {
+ if ( $level == $size )
+ {
+ push @blocks, {
+ BEG => $child->{ 'BEG' },
+ END => $child->{ 'END' },
+ COUNT => $child->{ 'COUNT' },
+ };
+ }
+
+ push @blocks, kiss_index_get_blocks( $child, $beg, $end, $level / $factor, $factor, $size );
+ }
+ }
}
- close $fh;
-
- return wantarray ? @entries : \@entries;
+ return wantarray ? @blocks : \@blocks;
}
1;
+__END__
+
+sub kiss_index
+{
+ # Martin A, Hansen, October 2009.
+
+ # Creates an index of a sorted KISS file that
+ # allowing the location of the byte position
+ # from where records can be read given a
+ # specific S_BEG position. The index consists of
+ # triples: [ beg, end, bytepos ], where beg and
+ # end denotes the interval where the next KISS
+ # record begins at bytepos.
+
+ my ( $fh, # filehandle to KISS file
+ ) = @_;
+
+ # Returns a list.
+
+ my ( $line, @fields, $beg, $end, $pos, @index );
+
+ $beg = 0;
+ $pos = 0;
+
+ while ( $line = <$fh> )
+ {
+ chomp $line;
+
+ @fields = split /\t/, $line, 3;
+
+ $end = $fields[ S_BEG ];
+
+ if ( $end == 0 )
+ {
+ push @index, [ $beg, $end, $pos ];
+ $beg = 1;
+ }
+ elsif ( $end > $beg )
+ {
+ push @index, [ $beg, $end - 1, $pos ];
+ $beg = $end;
+ }
+ elsif ( $end < $beg )
+ {
+ Maasha::Common::error( qq(KISS file not sorted: beg > end -> $beg > $end) );
+ }
+
+ $pos += 1 + length $line;
+ }
+
+ return wantarray ? @index : \@index;
+}
+
+
+
+sub kiss_index_search
+{
+ my ( $index,
+ $num,
+ ) = @_;
+
+ # Returns a number.
+
+ my ( $high, $low, $try );
+
+ $low = 0;
+ $high = scalar @{ $index };
+
+ while ( $low <= $high )
+ {
+ $try = int( ( $high + $low ) / 2 );
+
+ if ( $num < $index->[ $try ]->[ 0 ] ) {
+ $high = $try;
+ } elsif ( $num > $index->[ $try ]->[ 1 ] ) {
+ $low = $try + 1;
+ } else {
+ return $index->[ $try ]->[ 2 ];
+ }
+ }
+
+ Maasha::Common::error( "Could not find number->$num in index" );
+}
+
sub track_ruler
{
- my ( $width, # draw window width
- $y_offset, # y axis draw offset
- $beg, # base window beg
- $end, # base window end
- $font_size, # font size
- $color, # font color
+ my ( $draw_metrics, # hashref with image draw metrics
+ $cookie, # browser cookie
) = @_;
- my ( $factor, $step, $i, $txt, $x, @ruler );
+ my ( $beg, $end, $factor, $step, $i, $txt, $x, @ruler );
- $factor = $width / ( $end - $beg );
+ $beg = $cookie->{ 'NAV_START' };
+ $end = $cookie->{ 'NAV_END' };
+
+ $factor = $draw_metrics->{ 'IMG_WIDTH' } / ( $end - $beg );
$step = 10;
{
if ( ( $i % $step ) == 0 )
{
- $txt = "$i|";
+ $txt = Maasha::Calc::commify( $i ) . "|";
$x = sprintf( "%.0f", ( $i - $beg - length $txt ) * $factor );
- if ( $x > 0 and $x + ( $font_size * length $txt ) < $width )
+ if ( $x > 0 and $x + ( $draw_metrics->{ 'RULER_FONT_SIZE' } * length $txt ) < $draw_metrics->{ 'IMG_WIDTH' } )
{
push @ruler, {
type => 'text',
txt => $txt,
- font_size => $font_size,
- color => $color,
+ font_size => $draw_metrics->{ 'RULER_FONT_SIZE' },
+ color => $draw_metrics->{ 'RULER_COLOR' },
x1 => $x,
- y1 => $y_offset
+ y1 => $draw_metrics->{ 'TRACK_OFFSET' },
};
}
}
}
+ $draw_metrics->{ 'TRACK_OFFSET' } += $draw_metrics->{ 'TRACK_SPACE' };
+
return wantarray ? @ruler : \@ruler;
}
sub track_seq
{
- my ( $width, # draw window width
- $y_offset, # y axis draw offset
- $seq, # sequence to draw
- $font_size, # font size
- $color, # font color
+ my ( $draw_metrics, # hashref with image draw metrics
+ $cookie, # browser cookie
) = @_;
- my ( @chars, $factor, $i, @seq_list );
+ my ( $file, $fh, $seq, @chars, $factor, $i, @seq_list );
- @chars = split //, $seq;
+ if ( $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 <= 220 )
+ {
+ $file = path_seq( $cookie );
+ $fh = Maasha::Filesys::file_read_open( $file );
+ $seq = Maasha::Filesys::file_read( $fh, $cookie->{ 'NAV_START' } - 1, $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' } + 1 );
+ close $fh;
+
+ @chars = split //, $seq;
+
+ $factor = $draw_metrics->{ 'IMG_WIDTH' } / @chars;
+
+ for ( $i = 0; $i < @chars; $i++ ) {
+ push @seq_list, {
+ type => 'text',
+ txt => $chars[ $i ],
+ font_size => $draw_metrics->{ 'SEQ_FONT_SIZE' },
+ color => $draw_metrics->{ 'SEQ_COLOR' },
+ x1 => sprintf( "%.0f", $i * $factor ),
+ y1 => $draw_metrics->{ 'TRACK_OFFSET' },
+ };
+ }
- $factor = $width / @chars;
+ $draw_metrics->{ 'TRACK_OFFSET' } += $draw_metrics->{ 'TRACK_SPACE' };
- for ( $i = 0; $i < @chars; $i++ ) {
- push @seq_list, {
- type => 'text',
- txt => $chars[ $i ],
- font_size => $font_size,
- color => $color,
- x1 => sprintf( "%.0f", $i * $factor ),
- y1 => $y_offset,
- };
+ return wantarray ? @seq_list : \@seq_list;
+ }
+ else
+ {
+ return;
}
-
- return wantarray ? @seq_list : \@seq_list;
}
sub track_feature
{
- my ( $width, # draw window width
- $y_offset, # y axis draw offset
- $beg, # base window beg
- $end, # base window end
- $entries, # list of unsorted KISS entries
+ my ( $track,
+ $draw_metrics,
+ $cookie,
+ ) = @_;
+
+ # Returns a list.
+
+ my ( $index, $count, $track_name, $start, $end, $entries, $features );
+
+ $start = $cookie->{ 'NAV_START' };
+ $end = $cookie->{ 'NAV_END' };
+
+ $index = Maasha::KISS::IO::kiss_index_retrieve( "$track/track_data.kiss.index" );
+ $count = Maasha::KISS::IO::kiss_index_count( $index, $start, $end );
+
+ $track_name = ( split "/", $track )[ -1 ];
+ $track_name =~ s/^\d+_//;
+ $track_name =~ s/_/ /g;
+
+ $features = [ {
+ type => 'text',
+ txt => $track_name,
+ font_size => $draw_metrics->{ 'SEQ_FONT_SIZE' },
+ color => $draw_metrics->{ 'SEQ_COLOR' },
+ x1 => 0,
+ y1 => $draw_metrics->{ 'TRACK_OFFSET' },
+ } ];
+
+ $draw_metrics->{ 'TRACK_OFFSET' } += 10;
+
+ if ( $count > 5000 )
+ {
+ $entries = Maasha::KISS::IO::kiss_index_get_blocks( $index, $start, $end );
+ push @{ $features }, Maasha::KISS::Track::track_feature_histogram( $draw_metrics, $start, $end, $entries );
+ }
+ else
+ {
+ $entries = Maasha::KISS::IO::kiss_index_get_entries( "$track/track_data.kiss", $index, $start, $end );
+ push @{ $features }, Maasha::KISS::Track::track_feature_linear( $draw_metrics, $start, $end, $entries );
+ }
+
+ return wantarray ? @{ $features } : $features;
+}
+
+
+sub track_feature_linear
+{
+ my ( $draw_metrics, # hashref with image draw metrics
+ $beg, # base window beg
+ $end, # base window end
+ $entries, # list of unsorted KISS entries
) = @_;
# Returns a list.
- my ( $feat_height, $factor, $entry, $y_step, @ladder, $w, $x1, $y1, $x2, $y2, @features );
+ my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, @features );
@{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or $a->{ 'S_END' } <=> $b->{ 'S_END' } } @{ $entries };
- $feat_height = 5;
- $factor = $width / ( $end - $beg );
- $y_step = 0;
+ $factor = $draw_metrics->{ 'IMG_WIDTH' } / ( $end - $beg );
+ $y_step = 0;
+ $y_max = 0;
foreach $entry ( @{ $entries } )
{
{
$x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor );
- for ( $y_step = 0; $y_step < @ladder; $y_step++ )
- {
+ for ( $y_step = 0; $y_step < @ladder; $y_step++ ) {
last if $x1 >= $ladder[ $y_step ] + 1;
}
- $y1 = $y_offset + ( $feat_height * $y_step );
+ $y1 = $draw_metrics->{ 'TRACK_OFFSET' } + ( $draw_metrics->{ 'FEAT_WIDTH' } * $y_step );
push @features, {
type => 'rect',
- line_width => $feat_height,
+ line_width => $draw_metrics->{ 'FEAT_WIDTH' },
color => 'green',
title => $entry->{ 'Q_ID' },
x1 => $x1,
y1 => $y1,
x2 => $x1 + $w,
- y2 => $y1 + $feat_height,
+ y2 => $y1 + $draw_metrics->{ 'FEAT_WIDTH' },
};
- push @features, feature_align( $entry, $beg, $y1, $factor, $feat_height ) if defined $entry->{ 'ALIGN' };
+ $y_max = Maasha::Calc::max( $y_max, $y_step * $draw_metrics->{ 'FEAT_WIDTH' } );
+
+ push @features, feature_align( $entry, $beg, $y1, $factor, $draw_metrics->{ 'FEAT_WIDTH' } ) if $entry->{ 'ALIGN' } ne '.';
$ladder[ $y_step ] = $x1 + $w;
}
}
+ $draw_metrics->{ 'TRACK_OFFSET' } += $y_max + $draw_metrics->{ 'TRACK_SPACE' };
+
return wantarray ? @features : \@features;
}
}
-sub track_histogram
+sub track_feature_histogram
{
- my ( $width, # draw window width
- $y_offset, # y axis draw offset
- $min, # minimum base position
- $max, # maximum base position
- $entries, # list of unsorted KISS entries
+ my ( $draw_metrics, # hashref with image draw metrics
+ $min, # minimum base position
+ $max, # maximum base position
+ $blocks, # list of blocks
) = @_;
# Returns a list.
- my ( $hist_height, $bucket_width, $factor_heigth, $factor_width, $entry, $min_bucket, $max_height, $bucket_beg, $bucket_end, $i, @buckets, $bucket, @hist, $x, $h );
+ my ( $hist_height, $bucket_width, $bucket_count, $min_bucket, $factor, $factor_heigth, $max_height, $block, $bucket_beg, $bucket_end, $i, @buckets, $h, $x, @hist );
- return if $max == $min;
+ return if $max <= $min;
$hist_height = 100; # pixels
- $bucket_width = 5; # pixels
-
- $factor_width = ( $width / $bucket_width ) / ( $max - $min );
+ $bucket_width = 5;
+ $bucket_count = $draw_metrics->{ 'IMG_WIDTH' } / $bucket_width;
+ $factor = ( $draw_metrics->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min + 1 );
$min_bucket = 999999999;
$max_height = 0;
- foreach $entry ( @{ $entries } )
+ foreach $block ( @{ $blocks } )
{
- $bucket_beg = int( $entry->{ 'S_BEG' } * $factor_width );
- $bucket_end = int( $entry->{ 'S_END' } * $factor_width );
+ $bucket_beg = int( $block->{ 'BEG' } * $factor );
+ $bucket_end = int( $block->{ 'END' } * $factor );
$min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg );
for ( $i = $bucket_beg; $i <= $bucket_end; $i++ )
{
- $buckets[ $i ]++;
+ $buckets[ $i ] += $block->{ 'COUNT' };
$max_height = Maasha::Calc::max( $max_height, $buckets[ $i ] );
}
color => 'green',
title => "Features: $buckets[ $i ]",
x1 => $x,
- y1 => $y_offset + $hist_height,
+ y1 => $draw_metrics->{ 'TRACK_OFFSET' } + $hist_height,
x2 => $x,
- y2 => $y_offset + $hist_height - $h,
+ y2 => $draw_metrics->{ 'TRACK_OFFSET' } + $hist_height - $h,
};
}
}
}
}
+ $draw_metrics->{ 'TRACK_OFFSET' } += $hist_height + $draw_metrics->{ 'TRACK_SPACE' };
+
return wantarray ? @hist : \@hist;
}
+sub path_seq
+{
+ my ( $cookie,
+ ) = @_;
+
+ # Returns a string.
+
+ my ( $path );
+
+ die qq(ERROR: no DEF_USER in cookie.\n) if not exists $cookie->{ 'DEF_USER' };
+ die qq(ERROR: no DEF_CLADE in cookie.\n) if not exists $cookie->{ 'DEF_CLADE' };
+ die qq(ERROR: no DEF_GENOME in cookie.\n) if not exists $cookie->{ 'DEF_GENOME' };
+ die qq(ERROR: no DEF_ASSEMBLY in cookie.\n) if not exists $cookie->{ 'DEF_ASSEMBLY' };
+ die qq(ERROR: no DEF_CONTIG in cookie.\n) if not exists $cookie->{ 'DEF_CONTIG' };
+
+ $path = join( "/",
+ $cookie->{ 'DATA_DIR' },
+ "Users",
+ $cookie->{ 'DEF_USER' },
+ $cookie->{ 'DEF_CLADE' },
+ $cookie->{ 'DEF_GENOME' },
+ $cookie->{ 'DEF_ASSEMBLY' },
+ $cookie->{ 'DEF_CONTIG' },
+ "Sequence",
+ "sequence.txt"
+ );
+
+ die qq(ERROR: no such file: "$path".\n) if not -e $path;
+
+ return $path;
+}
+
+
+sub path_tracks
+{
+ my ( $cookie,
+ ) = @_;
+
+ # Returns a list.
+ #
+ my ( $path, @tracks );
+
+ die qq(ERROR: no DEF_USER in cookie.\n) if not exists $cookie->{ 'DEF_USER' };
+ die qq(ERROR: no DEF_CLADE in cookie.\n) if not exists $cookie->{ 'DEF_CLADE' };
+ die qq(ERROR: no DEF_GENOME in cookie.\n) if not exists $cookie->{ 'DEF_GENOME' };
+ die qq(ERROR: no DEF_ASSEMBLY in cookie.\n) if not exists $cookie->{ 'DEF_ASSEMBLY' };
+ die qq(ERROR: no DEF_CONTIG in cookie.\n) if not exists $cookie->{ 'DEF_CONTIG' };
+
+ $path = join( "/",
+ $cookie->{ 'DATA_DIR' },
+ "Users",
+ $cookie->{ 'DEF_USER' },
+ $cookie->{ 'DEF_CLADE' },
+ $cookie->{ 'DEF_GENOME' },
+ $cookie->{ 'DEF_ASSEMBLY' },
+ $cookie->{ 'DEF_CONTIG' },
+ "Tracks",
+ );
+
+ @tracks = Maasha::Filesys::ls_dirs( $path );
+
+ @tracks = grep { $_ !~ /\/\.\.?$/ } @tracks;
+
+ return wantarray ? @tracks : \@tracks;
+}
+
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1;
+
use Maasha::KISS::Track;
use Maasha::KISS::Draw;
-my ( $cgi, $database, $user, $password, $dbh, $script, @html );
+my ( $cgi, $cookie, $script, @html );
-$cgi = new CGI;
-
-$database = 'S_aur_COL';
-$user = Maasha::Biopieces::biopiecesrc( "MYSQL_USER" );
-$password = Maasha::Biopieces::biopiecesrc( "MYSQL_PASSWORD" );
-
-$dbh = Maasha::SQL::connect( $database, $user, $password );
-
-$script = Maasha::Common::get_scriptname();
+$cgi = new CGI;
+$script = Maasha::Common::get_scriptname();
+$cookie = cookie_default( $cgi );;
push @html, Maasha::XHTML::html_header(
cgi_header => 1,
push @html, Maasha::XHTML::h1( txt => "KISS Genome Browser", class => 'center' );
push @html, Maasha::XHTML::form_beg( action => $script, method => "get", enctype => "multipart/form-data" );
-push @html, sec_navigate( $cgi );
-push @html, sec_browse( $dbh, $cgi );
+push @html, sec_navigate( $cookie );
+push @html, sec_browse( $cookie );
push @html, Maasha::XHTML::form_end;
push @html, Maasha::XHTML::body_end;
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-sub sec_navigate
+sub cookie_default
{
my ( $cgi, # CGI object
) = @_;
- # Returns a list.
+ # Returns a hash
- my ( $list_clade, $list_genome, $list_assembly, $list_contig, $def_clade, $def_genome, $def_assembly, $def_contig, $def_start, $def_end, @html );
+ my ( $cookie );
- $list_clade = nav_list_clade();
- $list_genome = nav_list_genome();
- $list_assembly = nav_list_assembly();
- $list_contig = nav_list_contig();
+ $cookie = {};
- nav_zoom( $cgi );
- nav_move( $cgi, 2_800_000 ); # FIXME
+ $cookie->{ 'DATA_DIR' } = "Data";
- $def_clade = nav_def_clade( $cgi );
- $def_genome = nav_def_genome( $cgi );
- $def_assembly = nav_def_assembly( $cgi );
- $def_contig = nav_def_contig( $cgi );
- $def_start = nav_def_start( $cgi );
- $def_end = nav_def_end( $cgi );
+ cookie_cgi( $cookie, $cgi );
+ cookie_user( $cookie );
+ cookie_clade( $cookie );
+ cookie_genome( $cookie );
+ cookie_assembly( $cookie );
+ cookie_contig( $cookie );
+ cookie_start( $cookie );
+ cookie_end( $cookie );
+ cookie_zoom( $cookie );
+ cookie_move( $cookie );
- push @html, Maasha::XHTML::table_beg( summary => "Navigation table", align => 'center' );
- 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_clade", options => $list_clade, selected => $def_clade ),
- 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 => 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;
+ # print STDERR Dumper( $cookie );
- push @html, Maasha::XHTML::table_beg( summary => "Zoom table", align => 'center' );
- push @html, Maasha::XHTML::table_row_simple( tr => [
- Maasha::XHTML::p( txt => 'Move:' ),
- Maasha::XHTML::submit( name => "move_left3", value => "<<<", title => "move 95% to the left" ),
- Maasha::XHTML::submit( name => "move_left2", value => "<<", title => "move 47.5% to the left" ),
- Maasha::XHTML::submit( name => "move_left1", value => "<", title => "move 10% to the left" ),
- Maasha::XHTML::submit( name => "move_right1", value => ">", title => "move 10% to the rigth" ),
- Maasha::XHTML::submit( name => "move_right2", value => ">>", title => "move 47.5% to the rigth" ),
- Maasha::XHTML::submit( name => "move_right3", value => ">>>", title => "move 95% to the right" ),
- Maasha::XHTML::p( txt => 'Zoom in:' ),
- Maasha::XHTML::submit( name => "zoom_in1", value => "1.5x" ),
- Maasha::XHTML::submit( name => "zoom_in2", value => "3x" ),
- Maasha::XHTML::submit( name => "zoom_in3", value => "10x" ),
- Maasha::XHTML::p( txt => 'Zoom out:' ),
- Maasha::XHTML::submit( name => "zoom_out1", value => "1.5x" ),
- Maasha::XHTML::submit( name => "zoom_out2", value => "3x" ),
- Maasha::XHTML::submit( name => "zoom_out3", value => "10x" ),
- ] );
- push @html, Maasha::XHTML::table_end;
-
- @html = Maasha::XHTML::div( txt => join( "\n", @html ), class => 'navigate' );
-
- return wantarray ? @html : \@html;
+ return wantarray ? %{ $cookie } : $cookie;
}
-sub sec_browse
+sub cookie_cgi
{
- my ( $dbh, # Database handle
- $cgi, # CGI object
+ my ( $cookie,
+ $cgi,
) = @_;
- # Returns a list.
-
- my ( $t0, $t1, @stats, $start, $end, $ruler, $index, $index_beg, $index_len, $fh, $seq, $dna, $table, $entries, $features, $surface, $cr, $file, @html, @img );
-
- $start = $cgi->param( 'nav_start' );
- $end = $cgi->param( 'nav_end' );
-
- $ruler = Maasha::KISS::Track::track_ruler( 1200, 25, $start, $end, 10, 'black' );
-
- $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, 10, 'black' ) if length $seq <= 220;
+ # Returns nothing.
+
+ $cookie->{ 'DEF_CLADE' } = $cgi->param( 'nav_clade' );
+ $cookie->{ 'DEF_GENOME' } = $cgi->param( 'nav_genome' );
+ $cookie->{ 'DEF_ASSEMBLY' } = $cgi->param( 'nav_assembly' );
+ $cookie->{ 'DEF_CONTIG' } = $cgi->param( 'nav_contig' );
+ $cookie->{ 'NAV_START' } = $cgi->param( 'nav_start' );
+ $cookie->{ 'NAV_END' } = $cgi->param( 'nav_end' );
+ $cookie->{ 'ZOOM_IN1' } = $cgi->param( 'zoom_in1' );
+ $cookie->{ 'ZOOM_IN2' } = $cgi->param( 'zoom_in2' );
+ $cookie->{ 'ZOOM_IN3' } = $cgi->param( 'zoom_in3' );
+ $cookie->{ 'ZOOM_OUT1' } = $cgi->param( 'zoom_out1' );
+ $cookie->{ 'ZOOM_OUT2' } = $cgi->param( 'zoom_out2' );
+ $cookie->{ 'ZOOM_OUT3' } = $cgi->param( 'zoom_out3' );
+ $cookie->{ 'MOVE_LEFT1' } = $cgi->param( 'move_left1' );
+ $cookie->{ 'MOVE_LEFT2' } = $cgi->param( 'move_left2' );
+ $cookie->{ 'MOVE_LEFT3' } = $cgi->param( 'move_left3' );
+ $cookie->{ 'MOVE_RIGHT1' } = $cgi->param( 'move_right1' );
+ $cookie->{ 'MOVE_RIGHT2' } = $cgi->param( 'move_right2' );
+ $cookie->{ 'MOVE_RIGHT3' } = $cgi->param( 'move_right3' );
+}
- $table = 'Solexa';
- $t0 = Time::HiRes::gettimeofday();
- $entries = Maasha::KISS::IO::kiss_sql_get( $dbh, $table, $start, $end );
- $t1 = Time::HiRes::gettimeofday();
+sub cookie_user
+{
+ my ( $cookie,
+ ) = @_;
- push @stats, "Feature count: " . Maasha::Calc::commify( scalar @$entries );
- push @stats, "Time SQL: " . sprintf( "%.4f", $t1 - $t0 );
+ # Returns nothing.
+
+ my ( @dirs, $dir );
- $t0 = Time::HiRes::gettimeofday();
+ @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users" );
- my $MAX = 4000; # FIXME should depend on height of track as well
+ foreach $dir ( @dirs )
+ {
+ next if $dir =~ /\/\.\.?$/;
- if ( @$entries > $MAX ) {
- $features = Maasha::KISS::Track::track_histogram( 1200, 75, $start, $end, $entries );
- } else {
- $features = Maasha::KISS::Track::track_feature( 1200, 75, $start, $end, $entries );
+ push @{ $cookie->{ 'LIST_USER' } }, ( split "/", $dir )[ -1 ];
}
- $t1 = Time::HiRes::gettimeofday();
-
- # push @html, Maasha::KISS::Draw::hdump( $entries );
- # push @html, Maasha::KISS::Draw::hdump( $features );
-
- push @stats, "Time Track: " . sprintf( "%.4f", $t1 - $t0 );
-
- $file = "fisk.png";
-
- $surface = Cairo::ImageSurface->create( 'argb32', 1200, 800 );
- $cr = Cairo::Context->create( $surface );
-
- $t0 = Time::HiRes::gettimeofday();
-
- Maasha::KISS::Draw::draw_feature( $cr, $ruler ) if $ruler;
- Maasha::KISS::Draw::draw_feature( $cr, $dna ) if $dna;
- Maasha::KISS::Draw::draw_feature( $cr, $features ) if $features;
-
- Maasha::KISS::Draw::file_png( $surface, $file );
-
- $t1 = Time::HiRes::gettimeofday();
-
- push @stats, "Time Draw: " . sprintf( "%.4f", $t1 - $t0 );
-
- push @html, Maasha::XHTML::p( txt => join( " ", @stats ) );
-
- push @img, Maasha::XHTML::img( src => $file, alt => "Browser Tracks", height => 800, width => 1200, id => "browser_map", usemap => "#browser_map" );
-
- push @img, Maasha::XHTML::map_beg( name => "browser_map", id => "browser_map" );
-
- map { push @img, Maasha::XHTML::area( href => "www.dmi.dk", shape => "rect", coords => "$_->{ x1 }, $_->{ y1 }, $_->{ x2 }, $_->{ y2 }", title => "$_->{ title }" ) } @{ $features };
-
- push @img, Maasha::XHTML::map_end();
-
- push @html, Maasha::XHTML::p( txt => join( "\n", @img ) );
-
- @html = Maasha::XHTML::div( txt => join( "\n", @html ), class => 'browse' );
-
- return wantarray ? @html : \@html;
+ $cookie->{ 'DEF_USER' } = $cookie->{ 'LIST_USER' }->[ 0 ];
}
-sub nav_list_clade
+sub cookie_clade
{
- my ( @dirs, $dir, @list_clade );
+ my ( $cookie,
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( $user, @dirs, $dir );
- @dirs = Maasha::Filesys::ls_dirs( "Data" );
+ $user = $cookie->{ 'DEF_USER' };
+
+ @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user" );
foreach $dir ( @dirs )
{
- next if $dir eq "Data/." or $dir eq "Data/..";
+ next if $dir =~ /\/\.\.?$/;
- push @list_clade, ( split "/", $dir )[ -1 ];
+ push @{ $cookie->{ 'LIST_CLADE' } }, ( split "/", $dir )[ -1 ];
}
- return wantarray ? @list_clade : \@list_clade;
+ if ( not defined $cookie->{ 'DEF_CLADE' } ) {
+ $cookie->{ 'DEF_CLADE' } = $cookie->{ 'LIST_CLADE' }->[ 1 ];
+ }
}
-sub nav_list_genome
+sub cookie_genome
{
- my ( $list_genome );
+ my ( $cookie,
+ ) = @_;
- $list_genome = [ qw( S.aur_COL E.col B.sub ) ];
+ # Returns nothing.
+
+ my ( $user, $clade, @dirs, $dir );
- return wantarray ? @{ $list_genome } : $list_genome;
-}
+ $user = $cookie->{ 'DEF_USER' };
+ $clade = $cookie->{ 'DEF_CLADE' };
+ @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade" );
-sub nav_list_assembly
-{
- my ( $list_assembly );
+ foreach $dir ( @dirs )
+ {
+ next if $dir =~ /\/\.\.?$/;
- $list_assembly = [ qw( 2008-02-21 2009-01-23 ) ];
+ push @{ $cookie->{ 'LIST_GENOME' } }, ( split "/", $dir )[ -1 ];
+ }
- return wantarray ? @{ $list_assembly } : $list_assembly;
+ if ( not defined $cookie->{ 'DEF_GENOME' } ) {
+ $cookie->{ 'DEF_GENOME' } = $cookie->{ 'LIST_GENOME' }->[ 0 ];
+ }
}
-sub nav_list_contig
+sub cookie_assembly
{
- my ( $list_contig );
-
- $list_contig = [ qw( chr1 chr2 ) ];
-
- return wantarray ? @{ $list_contig } : $list_contig;
-}
+ my ( $cookie,
+ ) = @_;
+ # Returns nothing.
+
+ my ( $user, $clade, $genome, @dirs, $dir );
-sub nav_zoom
-{
- my ( $cgi, # CGI object
- ) = @_;
+ $user = $cookie->{ 'DEF_USER' };
+ $clade = $cookie->{ 'DEF_CLADE' };
+ $genome = $cookie->{ 'DEF_GENOME' };
- my ( $start, $end, $dist, $new_dist, $dist_diff, $new_start, $new_end );
+ @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade/$genome" );
- if ( defined $cgi->param( 'nav_start' ) and $cgi->param( 'nav_end' ) )
+ foreach $dir ( @dirs )
{
- $start = $cgi->param( 'nav_start' );
- $end = $cgi->param( 'nav_end' );
-
- $start =~ tr/,//d;
- $end =~ tr/,//d;
-
- $dist = $end - $start;
-
- if ( defined $cgi->param( 'zoom_in1' ) ) {
- $new_dist = $dist / 1.5;
- } elsif ( defined $cgi->param( 'zoom_in2' ) ) {
- $new_dist = $dist / 3;
- } elsif ( defined $cgi->param( 'zoom_in3' ) ) {
- $new_dist = $dist / 10;
- } elsif ( defined $cgi->param( 'zoom_out1' ) ) {
- $new_dist = $dist * 1.5;
- } elsif ( defined $cgi->param( 'zoom_out2' ) ) {
- $new_dist = $dist * 3;
- } elsif ( defined $cgi->param( 'zoom_out3' ) ) {
- $new_dist = $dist * 10;
- }
+ next if $dir =~ /\/\.\.?$/;
- if ( $new_dist )
- {
- $dist_diff = $dist - $new_dist;
- $new_start = int( $start + ( $dist_diff / 2 ) );
- $new_end = int( $end - ( $dist_diff / 2 ) );
+ push @{ $cookie->{ 'LIST_ASSEMBLY' } }, ( split "/", $dir )[ -1 ];
+ }
- $cgi->param( 'nav_start', $new_start );
- $cgi->param( 'nav_end', $new_end );
- }
+ if ( not defined $cookie->{ 'DEF_ASSEMBLY' } ) {
+ $cookie->{ 'DEF_ASSEMBLY' } = $cookie->{ 'LIST_ASSEMBLY' }->[ 0 ];
}
}
-sub nav_move
+sub cookie_contig
{
- my ( $cgi, # CGI object
- $max, # Max end position
+ my ( $cookie,
) = @_;
- my ( $start, $end, $dist, $shift, $new_start, $new_end );
+ # Returns nothing.
+
+ my ( $user, $clade, $genome, $assembly, @dirs, $dir );
- if ( defined $cgi->param( 'nav_start' ) and $cgi->param( 'nav_end' ) )
- {
- $start = $cgi->param( 'nav_start' );
- $end = $cgi->param( 'nav_end' );
-
- $start =~ tr/,//d;
- $end =~ tr/,//d;
-
- $dist = $end - $start;
-
- if ( defined $cgi->param( 'move_left1' ) ) {
- $shift = -1 * $dist * 0.10;
- } elsif ( defined $cgi->param( 'move_left2' ) ) {
- $shift = -1 * $dist * 0.475;
- } elsif ( defined $cgi->param( 'move_left3' ) ) {
- $shift = -1 * $dist * 0.95;
- } elsif ( defined $cgi->param( 'move_right1' ) ) {
- $shift = $dist * 0.10;
- } elsif ( defined $cgi->param( 'move_right2' ) ) {
- $shift = $dist * 0.475;
- } elsif ( defined $cgi->param( 'move_right3' ) ) {
- $shift = $dist * 0.95;
- }
+ $user = $cookie->{ 'DEF_USER' };
+ $clade = $cookie->{ 'DEF_CLADE' };
+ $genome = $cookie->{ 'DEF_GENOME' };
+ $assembly = $cookie->{ 'DEF_ASSEMBLY' };
- if ( $shift )
- {
- $new_start = int( $start + $shift );
- $new_end = int( $end + $shift );
+ @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade/$genome/$assembly" );
- print "HERRRR: shift: $shift start: $new_start end: $new_end\n";
+ foreach $dir ( @dirs )
+ {
+ next if $dir =~ /\/\.\.?$/;
- if ( $new_start > 0 and $new_end < $max )
- {
- $cgi->param( 'nav_start', $new_start );
- $cgi->param( 'nav_end', $new_end );
- }
- }
+ push @{ $cookie->{ 'LIST_CONTIG' } }, ( split "/", $dir )[ -1 ];
+ }
+
+ if ( not defined $cookie->{ 'DEF_CONTIG' } ) {
+ $cookie->{ 'DEF_CONTIG' } = $cookie->{ 'LIST_CONTIG' }->[ 0 ];
}
}
-sub nav_def_clade
+sub cookie_start
{
- my ( $cgi, # CGI object
+ my ( $cookie,
) = @_;
- my ( $def_clade );
+ # Returns nothing.
- if ( defined $cgi->param( 'nav_clade' ) )
+ if ( defined $cookie->{ 'NAV_START' } )
{
- $def_clade = $cgi->param( 'nav_clade' );
+ $cookie->{ 'NAV_START' } =~ tr/,//d;
+ $cookie->{ 'NAV_START' } = 1 if $cookie->{ 'NAV_START' } <= 0;
}
else
{
- $def_clade = "Bacteria";
+ $cookie->{ 'NAV_START' } = 1;
}
-
- return $def_clade;
}
-sub nav_def_genome
+sub cookie_end
{
- my ( $cgi, # CGI object
+ my ( $cookie,
) = @_;
- my ( $def_genome );
+ # Returns nothing.
- if ( defined $cgi->param( 'nav_genome' ) )
+ my ( $max );
+
+ $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) );
+
+ if ( defined $cookie->{ 'NAV_END' } )
{
- $def_genome = $cgi->param( 'nav_genome' );
+ $cookie->{ 'NAV_END' } =~ tr/,//d;
+ $cookie->{ 'NAV_END' } = $max if $cookie->{ 'NAV_END' } > $max;
}
else
{
- $def_genome = "S.aur_COL";
+ $cookie->{ 'NAV_END' } = $max;
}
-
- return $def_genome;
}
-sub nav_def_assembly
+sub cookie_zoom
{
- my ( $cgi, # CGI object
+ my ( $cookie,
) = @_;
- my ( $def_assembly );
+ # Returns nothing.
- if ( defined $cgi->param( 'nav_assembly' ) )
- {
- $def_assembly = $cgi->param( 'nav_assembly' );
+ my ( $max, $dist, $new_dist, $dist_diff );
+
+ $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) );
+
+ $dist = $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' };
+
+ if ( defined $cookie->{ 'ZOOM_IN1' } ) {
+ $new_dist = $dist / 1.5;
+ } elsif ( defined $cookie->{ 'ZOOM_IN2' } ) {
+ $new_dist = $dist / 3;
+ } elsif ( defined $cookie->{ 'ZOOM_IN3' } ) {
+ $new_dist = $dist / 10;
+ } elsif ( defined $cookie->{ 'ZOOM_OUT1' } ) {
+ $new_dist = $dist * 1.5;
+ } elsif ( defined $cookie->{ 'ZOOM_OUT2' } ) {
+ $new_dist = $dist * 3;
+ } elsif ( defined $cookie->{ 'ZOOM_OUT3' } ) {
+ $new_dist = $dist * 10;
}
- else
+
+ if ( $new_dist )
{
- $def_assembly = "2009-01-23";
- }
+ $dist_diff = $dist - $new_dist;
+
+ $cookie->{ 'NAV_START' } = int( $cookie->{ 'NAV_START' } + ( $dist_diff / 2 ) );
+ $cookie->{ 'NAV_END' } = int( $cookie->{ 'NAV_END' } - ( $dist_diff / 2 ) );
- return $def_assembly;
+ $cookie->{ 'NAV_START' } = 1 if $cookie->{ 'NAV_START' } <= 0;
+ $cookie->{ 'NAV_END' } = $max if $cookie->{ 'NAV_END' } > $max;
+ }
}
-sub nav_def_contig
+sub cookie_move
{
- my ( $cgi, # CGI object
+ my ( $cookie,
) = @_;
- my ( $def_contig );
+ my ( $max, $dist, $shift, $new_start, $new_end );
- if ( defined $cgi->param( 'nav_contig' ) )
- {
- $def_contig = $cgi->param( 'nav_contig' );
+ $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) );
+
+ $dist = $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' };
+
+ if ( defined $cookie->{ 'MOVE_LEFT1' } ) {
+ $shift = -1 * $dist * 0.10;
+ } elsif ( defined $cookie->{ 'MOVE_LEFT2' } ) {
+ $shift = -1 * $dist * 0.475;
+ } elsif ( defined $cookie->{ 'MOVE_LEFT3' } ) {
+ $shift = -1 * $dist * 0.95;
+ } elsif ( defined $cookie->{ 'MOVE_RIGHT1' } ) {
+ $shift = $dist * 0.10;
+ } elsif ( defined $cookie->{ 'MOVE_RIGHT2' } ) {
+ $shift = $dist * 0.475;
+ } elsif ( defined $cookie->{ 'MOVE_RIGHT3' } ) {
+ $shift = $dist * 0.95;
}
- else
+
+ if ( $shift )
{
- $def_contig = "chr1";
- }
+ $new_start = int( $cookie->{ 'NAV_START' } + $shift );
+ $new_end = int( $cookie->{ 'NAV_END' } + $shift );
- return $def_contig;
+ if ( $new_start > 0 and $new_end < $max )
+ {
+ $cookie->{ 'NAV_START' } = $new_start;
+ $cookie->{ 'NAV_END' } = $new_end;
+ }
+ }
}
-sub nav_def_start
+sub sec_navigate
{
- my ( $cgi, # CGI object
+ my ( $cookie,
) = @_;
- my ( $def_start );
+ # Returns a list.
- if ( defined $cgi->param( 'nav_start' ) ) {
- $def_start = $cgi->param( 'nav_start' );
- } else {
- $def_start = 1;
- }
+ my ( @html );
- $def_start =~ tr/,//d;
+ push @html, Maasha::XHTML::table_beg( summary => "Navigation table", align => 'center' );
+ 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_clade", options => $cookie->{ 'LIST_CLADE' }, selected => $cookie->{ 'DEF_CLADE' } ),
+ Maasha::XHTML::menu( name => "nav_genome", options => $cookie->{ 'LIST_GENOME' }, selected => $cookie->{ 'DEF_GENOME' } ),
+ Maasha::XHTML::menu( name => "nav_assembly", options => $cookie->{ 'LIST_ASSEMBLY' }, selected => $cookie->{ 'DEF_ASSEMBLY' } ),
+ Maasha::XHTML::menu( name => "nav_contig", options => $cookie->{ 'LIST_CONTIG' }, selected => $cookie->{ 'DEF_CONTIG' } ),
+ Maasha::XHTML::text( name => "nav_start", value => Maasha::Calc::commify( $cookie->{ 'NAV_START' } ), size => 20 ),
+ Maasha::XHTML::text( name => "nav_end", value => Maasha::Calc::commify( $cookie->{ 'NAV_END' } ), size => 20 ),
+ Maasha::XHTML::submit( name => "nav_submit", value => "Submit" ),
+ ] );
+ push @html, Maasha::XHTML::table_end;
- if ( $def_start <= 0 ) {
- $def_start = 1;
- }
+ push @html, Maasha::XHTML::table_beg( summary => "Zoom table", align => 'center' );
+ push @html, Maasha::XHTML::table_row_simple( tr => [
+ Maasha::XHTML::p( txt => 'Move:' ),
+ Maasha::XHTML::submit( name => "move_left3", value => "<<<", title => "move 95% to the left" ),
+ Maasha::XHTML::submit( name => "move_left2", value => "<<", title => "move 47.5% to the left" ),
+ Maasha::XHTML::submit( name => "move_left1", value => "<", title => "move 10% to the left" ),
+ Maasha::XHTML::submit( name => "move_right1", value => ">", title => "move 10% to the rigth" ),
+ Maasha::XHTML::submit( name => "move_right2", value => ">>", title => "move 47.5% to the rigth" ),
+ Maasha::XHTML::submit( name => "move_right3", value => ">>>", title => "move 95% to the right" ),
+ Maasha::XHTML::p( txt => 'Zoom in:' ),
+ Maasha::XHTML::submit( name => "zoom_in1", value => "1.5x" ),
+ Maasha::XHTML::submit( name => "zoom_in2", value => "3x" ),
+ Maasha::XHTML::submit( name => "zoom_in3", value => "10x" ),
+ Maasha::XHTML::p( txt => 'Zoom out:' ),
+ Maasha::XHTML::submit( name => "zoom_out1", value => "1.5x" ),
+ Maasha::XHTML::submit( name => "zoom_out2", value => "3x" ),
+ Maasha::XHTML::submit( name => "zoom_out3", value => "10x" ),
+ ] );
+ push @html, Maasha::XHTML::table_end;
- $cgi->param( 'nav_start', $def_start );
+ @html = Maasha::XHTML::div( txt => join( "\n", @html ), class => 'navigate' );
- return $def_start;
+ return wantarray ? @html : \@html;
}
-sub nav_def_end
+sub sec_browse
{
- my ( $cgi, # CGI object
+ my ( $cookie,
) = @_;
- my ( $def_end );
+ # Returns a list.
+
+ my ( $draw_metrics, @tracks, @features, $feat, $elem, $file, $surface, $cr, @html, @img );
+
+ $draw_metrics = {
+ IMG_WIDTH => 1200,
+ IMG_HEIGHT => 800,
+ TRACK_OFFSET => 20,
+ TRACK_SPACE => 20,
+ RULER_FONT_SIZE => 10,
+ RULER_COLOR => 'black',
+ SEQ_FONT_SIZE => 10,
+ SEQ_COLOR => 'black',
+ FEAT_WIDTH => 5,
+ };
- if ( defined $cgi->param( 'nav_end' ) ) {
- $def_end = $cgi->param( 'nav_end' );
- } else {
- $def_end = 2809422;
- $def_end = 2000;
+ push @features, [ Maasha::KISS::Track::track_ruler( $draw_metrics, $cookie ) ];
+ push @features, [ Maasha::KISS::Track::track_seq( $draw_metrics, $cookie ) ];
+
+ @tracks = Maasha::KISS::Track::path_tracks( $cookie );
+
+ map { push @features, [ Maasha::KISS::Track::track_feature( $_, $draw_metrics, $cookie ) ] } @tracks;
+
+ $file = "fisk.png";
+
+ $surface = Cairo::ImageSurface->create( 'argb32', $draw_metrics->{ 'IMG_WIDTH' }, $draw_metrics->{ 'TRACK_OFFSET' } );
+ $cr = Cairo::Context->create( $surface );
+
+ foreach $feat ( @features ) {
+ Maasha::KISS::Draw::draw_feature( $cr, $feat ) if $feat;
}
- $def_end =~ tr/,//d;
+ Maasha::KISS::Draw::file_png( $surface, $file );
+
+ push @img, Maasha::XHTML::img(
+ src => $file,
+ alt => "Browser Tracks",
+ height => $draw_metrics->{ 'TRACK_OFFSET' },
+ width => $draw_metrics->{ 'IMG_WIDTH' },
+ id => "browser_map",
+ usemap => "#browser_map"
+ );
- if ( $def_end > 2809422 ) {
- $def_end = 2809422;
+ push @img, Maasha::XHTML::map_beg( name => "browser_map", id => "browser_map" );
+
+ foreach $feat ( @features )
+ {
+ foreach $elem ( @{ $feat } )
+ {
+ next if not $elem->{ 'type' } eq 'line';
+
+ push @img, Maasha::XHTML::area(
+ href => "www.dmi.dk",
+ shape => "rect",
+ coords => "$elem->{ x1 }, $elem->{ y1 }, $elem->{ x2 }, $elem->{ y2 }", title => "$elem->{ 'title' }",
+ );
+ }
}
- $cgi->param( 'nav_end', $def_end );
+ push @img, Maasha::XHTML::map_end();
+
+ push @html, Maasha::XHTML::p( txt => join( "\n", @img ) );
+
+ @html = Maasha::XHTML::div( txt => join( "\n", @html ), class => 'browse' );
- return $def_end;
+ return wantarray ? @html : \@html;
}
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-END
-{
- Maasha::SQL::disconnect( $dbh ) if $dbh;
-}
+__END__
+ # push @html, Maasha::KISS::Draw::hdump( $entries );
+ # push @html, Maasha::KISS::Draw::hdump( $features );
-__END__
+ $t0 = Time::HiRes::gettimeofday();
+ $t1 = Time::HiRes::gettimeofday();
projects / biopieces.git / commitdiff