+++ /dev/null
-#!/usr/bin/env perl
-
-# Copyright (C) 2006-2009 Martin A. Hansen.
-
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-
-# http://www.gnu.org/copyleft/gpl.html
-
-# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-use strict;
-use warnings;
-
-use lib "/Users/maasha/biopieces/code_perl/";
-
-use CGI;
-use Data::Dumper;
-use Time::HiRes;
-use Maasha::Common;
-use Maasha::Filesys;
-use Maasha::Calc;
-use Maasha::XHTML;
-use Maasha::KISS::IO;
-use Maasha::KISS::Track;
-use Maasha::KISS::Draw;
-
-my ( $cgi, $cookie, @html );
-
-$cgi = new CGI;
-$cookie = cookie_default( $cgi );;
-
-push @html, Maasha::XHTML::html_header(
- cgi_header => 1,
- title => "KISS Genome Browser",
- css_file => "kiss.css",
- author => "Martin A. Hansen, mail\@maasha.dk",
- description => "Biopieces bacterial genome browser - KISS",
- keywords => [ qw( KISS Biopieces biopiece genome browser viewer bacterium bacteria prokaryote prokaryotes ) ],
- no_cache => 1,
-);
-
-push @html, Maasha::XHTML::h1( txt => "KISS Genome Browser", class => 'center' );
-push @html, Maasha::XHTML::form_beg( action => $cookie->{ 'SCRIPT' }, method => "get", enctype => "multipart/form-data" );
-
-push @html, page( $cookie );
-
-push @html, Maasha::XHTML::form_end;
-push @html, Maasha::XHTML::body_end;
-push @html, Maasha::XHTML::html_end;
-
-# push @html, Maasha::KISS::Draw::hdump( $cgi->param );
-# push @html, Maasha::KISS::Draw::hdump( $cookie );
-
-print "$_\n" foreach @html;
-
-
-# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-
-sub cookie_default
-{
- my ( $cgi, # CGI object
- ) = @_;
-
- # Returns a hash
-
- my ( $cookie, $path );
-
- $cookie = {};
-
- $cookie->{ 'SCRIPT' } = Maasha::Common::get_scriptname();
- $cookie->{ 'DATA_DIR' } = "Data";
- $cookie->{ 'LIST_PAGES' } = [ qw( user clade genome assembly contig browse ) ];
- $cookie->{ 'PAGE' } = $cgi->param( 'page' ) || 'user';
- $cookie->{ 'USER' } = $cgi->param( 'user' ) || '';
- $cookie->{ 'CLADE' } = $cgi->param( 'clade' ) || '';
- $cookie->{ 'GENOME' } = $cgi->param( 'genome' ) || '';
- $cookie->{ 'ASSEMBLY' } = $cgi->param( 'assembly' ) || '';
- $cookie->{ 'CONTIG' } = $cgi->param( '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' );
-
- $path = "$cookie->{ 'DATA_DIR' }/Users";
-
- $cookie->{ 'LIST_USER' } = ls_dir_base( $path ) if -d $path;
-
- $path .= "/$cookie->{ 'USER' }";
-
- $cookie->{ 'LIST_CLADE' } = ls_dir_base( $path ) if -d $path;
-
- $path .= "/$cookie->{ 'CLADE' }";
-
- $cookie->{ 'LIST_GENOME' } = ls_dir_base( $path ) if -d $path;
-
- $path .= "/$cookie->{ 'GENOME' }";
-
- $cookie->{ 'LIST_ASSEMBLY' } = ls_dir_base( $path ) if -d $path;
-
- $path .= "/$cookie->{ 'ASSEMBLY' }";
-
- $cookie->{ 'LIST_CONTIG' } = ls_dir_base( $path ) if -d $path;
-
- if ( $cookie->{ 'CONTIG' } )
- {
- cookie_start( $cookie );
- cookie_end( $cookie );
- cookie_zoom( $cookie );
- cookie_move( $cookie );
- }
-
- return wantarray ? %{ $cookie } : $cookie;
-}
-
-
-sub ls_dir_base
-{
- my ( $path,
- ) = @_;
-
- # Returns a list.
-
- my ( @dirs, $dir, @list );
-
- @dirs = Maasha::Filesys::ls_dirs( $path );
-
- foreach $dir ( @dirs )
- {
- next if $dir =~ /\/\.\.?$/;
-
- push @list, ( split "/", $dir )[ -1 ];
- }
-
- return wantarray ? @list : \@list;
-}
-
-
-sub cookie_clade
-{
- my ( $cookie,
- ) = @_;
-
- # Returns nothing.
-
- my ( $user, @dirs, $dir );
-
- $user = $cookie->{ 'USER' };
-
- @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user" );
-
- foreach $dir ( @dirs )
- {
- next if $dir =~ /\/\.\.?$/;
-
- push @{ $cookie->{ 'LIST_CLADE' } }, ( split "/", $dir )[ -1 ];
- }
-}
-
-
-sub cookie_genome
-{
- my ( $cookie,
- ) = @_;
-
- # Returns nothing.
-
- my ( $user, $clade, @dirs, $dir );
-
- $user = $cookie->{ 'USER' };
- $clade = $cookie->{ 'CLADE' };
-
- @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade" );
-
- foreach $dir ( @dirs )
- {
- next if $dir =~ /\/\.\.?$/;
-
- push @{ $cookie->{ 'LIST_GENOME' } }, ( split "/", $dir )[ -1 ];
- }
-}
-
-
-sub cookie_assembly
-{
- my ( $cookie,
- ) = @_;
-
- # Returns nothing.
-
- my ( $user, $clade, $genome, @dirs, $dir );
-
- $user = $cookie->{ 'USER' };
- $clade = $cookie->{ 'CLADE' };
- $genome = $cookie->{ 'GENOME' };
-
- @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade/$genome" );
-
- foreach $dir ( @dirs )
- {
- next if $dir =~ /\/\.\.?$/;
-
- push @{ $cookie->{ 'LIST_ASSEMBLY' } }, ( split "/", $dir )[ -1 ];
- }
-}
-
-
-sub cookie_contig
-{
- my ( $cookie,
- ) = @_;
-
- # Returns nothing.
-
- my ( $user, $clade, $genome, $assembly, @dirs, $dir );
-
- $user = $cookie->{ 'USER' };
- $clade = $cookie->{ 'CLADE' };
- $genome = $cookie->{ 'GENOME' };
- $assembly = $cookie->{ 'ASSEMBLY' };
-
- @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade/$genome/$assembly" );
-
- foreach $dir ( @dirs )
- {
- next if $dir =~ /\/\.\.?$/;
-
- push @{ $cookie->{ 'LIST_CONTIG' } }, ( split "/", $dir )[ -1 ];
- }
-}
-
-
-sub cookie_start
-{
- my ( $cookie,
- ) = @_;
-
- # Returns nothing.
-
- if ( defined $cookie->{ 'NAV_START' } )
- {
- $cookie->{ 'NAV_START' } =~ tr/,//d;
- $cookie->{ 'NAV_START' } = 1 if $cookie->{ 'NAV_START' } <= 0;
- }
- else
- {
- $cookie->{ 'NAV_START' } = 1;
- }
-}
-
-
-sub cookie_end
-{
- my ( $cookie,
- ) = @_;
-
- # Returns nothing.
-
- my ( $max );
-
- $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) );
-
- if ( defined $cookie->{ 'NAV_END' } )
- {
- $cookie->{ 'NAV_END' } =~ tr/,//d;
- $cookie->{ 'NAV_END' } = $max if $cookie->{ 'NAV_END' } > $max;
- }
- else
- {
- $cookie->{ 'NAV_END' } = $max;
- }
-}
-
-
-sub cookie_zoom
-{
- my ( $cookie,
- ) = @_;
-
- # Returns nothing.
-
- 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;
- }
-
- if ( $new_dist )
- {
- $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 ) );
-
- $cookie->{ 'NAV_START' } = 1 if $cookie->{ 'NAV_START' } <= 0;
- $cookie->{ 'NAV_END' } = $max if $cookie->{ 'NAV_END' } > $max;
- }
-}
-
-
-sub cookie_move
-{
- my ( $cookie,
- ) = @_;
-
- my ( $max, $dist, $shift, $new_start, $new_end );
-
- $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;
- }
-
- if ( $shift )
- {
- $new_start = int( $cookie->{ 'NAV_START' } + $shift );
- $new_end = int( $cookie->{ 'NAV_END' } + $shift );
-
- if ( $new_start > 0 and $new_end < $max )
- {
- $cookie->{ 'NAV_START' } = $new_start;
- $cookie->{ 'NAV_END' } = $new_end;
- }
- }
-}
-
-
-sub page
-{
- my ( $cookie,
- ) = @_;
-
- # Returns a list.
-
- my ( @html, $list, $item, $href );
-
- push @html, breadcrumb( $cookie );
-
- $list = "LIST_" . uc $cookie->{ 'PAGE' };
-
- if ( $cookie->{ 'PAGE' } eq 'export' )
- {
- push @html, Maasha::XHTML::h2( txt => "Export", class => 'center' );
- }
- elsif ( $cookie->{ 'PAGE' } ne 'browse' )
- {
- push @html, Maasha::XHTML::h2( txt => "Select $cookie->{ 'PAGE' }", class => 'center' );
-
- push @html, Maasha::XHTML::table_beg( summary => "Select table", align => 'center', cellpadding => '5px' );
-
- foreach $item ( @{ $cookie->{ $list } } )
- {
- $cookie->{ uc $cookie->{ 'PAGE' } } = $item;
-
- $href = page_href( $cookie, page_next( $cookie ) );
-
- push @html, Maasha::XHTML::table_row_simple( tr => [ Maasha::XHTML::ln( txt => $item, href => $href ) ] );
- }
-
- push @html, Maasha::XHTML::table_end;
- }
- else
- {
- push @html, sec_navigate( $cookie );
- push @html, sec_browse( $cookie );
- }
-
- return wantarray ? @html : \@html;
-}
-
-
-sub page_next
-{
- my ( $cookie,
- ) = @_;
-
- my ( $i );
-
- for ( $i = 0; $i < @{ $cookie->{ 'LIST_PAGES' } }; $i++ ) {
- last if $cookie->{ 'PAGE' } eq $cookie->{ 'LIST_PAGES' }->[ $i ];
- }
-
- return $cookie->{ 'LIST_PAGES' }->[ $i + 1 ];
-}
-
-
-sub breadcrumb
-{
- my ( $cookie,
- ) = @_;
-
- # Returns a list.
-
- my ( @pages, $page, @row1, @row2, @html, $href, $txt );
-
- @pages = @{ $cookie->{ 'LIST_PAGES' } };
-
- pop @pages; # remove 'browse'
-
- foreach $page ( @pages )
- {
- $href = page_href( $cookie, $page );
-
- $txt = $cookie->{ uc $page } || "";
-
- push @row1, Maasha::XHTML::ln( txt => $page, href => $href, class => 'inline' );
- push @row2, Maasha::XHTML::p( txt => $txt, class => 'inline' );
-
- last if $page eq $cookie->{ 'PAGE' };
- }
-
- push @html, Maasha::XHTML::table_beg( summary => "Taxonomy table", align => 'center', cellpadding => '5px' );
- push @html, Maasha::XHTML::table_row_simple( tr => \@row1, align => 'center' );
- push @html, Maasha::XHTML::table_row_simple( tr => \@row2, align => 'center' );
- push @html, Maasha::XHTML::table_end;
-
- return wantarray ? @html : \@html;
-}
-
-
-sub page_href
-{
- my ( $cookie,
- $page,
- ) = @_;
-
- # Returns a string.
-
- my ( @href );
-
- while ( 1 )
- {
- push @href, "$cookie->{ 'SCRIPT' }?page=$page";
- push @href, "user=$cookie->{ 'USER' }" if $cookie->{ 'USER' };
- last if $page eq 'user';
- push @href, "clade=$cookie->{ 'CLADE' }" if $cookie->{ 'CLADE' };
- last if $page eq 'clade';
- push @href, "genome=$cookie->{ 'GENOME' }" if $cookie->{ 'GENOME' };
- last if $page eq 'genome';
- push @href, "assembly=$cookie->{ 'ASSEMBLY' }" if $cookie->{ 'ASSEMBLY' };
- last if $page eq 'assembly';
- push @href, "contig=$cookie->{ 'CONTIG' }" if $cookie->{ 'CONTIG' };
- last if $page eq 'contig';
- last;
- }
-
- return join "&", @href;
-}
-
-
-sub sec_navigate
-{
- my ( $cookie,
- ) = @_;
-
- # Returns a list.
-
- my ( @html );
-
- push @html, Maasha::XHTML::table_beg( summary => "Navigation table", align => 'center' );
- push @html, Maasha::XHTML::table_row_simple( tr => [ qw( Start End ) ], align => 'center' );
- push @html, Maasha::XHTML::table_row_simple( tr => [
- 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;
-
- 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;
-
- push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "page", value => "browse" ) );
- push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "user", value => "$cookie->{ 'USER' }" ) );
- push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "clade", value => "$cookie->{ 'CLADE' }" ) );
- push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "genome", value => "$cookie->{ 'GENOME' }" ) );
- push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "assembly", value => "$cookie->{ 'ASSEMBLY' }" ) );
- push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "contig", value => "$cookie->{ 'CONTIG' }" ) );
-
- return wantarray ? @html : \@html;
-}
-
-
-sub sec_browse
-{
- my ( $cookie,
- ) = @_;
-
- # Returns a list.
-
- my ( $draw_metrics, @tracks, $i, @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 => [ 0, 0, 0 ],
- SEQ_FONT_SIZE => 10,
- SEQ_COLOR => [ 0, 0, 0, ],
- FEAT_WIDTH => 5,
- FEAT_COLOR => [ 0, 1, 0 ],
- };
-
- 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 );
-
- for ( $i = 0; $i < @tracks; $i++ )
- {
- $draw_metrics->{ 'FEAT_COLOR' } = palette( $i );
-
- push @features, [ Maasha::KISS::Track::track_feature( $tracks[ $i ], $draw_metrics, $cookie ) ];
- }
-
- $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;
- }
-
- 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"
- );
-
- push @img, Maasha::XHTML::map_beg( name => "browser_map", id => "browser_map" );
-
- foreach $feat ( @features )
- {
- foreach $elem ( @{ $feat } )
- {
- next if $elem->{ 'type' } eq 'text';
-
- push @img, Maasha::XHTML::area(
- href => page_href( $cookie, "export" ) . "&Q_ID=$elem->{ 'id' }",
- shape => "rect",
- coords => "$elem->{ x1 }, $elem->{ y1 }, $elem->{ x2 }, $elem->{ y2 }", title => "$elem->{ 'title' }",
- );
- }
- }
-
- 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;
-}
-
-
-sub palette
-{
- my ( $i,
- ) = @_;
-
- my ( $palette, $color );
-
- $palette = [
- [ 30, 130, 130 ],
- [ 30, 50, 150 ],
- [ 130, 130, 50 ],
- [ 130, 90, 130 ],
- [ 130, 70, 70 ],
- [ 70, 170, 130 ],
- [ 130, 170, 50 ],
- ];
-
- $color = $palette->[ $i ];
-
- map { $_ /= 255 } @{ $color };
-
- return $color;
-}
-
-# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-
-__END__
-
- # push @html, Maasha::KISS::Draw::hdump( $features );
-
- $t0 = Time::HiRes::gettimeofday();
- $t1 = Time::HiRes::gettimeofday();
+++ /dev/null
-/* CSS test /*
-
-/* Martin A. Hansen, July 2005 /*
-/* email: mail@maasha.dk */
-
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SUGGESTED READING <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-/*
-/*
-/* http://www.w3.org/TR/CSS21/
-/* http://www.w3.org/TR/CSS21/propidx.html
-/* http://www.w3schools.com/css/css_reference.asp
-/* http://htmldog.com/guides/cssbeginner/
-/* http://htmldog.com/guides/cssintermediate/
-/* http://htmldog.com/guides/cssadvanced/
-/*
-/*
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> UNITS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-/*
-/*
-/* Unit Description
-/* % a percentage of something
-/* in inch
-/* cm centimeter
-/* mm millimeter
-/* em one em is equal to the font size of the current element
-/* ex one ex is the x-height of a font, the x-height is usually about half the font-size
-/* pt point (1 pt is the same as 1/72 inch)
-/* pc pica (1 pc is the same as 12 points)
-/* px pixels (a dot on the computer screen)
-/*
-/*
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> COLORS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-/*
-/*
-/* Examples (all give the same result):
-/* red
-/* rgb(255,0,0)
-/* rgb(100%,0%,0%)
-/* #ff0000
-/* #f00
-/*
-/* There are 16 valid predefined colour names:
-/* aqua
-/* black
-/* blue
-/* fuchsia
-/* gray
-/* green
-/* lime
-/* maroon,
-/* navy
-/* olive
-/* purple
-/* red,
-/* silver
-/* teal
-/* white
-/* yellow
-/*
-/* transparent is also valid
-/*
-/*
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> PROPERTIES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-/*
-/*
-/* background-attachment
-/* background-color
-/* background-image
-/* background-position
-/* background-repeat
-/* background
-/* border-collapse
-/* border-color
-/* border-spacing
-/* border-style
-/* border-top border-right border-bottom border-left
-/* border-top-color border-right-color border-bottom-color border-left-color
-/* border-top-style border-right-style border-bottom-style border-left-style
-/* border-top-width border-right-width border-bottom-width border-left-width
-/* border-width
-/* border
-/* bottom
-/* caption-side
-/* clear
-/* clip
-/* color
-/* content
-/* counter-increment
-/* counter-reset
-/* cursor
-/* direction
-/* display
-/* empty-cells
-/* float
-/* font-family
-/* font-size
-/* font-style
-/* font-variant
-/* font-weight
-/* font
-/* height
-/* left
-/* letter-spacing
-/* line-height
-/* list-style-image
-/* list-style-position
-/* list-style-type
-/* list-style
-/* margin-right margin-left
-/* margin-top margin-bottom
-/* margin
-/* max-height
-/* max-width
-/* min-height
-/* min-width
-/* orphans
-/* outline-color
-/* outline-style
-/* outline-width
-/* outline
-/* overflow
-/* padding-top padding-right padding-bottom padding-left
-/* padding
-/* page-break-after
-/* page-break-before
-/* page-break-inside
-/* position
-/* quotes
-/* right
-/* table-layout
-/* text-align
-/* text-decoration
-/* text-indent
-/* text-transform
-/* top
-/* unicode-bidi
-/* vertical-align
-/* visibility
-/* white-space
-/* widows
-/* width
-/* word-spacing
-/* z-index
-/*
-/*
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTORS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-/*
-/*
-/* Name Values
-/* ---- ------
-/* ascent <number>
-/* baseline <number>
-/* bbox <number>, <number>, <number>, <number>
-/* cap-height <number>
-/* centerline <number>
-/* definition-src <uri>
-/* descent <number>
-/* font-family [ <family-name> | <generic-family> ] [, [<family-name> | <generic-family> ]]
-/* font-size all | <length> [, <length>]
-/* font-stretch all | [ normal | ultra-condensed | extra-condensed | condensed | semi-condensed | semi-expanded | expanded | extra-expanded | ultra-expanded ] [, [ normal |
-/* ultra-condensed | extra-condensed | condensed | semi-condensed | semi-expanded | expanded | extra-expanded | ultra-expanded] ]
-/* font-style all | [ normal | italic | oblique ] [, [normal | italic | oblique] ]
-/* font-variant [normal | small-caps] [,[normal | small-caps]]
-/* font-weight all | [normal | bold | 100 | 200 | 300 | 400 | 500 | 600 | 700 | 800 | 900] [, [normal | bold | 100 | 200 | 300 | 400 | 500 | 600 | 700 | 800 | 900]]
-/* mathline <number>
-/* panose-1 [<integer>]{10}
-/* slope <number>
-/* src [ <uri> [format(<string> [, <string>]*)] | <font-face-name> ] [, <uri> [format(<string> [, <string>]*)] | <font-face-name> ]
-/* stemh <number>
-/* stemv <number>
-/* topline <number>
-/* unicode-range <urange> [, <urange>]
-/* units-per-em <number>
-/* widths [<urange> ]? [<number> ]+ [,[<urange> ]? <number> ]+]
-/* x-height <number>
-/*
-/*
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-
-
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> PROPERTY & VALUE EXAMPLES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-/*
-/*
-/* color: yellow;
-/* background-color: blue;
-/* font-family: "Times New Roman", arial, helvetica, serif;
-/* font-size: 0.8em;
-/* text-decoration: none;
-/* font-style: italic;
-/* text-transform: uppercase;
-/* letter-spacing: 0.5em;
-/* word-spacing: 2em;
-/* line-height: 1.5em;
-/* text-align: center;
-/* margin: 1em;
-/* padding: 3em;
-/* border-style: dashed;
-/* border-width: 3px;
-/* border-left-width: 10px;
-/* border-right-width: 10px;
-/* border-color: red;
-/*
-/*
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-
-
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DIV <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< */
-
-div.navigate {
-
-}
-
-div.browse {
- text-align: center;
-}
-
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> GENERIC CLASSES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< */
-
-
-.bold {
- font-weight: bold;
-}
-
-
-.italic {
- font-style: italic;
-}
-
-
-.oblique {
- font-style: oblique;
-}
-
-
-.align_right {
- text-align: right;
-}
-
-
-.align_center {
- text-align: center;
-}
-
-.inline {
- display: inline;
-}
-
-
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> HEADINGS AND PARAGRAPH <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< */
-
-
-h1.right {
- text-align: right
-}
-
-h1.center {
- text-align: center
-}
-
-h2.right {
- text-align: right
-}
-
-h2.center {
- text-align: center
-}
-
-h3.right {
- text-align: right
-}
-
-h3.center {
- text-align: center
-}
-
-h4.right {
- text-align: right
-}
-
-h4.center {
- text-align: center
-}
-
-h5.right {
- text-align: right
-}
-
-h5.center {
- text-align: center
-}
-
-h6.right {
- text-align: right
-}
-
-h6.center {
- text-align: center
-}
-
-p.right {
- text-align: right
-}
-
-p.center {
- text-align: center
-}
-
-
-/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< */
--- /dev/null
+#!/usr/bin/env perl
+
+# Copyright (C) 2006-2009 Martin A. Hansen.
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+
+# http://www.gnu.org/copyleft/gpl.html
+
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+use strict;
+use warnings;
+
+use lib "/Users/maasha/biopieces/code_perl/"; # FIXME should be shell and httpd env variable
+
+use CGI;
+use Data::Dumper;
+use Maasha::Common;
+use Maasha::Filesys;
+use Maasha::Calc;
+use Maasha::XHTML;
+use Maasha::KISS::IO;
+use Maasha::KISS::Track;
+use Maasha::KISS::Draw;
+
+my ( $cgi, $cookie, @html );
+
+$cgi = new CGI;
+$cookie = cookie_default( $cgi );;
+
+push @html, Maasha::XHTML::html_header(
+ cgi_header => 1,
+ title => "Biopieces Genome Browser",
+ css_file => "bgb.css",
+ author => "Martin A. Hansen, mail\@maasha.dk",
+ description => "Biopieces Genome Browser",
+ keywords => [ qw( Biopieces biopiece genome browser viewer bacterium bacteria prokaryote prokaryotes ) ],
+ no_cache => 1,
+);
+
+push @html, Maasha::XHTML::h1( txt => "Biopieces Genome Browser", class => 'center' );
+push @html, Maasha::XHTML::form_beg( action => $cookie->{ 'SCRIPT' }, method => "get", enctype => "multipart/form-data" );
+
+push @html, page( $cookie );
+
+push @html, Maasha::XHTML::form_end;
+push @html, Maasha::XHTML::body_end;
+push @html, Maasha::XHTML::html_end;
+
+# push @html, Maasha::KISS::Draw::hdump( $cgi->param ); # DEBUG
+# push @html, Maasha::KISS::Draw::hdump( $cookie ); # DEBUG
+
+print "$_\n" foreach @html;
+
+
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> COOKIE <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
+sub cookie_default
+{
+ # Martin A. Hansen, November 2009.
+
+ # Set a cookie with values from the CGI object or defaults.
+
+ my ( $cgi, # CGI object
+ ) = @_;
+
+ # Returns a hash.
+
+ my ( $cookie, $path );
+
+ $cookie = {};
+
+ $cookie->{ 'SCRIPT' } = Maasha::Common::get_scriptname();
+ $cookie->{ 'DATA_DIR' } = "Data";
+ $cookie->{ 'LIST_PAGES' } = [ qw( user clade genome assembly contig browse ) ];
+ $cookie->{ 'PAGE' } = $cgi->param( 'page' ) || 'user';
+ $cookie->{ 'USER' } = $cgi->param( 'user' ) || '';
+ $cookie->{ 'CLADE' } = $cgi->param( 'clade' ) || '';
+ $cookie->{ 'GENOME' } = $cgi->param( 'genome' ) || '';
+ $cookie->{ 'ASSEMBLY' } = $cgi->param( 'assembly' ) || '';
+ $cookie->{ 'CONTIG' } = $cgi->param( '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' );
+
+ $cookie->{ 'IMG_WIDTH' } = 1200;
+ $cookie->{ 'IMG_HEIGHT' } = 800;
+ $cookie->{ 'TRACK_OFFSET' } = 20;
+ $cookie->{ 'TRACK_SPACE' } = 20;
+ $cookie->{ 'RULER_FONT_SIZE' } = 10;
+ $cookie->{ 'RULER_COLOR' } = [ 0, 0, 0 ];
+ $cookie->{ 'SEQ_FONT_SIZE' } = 10;
+ $cookie->{ 'SEQ_COLOR' } = [ 0, 0, 0, ];
+ $cookie->{ 'FEAT_WIDTH' } = 5;
+ $cookie->{ 'FEAT_COLOR' } = [ 0, 0, 0 ];
+
+ $path = "$cookie->{ 'DATA_DIR' }/Users";
+
+ $cookie->{ 'LIST_USER' } = Maasha::Filesys::ls_dirs_base( $path ) if -d $path;
+
+ $path .= "/$cookie->{ 'USER' }";
+
+ $cookie->{ 'LIST_CLADE' } = Maasha::Filesys::ls_dirs_base( $path ) if -d $path;
+
+ $path .= "/$cookie->{ 'CLADE' }";
+
+ $cookie->{ 'LIST_GENOME' } = Maasha::Filesys::ls_dirs_base( $path ) if -d $path;
+
+ $path .= "/$cookie->{ 'GENOME' }";
+
+ $cookie->{ 'LIST_ASSEMBLY' } = Maasha::Filesys::ls_dirs_base( $path ) if -d $path;
+
+ $path .= "/$cookie->{ 'ASSEMBLY' }";
+
+ $cookie->{ 'LIST_CONTIG' } = Maasha::Filesys::ls_dirs_base( $path ) if -d $path;
+
+ if ( $cookie->{ 'CONTIG' } )
+ {
+ cookie_start( $cookie );
+ cookie_end( $cookie );
+ cookie_zoom( $cookie );
+ cookie_move( $cookie );
+ }
+
+ return wantarray ? %{ $cookie } : $cookie;
+}
+
+
+sub cookie_start
+{
+ # Martin A. Hansen, November 2009.
+
+ # Decommify the cookie value for NAV_START and adjust it to
+ # to prevent negative values.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ # Returns nothing.
+
+ if ( defined $cookie->{ 'NAV_START' } )
+ {
+ $cookie->{ 'NAV_START' } =~ tr/,//d;
+ $cookie->{ 'NAV_START' } = 1 if $cookie->{ 'NAV_START' } <= 0;
+ }
+ else
+ {
+ $cookie->{ 'NAV_START' } = 1;
+ }
+}
+
+
+sub cookie_end
+{
+ # Martin A. Hansen, November 2009.
+
+ # Decommify the cookie value for NAV_END and adjust it to prevent
+ # overshooting the max value for the contig size as determined
+ # from the cookie.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( $max );
+
+ $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) );
+
+ if ( defined $cookie->{ 'NAV_END' } )
+ {
+ $cookie->{ 'NAV_END' } =~ tr/,//d;
+ $cookie->{ 'NAV_END' } = $max if $cookie->{ 'NAV_END' } > $max;
+ }
+ else
+ {
+ $cookie->{ 'NAV_END' } = $max;
+ }
+}
+
+
+sub cookie_zoom
+{
+ # Martin A. Hansen, November 2009.
+
+ # Adjust the cookie values for NAV_START and NAV_END based
+ # on cookie ZOOM values.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ # Returns nothing.
+
+ 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;
+ }
+
+ if ( $new_dist )
+ {
+ $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 ) );
+
+ $cookie->{ 'NAV_START' } = 1 if $cookie->{ 'NAV_START' } <= 0;
+ $cookie->{ 'NAV_END' } = $max if $cookie->{ 'NAV_END' } > $max;
+ }
+}
+
+
+sub cookie_move
+{
+ # Martin A. Hansen, November 2009.
+
+ # Adjust the cookie values for NAV_START and NAV_END based
+ # on cookie MOVE values.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ my ( $max, $dist, $shift, $new_start, $new_end );
+
+ $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;
+ }
+
+ if ( $shift )
+ {
+ $new_start = int( $cookie->{ 'NAV_START' } + $shift );
+ $new_end = int( $cookie->{ 'NAV_END' } + $shift );
+
+ if ( $new_start > 0 and $new_end < $max )
+ {
+ $cookie->{ 'NAV_START' } = $new_start;
+ $cookie->{ 'NAV_END' } = $new_end;
+ }
+ }
+}
+
+
+sub cookie_href
+{
+ # Martin A. Hansen, November 2009.
+
+ # Returns the href for a taxonomy path terminated at a given
+ # page using information stored in a cookie.
+
+ my ( $cookie, # cookie hash
+ $page, # page
+ ) = @_;
+
+ # Returns a string.
+
+ my ( @href );
+
+ while ( 1 )
+ {
+ push @href, "$cookie->{ 'SCRIPT' }?page=$page";
+ push @href, "user=$cookie->{ 'USER' }" if $cookie->{ 'USER' };
+ last if $page eq 'user';
+ push @href, "clade=$cookie->{ 'CLADE' }" if $cookie->{ 'CLADE' };
+ last if $page eq 'clade';
+ push @href, "genome=$cookie->{ 'GENOME' }" if $cookie->{ 'GENOME' };
+ last if $page eq 'genome';
+ push @href, "assembly=$cookie->{ 'ASSEMBLY' }" if $cookie->{ 'ASSEMBLY' };
+ last if $page eq 'assembly';
+ push @href, "contig=$cookie->{ 'CONTIG' }" if $cookie->{ 'CONTIG' };
+ last if $page eq 'contig';
+ last;
+ }
+
+ return join "&", @href;
+}
+
+
+sub cookie_page_next
+{
+ # Martin A. Hansen, November 2009.
+
+ # Returns the next page in the taxonomy path.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ # Returns a string.
+
+ my ( $i );
+
+ for ( $i = 0; $i < @{ $cookie->{ 'LIST_PAGES' } }; $i++ ) {
+ last if $cookie->{ 'PAGE' } eq $cookie->{ 'LIST_PAGES' }->[ $i ];
+ }
+
+ return $cookie->{ 'LIST_PAGES' }->[ $i + 1 ];
+}
+
+
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> PAGES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
+sub page
+{
+ # Martin A. Hansen, November 2009.
+
+ # Determines what page to render based on
+ # the cookie's PAGE setting.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ # Returns a list.
+
+ my ( @html );
+
+ if ( $cookie->{ 'PAGE' } eq 'export' ) {
+ push @html, page_export( $cookie );
+ } elsif ( $cookie->{ 'PAGE' } eq 'browse' ) {
+ push @html, page_browse( $cookie );
+ } else {
+ push @html, page_taxonomy( $cookie );
+ }
+
+ return wantarray ? @html : \@html;
+}
+
+
+sub page_export
+{
+ # Martin A. Hansen, November 2009.
+
+ # Renders the export page.
+
+ my ( $cookie,
+ ) = @_;
+
+ # Returns a list.
+
+ push @html, section_taxonomy_table( $cookie );
+ push @html, section_export( $cookie );
+
+ return wantarray ? @html : \@html;
+}
+
+
+sub page_browse
+{
+ # Martin A. Hansen, November 2009.
+
+ # Renders the browse page.
+
+ my ( $cookie,
+ ) = @_;
+
+ # Returns a list.
+
+ my ( @html );
+
+ push @html, section_taxonomy_table( $cookie );
+ push @html, section_navigate( $cookie );
+ push @html, section_browse( $cookie );
+
+ return wantarray ? @html : \@html;
+}
+
+
+sub page_taxonomy
+{
+ # Martin A. Hansen, November 2009.
+
+ # Renders the browse page.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ # Returns a list.
+
+ my ( @html );
+
+ push @html, section_taxonomy_table( $cookie );
+ push @html, section_taxonomy_select( $cookie );
+
+ return wantarray ? @html : \@html;
+}
+
+
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SECTIONS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
+sub section_taxonomy_table
+{
+ # Martin A. Hansen, November 2009.
+
+ # Returns a HTML section with a taxonomy table
+ # showing the location in the taxonomy and with
+ # links to browse the taxonomy.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ # Returns a list.
+
+ my ( $page, @row, @html, $href, $txt );
+
+ foreach $page ( @{ $cookie->{ 'LIST_PAGES' } } )
+ {
+ last if $page eq $cookie->{ 'PAGE' };
+
+ $href = cookie_href( $cookie, $page );
+
+ $txt = ": $cookie->{ uc $page }";
+
+ push @row, Maasha::XHTML::ln( txt => $page, href => $href, class => 'inline' );
+ push @row, Maasha::XHTML::p( txt => $txt, class => 'inline' );
+ }
+
+ push @html, Maasha::XHTML::table_beg( summary => "Taxonomy table", align => 'center', cellpadding => '5px' );
+ push @html, Maasha::XHTML::table_row_simple( tr => [ join( " ", @row ) ], align => 'center' );
+ push @html, Maasha::XHTML::table_end;
+
+ return wantarray ? @html : \@html;
+}
+
+
+sub section_taxonomy_select
+{
+ # Martin A. Hansen, November 2009.
+
+ # Returns a HTML section with selection choices
+ # for navigating the taxonomy tree.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ # Returns a list.
+
+ my ( $list, @html, $item, $href );
+
+ $list = "LIST_" . uc $cookie->{ 'PAGE' };
+
+ push @html, Maasha::XHTML::h2( txt => "Select $cookie->{ 'PAGE' }", class => 'center' );
+
+ push @html, Maasha::XHTML::table_beg( summary => "Select table", align => 'center', cellpadding => '5px' );
+
+ foreach $item ( @{ $cookie->{ $list } } )
+ {
+ $cookie->{ uc $cookie->{ 'PAGE' } } = $item;
+
+ $href = cookie_href( $cookie, cookie_page_next( $cookie ) );
+
+ push @html, Maasha::XHTML::table_row_simple( tr => [ Maasha::XHTML::ln( txt => $item, href => $href ) ] );
+ }
+
+ push @html, Maasha::XHTML::table_end;
+
+ return wantarray ? @html : \@html;
+}
+
+
+sub section_navigate
+{
+ # Martin A. Hansen, November 2009.
+
+ # Returns a HTML section for navigating in the browser window.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ # Returns a list.
+
+ my ( @html );
+
+ push @html, Maasha::XHTML::table_beg( summary => "Navigation table", align => 'center' );
+ push @html, Maasha::XHTML::table_row_simple( tr => [
+ "Start:",
+ Maasha::XHTML::text( name => "nav_start", value => Maasha::Calc::commify( $cookie->{ 'NAV_START' } ), size => 20 ),
+ "End:",
+ 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;
+
+ 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;
+
+ push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "page", value => "browse" ) );
+ push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "user", value => "$cookie->{ 'USER' }" ) );
+ push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "clade", value => "$cookie->{ 'CLADE' }" ) );
+ push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "genome", value => "$cookie->{ 'GENOME' }" ) );
+ push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "assembly", value => "$cookie->{ 'ASSEMBLY' }" ) );
+ push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "contig", value => "$cookie->{ 'CONTIG' }" ) );
+
+ return wantarray ? @html : \@html;
+}
+
+
+sub section_browse
+{
+ my ( $cookie,
+ ) = @_;
+
+ # Returns a list.
+
+ my ( @tracks, $i, @features, $feat, $elem, $file, $surface, $cr, @html, @img );
+
+ push @features, [ Maasha::KISS::Track::track_ruler( $cookie ) ];
+ push @features, [ Maasha::KISS::Track::track_seq( $cookie ) ];
+
+ @tracks = Maasha::KISS::Track::path_tracks( $cookie );
+
+ for ( $i = 0; $i < @tracks; $i++ )
+ {
+ $cookie->{ 'FEAT_COLOR' } = Maasha::KISS::Draw::palette( $i );
+
+ push @features, [ Maasha::KISS::Track::track_feature( $tracks[ $i ], $cookie, $cookie ) ];
+ }
+
+ $file = "fisk.png"; # FIXME
+
+ $surface = Cairo::ImageSurface->create( 'argb32', $cookie->{ 'IMG_WIDTH' }, $cookie->{ 'TRACK_OFFSET' } );
+ $cr = Cairo::Context->create( $surface );
+
+ foreach $feat ( @features ) {
+ Maasha::KISS::Draw::draw_feature( $cr, $feat ) if $feat;
+ }
+
+ Maasha::KISS::Draw::file_png( $surface, $file );
+
+ push @img, Maasha::XHTML::img(
+ src => $file,
+ alt => "Browser Tracks",
+ height => $cookie->{ 'TRACK_OFFSET' },
+ width => $cookie->{ 'IMG_WIDTH' },
+ id => "browser_map",
+ usemap => "#browser_map"
+ );
+
+ push @img, Maasha::XHTML::map_beg( name => "browser_map", id => "browser_map" );
+
+ foreach $feat ( @features )
+ {
+ foreach $elem ( @{ $feat } )
+ {
+ next if $elem->{ 'type' } eq 'text';
+
+ push @img, Maasha::XHTML::area(
+ href => cookie_href( $cookie, "export" ) . "&Q_ID=$elem->{ 'id' }",
+ shape => "rect",
+ coords => "$elem->{ x1 }, $elem->{ y1 }, $elem->{ x2 }, $elem->{ y2 }", title => "$elem->{ 'title' }",
+ );
+ }
+ }
+
+ 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;
+}
+
+
+sub section_export
+{
+ # Martin A. Hansen, November 2009.
+
+ # Returns a HTML section with export table.
+
+ my ( $cookie, # cookie hash
+ ) = @_;
+
+ # Returns a list.
+
+ my ( @html );
+
+ push @html, Maasha::XHTML::h2( txt => "Export", class => 'center' ); # TODO section_export!
+
+ return wantarray ? @html : \@html;
+}
+
+
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
+__END__
projects / biopieces.git / commitdiff