www/cgi-bin/index.cgi

   1 #!/usr/bin/env perl
   2
   3 # Copyright (C) 2006-2009 Martin A. Hansen.
   4
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # http://www.gnu.org/copyleft/gpl.html
  20
  21 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  22
  23 use strict;
  24 use warnings;
  25
  26 use lib "/Users/maasha/biopieces/code_perl/";
  27
  28 use CGI;
  29 use Data::Dumper;
  30 use Time::HiRes;
  31 use Maasha::Common;
  32 use Maasha::Filesys;
  33 use Maasha::Calc;
  34 use Maasha::XHTML;
  35 use Maasha::KISS::IO;
  36 use Maasha::KISS::Track;
  37 use Maasha::KISS::Draw;
  38
  39 my ( $cgi, $cookie, @html );
  40
  41 $cgi    = new CGI;
  42 $cookie = cookie_default( $cgi );;
  43
  44 push @html, Maasha::XHTML::html_header(
  45     cgi_header  => 1,
  46     title       => "KISS Genome Browser",
  47     css_file    => "kiss.css",
  48     author      => "Martin A. Hansen, mail\@maasha.dk",
  49     description => "Biopieces bacterial genome browser - KISS",
  50     keywords    => [ qw( KISS Biopieces biopiece genome browser viewer bacterium bacteria prokaryote prokaryotes ) ],
  51     no_cache    => 1,
  52 );
  53
  54 push @html, Maasha::XHTML::h1( txt => "KISS Genome Browser", class => 'center' );
  55 push @html, Maasha::XHTML::form_beg( action => $cookie->{ 'SCRIPT' }, method => "get", enctype => "multipart/form-data" );
  56
  57 push @html, page( $cookie );
  58
  59 push @html, Maasha::XHTML::form_end;
  60 push @html, Maasha::XHTML::body_end;
  61 push @html, Maasha::XHTML::html_end;
  62
  63 # push @html, Maasha::KISS::Draw::hdump( $cgi->param );
  64 # push @html, Maasha::KISS::Draw::hdump( $cookie );
  65
  66 print "$_\n" foreach @html;
  67
  68
  69 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  70
  71
  72 sub cookie_default
  73 {
  74     my ( $cgi,   # CGI object
  75        ) = @_;
  76
  77     # Returns a hash
  78
  79     my ( $cookie, $path );
  80
  81     $cookie = {};
  82
  83     $cookie->{ 'SCRIPT' }      = Maasha::Common::get_scriptname();
  84     $cookie->{ 'DATA_DIR' }    = "Data";
  85     $cookie->{ 'LIST_PAGES' }  = [ qw( user clade genome assembly contig browse ) ];
  86     $cookie->{ 'PAGE' }        = $cgi->param( 'page' )     || 'user';
  87     $cookie->{ 'USER' }        = $cgi->param( 'user' )     || '';
  88     $cookie->{ 'CLADE' }       = $cgi->param( 'clade' )    || '';
  89     $cookie->{ 'GENOME' }      = $cgi->param( 'genome' )   || '';
  90     $cookie->{ 'ASSEMBLY' }    = $cgi->param( 'assembly' ) || '';
  91     $cookie->{ 'CONTIG' }      = $cgi->param( 'contig' )   || '';
  92     $cookie->{ 'NAV_START' }   = $cgi->param( 'nav_start' );
  93     $cookie->{ 'NAV_END' }     = $cgi->param( 'nav_end' );
  94     $cookie->{ 'ZOOM_IN1' }    = $cgi->param( 'zoom_in1' );
  95     $cookie->{ 'ZOOM_IN2' }    = $cgi->param( 'zoom_in2' );
  96     $cookie->{ 'ZOOM_IN3' }    = $cgi->param( 'zoom_in3' );
  97     $cookie->{ 'ZOOM_OUT1' }   = $cgi->param( 'zoom_out1' );
  98     $cookie->{ 'ZOOM_OUT2' }   = $cgi->param( 'zoom_out2' );
  99     $cookie->{ 'ZOOM_OUT3' }   = $cgi->param( 'zoom_out3' );
 100     $cookie->{ 'MOVE_LEFT1' }  = $cgi->param( 'move_left1' );
 101     $cookie->{ 'MOVE_LEFT2' }  = $cgi->param( 'move_left2' );
 102     $cookie->{ 'MOVE_LEFT3' }  = $cgi->param( 'move_left3' );
 103     $cookie->{ 'MOVE_RIGHT1' } = $cgi->param( 'move_right1' );
 104     $cookie->{ 'MOVE_RIGHT2' } = $cgi->param( 'move_right2' );
 105     $cookie->{ 'MOVE_RIGHT3' } = $cgi->param( 'move_right3' );
 106
 107     $path = "$cookie->{ 'DATA_DIR' }/Users";
 108
 109     $cookie->{ 'LIST_USER' }     = ls_dir_base( $path ) if -d $path;
 110
 111     $path .= "/$cookie->{ 'USER' }";
 112
 113     $cookie->{ 'LIST_CLADE' }    = ls_dir_base( $path ) if -d $path;
 114
 115     $path .= "/$cookie->{ 'CLADE' }";
 116
 117     $cookie->{ 'LIST_GENOME' }   = ls_dir_base( $path ) if -d $path;
 118
 119     $path .= "/$cookie->{ 'GENOME' }";
 120
 121     $cookie->{ 'LIST_ASSEMBLY' } = ls_dir_base( $path ) if -d $path;
 122
 123     $path .= "/$cookie->{ 'ASSEMBLY' }";
 124
 125     $cookie->{ 'LIST_CONTIG' }   = ls_dir_base( $path ) if -d $path;
 126
 127     if ( $cookie->{ 'CONTIG' } )
 128     {
 129         cookie_start( $cookie );
 130         cookie_end( $cookie );
 131         cookie_zoom( $cookie );
 132         cookie_move( $cookie );
 133     }
 134
 135     return wantarray ? %{ $cookie } : $cookie;
 136 }
 137
 138
 139 sub ls_dir_base
 140 {
 141     my ( $path,
 142        ) = @_;
 143
 144     # Returns a list.
 145
 146     my ( @dirs, $dir, @list );
 147
 148     @dirs = Maasha::Filesys::ls_dirs( $path );
 149
 150     foreach $dir ( @dirs )
 151     {
 152         next if $dir =~ /\/\.\.?$/;
 153
 154         push @list, ( split "/", $dir )[ -1 ];
 155     }
 156
 157     return wantarray ? @list : \@list;
 158 }
 159
 160
 161 sub cookie_clade
 162 {
 163     my ( $cookie,
 164        ) = @_;
 165
 166     # Returns nothing.
 167
 168     my ( $user, @dirs, $dir );
 169
 170     $user = $cookie->{ 'USER' };
 171
 172     @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user" );
 173
 174     foreach $dir ( @dirs )
 175     {
 176         next if $dir =~ /\/\.\.?$/;
 177
 178         push @{ $cookie->{ 'LIST_CLADE' } }, ( split "/", $dir )[ -1 ];
 179     }
 180 }
 181
 182
 183 sub cookie_genome
 184 {
 185     my ( $cookie,
 186        ) = @_;
 187
 188     # Returns nothing.
 189
 190     my ( $user, $clade, @dirs, $dir );
 191
 192     $user  = $cookie->{ 'USER' };
 193     $clade = $cookie->{ 'CLADE' };
 194
 195     @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade" );
 196
 197     foreach $dir ( @dirs )
 198     {
 199         next if $dir =~ /\/\.\.?$/;
 200
 201         push @{ $cookie->{ 'LIST_GENOME' } }, ( split "/", $dir )[ -1 ];
 202     }
 203 }
 204
 205
 206 sub cookie_assembly
 207 {
 208     my ( $cookie,
 209        ) = @_;
 210
 211     # Returns nothing.
 212
 213     my ( $user, $clade, $genome, @dirs, $dir );
 214
 215     $user   = $cookie->{ 'USER' };
 216     $clade  = $cookie->{ 'CLADE' };
 217     $genome = $cookie->{ 'GENOME' };
 218
 219     @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade/$genome" );
 220
 221     foreach $dir ( @dirs )
 222     {
 223         next if $dir =~ /\/\.\.?$/;
 224
 225         push @{ $cookie->{ 'LIST_ASSEMBLY' } }, ( split "/", $dir )[ -1 ];
 226     }
 227 }
 228
 229
 230 sub cookie_contig
 231 {
 232     my ( $cookie,
 233        ) = @_;
 234
 235     # Returns nothing.
 236
 237     my ( $user, $clade, $genome, $assembly, @dirs, $dir );
 238
 239     $user     = $cookie->{ 'USER' };
 240     $clade    = $cookie->{ 'CLADE' };
 241     $genome   = $cookie->{ 'GENOME' };
 242     $assembly = $cookie->{ 'ASSEMBLY' };
 243
 244     @dirs = Maasha::Filesys::ls_dirs( "$cookie->{ 'DATA_DIR' }/Users/$user/$clade/$genome/$assembly" );
 245
 246     foreach $dir ( @dirs )
 247     {
 248         next if $dir =~ /\/\.\.?$/;
 249
 250         push @{ $cookie->{ 'LIST_CONTIG' } }, ( split "/", $dir )[ -1 ];
 251     }
 252 }
 253
 254
 255 sub cookie_start
 256 {
 257     my ( $cookie,
 258        ) = @_;
 259
 260     # Returns nothing.
 261
 262     if ( defined $cookie->{ 'NAV_START' } )
 263     {
 264         $cookie->{ 'NAV_START' } =~ tr/,//d;
 265         $cookie->{ 'NAV_START' } = 1 if $cookie->{ 'NAV_START' } <= 0;
 266     }
 267     else
 268     {
 269         $cookie->{ 'NAV_START' } = 1;
 270     }
 271 }
 272
 273
 274 sub cookie_end
 275 {
 276     my ( $cookie,
 277        ) = @_;
 278
 279     # Returns nothing.
 280
 281     my ( $max );
 282
 283     $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) );
 284
 285     if ( defined $cookie->{ 'NAV_END' } )
 286     {
 287         $cookie->{ 'NAV_END' } =~ tr/,//d;
 288         $cookie->{ 'NAV_END' } = $max if $cookie->{ 'NAV_END' } > $max;
 289     }
 290     else
 291     {
 292         $cookie->{ 'NAV_END' } = $max;
 293     }
 294 }
 295
 296
 297 sub cookie_zoom
 298 {
 299     my ( $cookie,
 300        ) = @_;
 301
 302     # Returns nothing.
 303
 304     my ( $max, $dist, $new_dist, $dist_diff );
 305
 306     $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) );
 307
 308     $dist = $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' };
 309
 310     if ( defined $cookie->{ 'ZOOM_IN1' } ) {
 311         $new_dist = $dist / 1.5;
 312     } elsif ( defined $cookie->{ 'ZOOM_IN2' } ) {
 313         $new_dist = $dist / 3;
 314     } elsif ( defined $cookie->{ 'ZOOM_IN3' } ) {
 315         $new_dist = $dist / 10;
 316     } elsif ( defined $cookie->{ 'ZOOM_OUT1' } ) {
 317         $new_dist = $dist * 1.5;
 318     } elsif ( defined $cookie->{ 'ZOOM_OUT2' } ) {
 319         $new_dist = $dist * 3;
 320     } elsif ( defined $cookie->{ 'ZOOM_OUT3' } ) {
 321         $new_dist = $dist * 10;
 322     }
 323
 324     if ( $new_dist )
 325     {
 326         $dist_diff = $dist - $new_dist;
 327
 328         $cookie->{ 'NAV_START' } = int( $cookie->{ 'NAV_START' } + ( $dist_diff / 2 ) );
 329         $cookie->{ 'NAV_END' }   = int( $cookie->{ 'NAV_END' }   - ( $dist_diff / 2 ) );
 330
 331         $cookie->{ 'NAV_START' } = 1     if $cookie->{ 'NAV_START' } <= 0;
 332         $cookie->{ 'NAV_END' }   = $max if $cookie->{ 'NAV_END' } > $max;
 333     }
 334 }
 335
 336
 337 sub cookie_move
 338 {
 339     my ( $cookie,
 340        ) = @_;
 341
 342     my ( $max, $dist, $shift, $new_start, $new_end );
 343
 344     $max = Maasha::Filesys::file_size( Maasha::KISS::Track::path_seq( $cookie ) );
 345
 346     $dist = $cookie->{ 'NAV_END' } - $cookie->{ 'NAV_START' };
 347
 348     if ( defined $cookie->{ 'MOVE_LEFT1' } ) {
 349         $shift = -1 * $dist * 0.10;
 350     } elsif ( defined $cookie->{ 'MOVE_LEFT2' } ) {
 351         $shift = -1 * $dist * 0.475;
 352     } elsif ( defined $cookie->{ 'MOVE_LEFT3' } ) {
 353         $shift = -1 * $dist * 0.95;
 354     } elsif ( defined $cookie->{ 'MOVE_RIGHT1' } ) {
 355         $shift = $dist * 0.10;
 356     } elsif ( defined $cookie->{ 'MOVE_RIGHT2' } ) {
 357         $shift = $dist * 0.475;
 358     } elsif ( defined $cookie->{ 'MOVE_RIGHT3' } ) {
 359         $shift = $dist * 0.95;
 360     }
 361
 362     if ( $shift )
 363     {
 364         $new_start = int( $cookie->{ 'NAV_START' } + $shift );
 365         $new_end   = int( $cookie->{ 'NAV_END' }   + $shift );
 366
 367         if ( $new_start > 0 and $new_end < $max )
 368         {
 369             $cookie->{ 'NAV_START' } = $new_start;
 370             $cookie->{ 'NAV_END' }   = $new_end;
 371         }
 372     }
 373 }
 374
 375
 376 sub page
 377 {
 378     my ( $cookie,
 379        ) = @_;
 380
 381     # Returns a list.
 382
 383     my ( @html, $list, $item, $href );
 384
 385     push @html, breadcrumb( $cookie );
 386
 387     $list = "LIST_" . uc $cookie->{ 'PAGE' };
 388
 389     if ( $cookie->{ 'PAGE' } ne 'browse' )
 390     {
 391         push @html, Maasha::XHTML::h2( txt => "Select $cookie->{ 'PAGE' }", class => 'center' );
 392
 393         push @html, Maasha::XHTML::table_beg( summary => "Select table", align => 'center', cellpadding => '5px' );
 394
 395         foreach $item ( @{ $cookie->{ $list } } )
 396         {
 397             $cookie->{ uc $cookie->{ 'PAGE' } } = $item;
 398
 399             $href = page_href( $cookie, page_next( $cookie ) );
 400
 401             push @html, Maasha::XHTML::table_row_simple( tr => [ Maasha::XHTML::ln( txt => $item, href => $href ) ] );
 402         }
 403
 404         push @html, Maasha::XHTML::table_end;
 405     }
 406     else
 407     {
 408         push @html, sec_navigate( $cookie );
 409         push @html, sec_browse( $cookie );
 410     }
 411
 412     return wantarray ? @html : \@html;
 413 }
 414
 415
 416 sub page_next
 417 {
 418     my ( $cookie,
 419        ) = @_;
 420
 421     my ( $i );
 422
 423     for ( $i = 0; $i < @{ $cookie->{ 'LIST_PAGES' } }; $i++ ) {
 424         last if $cookie->{ 'PAGE' } eq $cookie->{ 'LIST_PAGES' }->[ $i ];
 425     }
 426
 427     return $cookie->{ 'LIST_PAGES' }->[ $i + 1 ];
 428 }
 429
 430
 431 sub breadcrumb
 432 {
 433     my ( $cookie,
 434        ) = @_;
 435
 436     # Returns a list.
 437
 438     my ( @pages, $page, @row1, @row2, @html, $href, $txt );
 439
 440     @pages = @{ $cookie->{ 'LIST_PAGES' } };
 441
 442     pop @pages;   # remove 'browse'
 443
 444     foreach $page ( @pages )
 445     {
 446         $href = page_href( $cookie, $page );
 447
 448         $txt = $cookie->{ uc $page } || "";
 449
 450         push @row1, Maasha::XHTML::ln( txt => $page, href => $href, class => 'inline' );
 451         push @row2, Maasha::XHTML::p( txt => $txt, class => 'inline' );
 452
 453         last if $page eq $cookie->{ 'PAGE' };
 454     }
 455
 456     push @html, Maasha::XHTML::table_beg( summary => "Taxonomy table", align => 'center', cellpadding => '5px' );
 457     push @html, Maasha::XHTML::table_row_simple( tr => \@row1, align => 'center' );
 458     push @html, Maasha::XHTML::table_row_simple( tr => \@row2, align => 'center' );
 459     push @html, Maasha::XHTML::table_end;
 460
 461     return wantarray ? @html : \@html;
 462 }
 463
 464
 465 sub page_href
 466 {
 467     my ( $cookie,
 468          $page,
 469        ) = @_;
 470
 471     # Returns a string.
 472
 473     my ( @href );
 474
 475     while ( 1 )
 476     {
 477         push @href, "$cookie->{ 'SCRIPT' }?page=$page";
 478         push @href, "user=$cookie->{ 'USER' }"         if $cookie->{ 'USER' };
 479         last if $page eq 'user';
 480         push @href, "clade=$cookie->{ 'CLADE' }"       if $cookie->{ 'CLADE' };
 481         last if $page eq 'clade';
 482         push @href, "genome=$cookie->{ 'GENOME' }"     if $cookie->{ 'GENOME' };
 483         last if $page eq 'genome';
 484         push @href, "assembly=$cookie->{ 'ASSEMBLY' }" if $cookie->{ 'ASSEMBLY' };
 485         last if $page eq 'assembly';
 486         push @href, "contig=$cookie->{ 'CONTIG' }"     if $cookie->{ 'CONTIG' };
 487         last if $page eq 'contig';
 488         last;
 489     }
 490
 491     return join "&", @href;
 492 }
 493
 494
 495 sub sec_navigate
 496 {
 497     my ( $cookie,
 498        ) = @_;
 499
 500     # Returns a list.
 501
 502     my ( @html );
 503
 504     push @html, Maasha::XHTML::table_beg( summary => "Navigation table", align => 'center' );
 505     push @html, Maasha::XHTML::table_row_simple( tr => [ qw( Start End ) ], align => 'center' );
 506     push @html, Maasha::XHTML::table_row_simple( tr => [
 507         Maasha::XHTML::text( name => "nav_start", value => Maasha::Calc::commify( $cookie->{ 'NAV_START' } ), size => 20 ),
 508         Maasha::XHTML::text( name => "nav_end",   value => Maasha::Calc::commify( $cookie->{ 'NAV_END' } ),   size => 20 ),
 509         Maasha::XHTML::submit( name => "nav_submit", value => "Submit" ),
 510     ] );
 511     push @html, Maasha::XHTML::table_end;
 512
 513     push @html, Maasha::XHTML::table_beg( summary => "Zoom table", align => 'center' );
 514     push @html, Maasha::XHTML::table_row_simple( tr => [
 515         Maasha::XHTML::p( txt => 'Move:' ),
 516         Maasha::XHTML::submit( name => "move_left3",  value => "<<<", title => "move 95% to the left" ),
 517         Maasha::XHTML::submit( name => "move_left2",  value => "<<",  title => "move 47.5% to the left" ),
 518         Maasha::XHTML::submit( name => "move_left1",  value => "<",   title => "move 10% to the left" ),
 519         Maasha::XHTML::submit( name => "move_right1", value => ">",   title => "move 10% to the rigth" ),
 520         Maasha::XHTML::submit( name => "move_right2", value => ">>",  title => "move 47.5% to the rigth" ),
 521         Maasha::XHTML::submit( name => "move_right3", value => ">>>", title => "move 95% to the right" ),
 522         Maasha::XHTML::p( txt => 'Zoom in:' ),
 523         Maasha::XHTML::submit( name => "zoom_in1", value => "1.5x" ),
 524         Maasha::XHTML::submit( name => "zoom_in2", value => "3x" ),
 525         Maasha::XHTML::submit( name => "zoom_in3", value => "10x" ),
 526         Maasha::XHTML::p( txt => 'Zoom out:' ),
 527         Maasha::XHTML::submit( name => "zoom_out1", value => "1.5x" ),
 528         Maasha::XHTML::submit( name => "zoom_out2", value => "3x" ),
 529         Maasha::XHTML::submit( name => "zoom_out3", value => "10x" ),
 530     ] );
 531     push @html, Maasha::XHTML::table_end;
 532
 533     push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "page",     value => "browse" ) );
 534     push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "user",     value => "$cookie->{ 'USER' }" ) );
 535     push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "clade",    value => "$cookie->{ 'CLADE' }" ) );
 536     push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "genome",   value => "$cookie->{ 'GENOME' }" ) );
 537     push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "assembly", value => "$cookie->{ 'ASSEMBLY' }" ) );
 538     push @html, Maasha::XHTML::p( txt => Maasha::XHTML::hidden( name => "contig",   value => "$cookie->{ 'CONTIG' }" ) );
 539
 540     return wantarray ? @html : \@html;
 541 }
 542
 543
 544 sub sec_browse
 545 {
 546     my ( $cookie,
 547        ) = @_;
 548
 549     # Returns a list.
 550
 551     my ( $draw_metrics, @tracks, $i, @features, $feat, $elem, $file, $surface, $cr, @html, @img );
 552
 553     $draw_metrics = {
 554         IMG_WIDTH       => 1200,
 555         IMG_HEIGHT      => 800,
 556         TRACK_OFFSET    => 20,
 557         TRACK_SPACE     => 20,
 558         RULER_FONT_SIZE => 10,
 559         RULER_COLOR     => [ 0, 0, 0 ],
 560         SEQ_FONT_SIZE   => 10,
 561         SEQ_COLOR       => [ 0, 0, 0, ],
 562         FEAT_WIDTH      => 5,
 563         FEAT_COLOR      => [ 0, 1, 0 ],
 564     };
 565
 566     push @features, [ Maasha::KISS::Track::track_ruler( $draw_metrics, $cookie ) ];
 567     push @features, [ Maasha::KISS::Track::track_seq( $draw_metrics, $cookie ) ];
 568
 569     @tracks = Maasha::KISS::Track::path_tracks( $cookie );
 570
 571     for ( $i = 0; $i < @tracks; $i++ )
 572     {
 573         $draw_metrics->{ 'FEAT_COLOR' } = palette( $i );
 574
 575         push @features, [ Maasha::KISS::Track::track_feature( $tracks[ $i ], $draw_metrics, $cookie ) ];
 576     }
 577
 578     $file = "fisk.png";
 579
 580     $surface = Cairo::ImageSurface->create( 'argb32', $draw_metrics->{ 'IMG_WIDTH' }, $draw_metrics->{ 'TRACK_OFFSET' } );
 581     $cr      = Cairo::Context->create( $surface );
 582
 583     foreach $feat ( @features ) {
 584         Maasha::KISS::Draw::draw_feature( $cr, $feat ) if $feat;
 585     }
 586
 587     Maasha::KISS::Draw::file_png( $surface, $file );
 588
 589     push @img, Maasha::XHTML::img(
 590         src    => $file,
 591         alt    => "Browser Tracks",
 592         height => $draw_metrics->{ 'TRACK_OFFSET' },
 593         width  => $draw_metrics->{ 'IMG_WIDTH' },
 594         id     => "browser_map",
 595         usemap => "#browser_map"
 596     );
 597
 598     push @img, Maasha::XHTML::map_beg( name => "browser_map", id => "browser_map" );
 599
 600     foreach $feat ( @features )
 601     {
 602         foreach $elem ( @{ $feat } )
 603         {
 604             next if $elem->{ 'type' } eq 'text';
 605
 606             push @img, Maasha::XHTML::area(
 607                 href   => "www.dmi.dk",
 608                 shape  => "rect",
 609                 coords => "$elem->{ x1 }, $elem->{ y1 }, $elem->{ x2 }, $elem->{ y2 }", title => "$elem->{ 'title' }",
 610             );
 611         }
 612     }
 613
 614     push @img, Maasha::XHTML::map_end();
 615
 616     push @html, Maasha::XHTML::p( txt => join( "\n", @img ) );
 617
 618     @html = Maasha::XHTML::div( txt => join( "\n", @html ), class => 'browse' );
 619
 620     return wantarray ? @html : \@html;
 621 }
 622
 623
 624 sub palette
 625 {
 626     my ( $i,
 627        ) = @_;
 628
 629     my ( $palette, $color );
 630
 631     $palette = [
 632         [ 30, 130, 130 ],
 633         [ 30, 50, 150 ],
 634         [ 130, 130, 50 ],
 635         [ 130, 90, 130 ],
 636         [ 130, 70, 70 ],
 637     ];
 638
 639     $color = $palette->[ $i ];
 640
 641     map { $_ /= 255 } @{ $color };
 642
 643     return $color;
 644 }
 645
 646 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 647
 648
 649 __END__
 650
 651     # push @html, Maasha::KISS::Draw::hdump( $features );
 652
 653     $t0 = Time::HiRes::gettimeofday();
 654     $t1 = Time::HiRes::gettimeofday();