view release on metacpan or  search on metacpan

lib/Microarray/Explorer.pm  view on Meta::CPAN

    my ($row, @rows, $row_table, $row_image);
    my $imgWidth = $self->_dataset->width() * $self->_zoom_x;

    # for every row, do the markup
    for (my $i=0; $i <= $#$index_ref; $i++) {	
	# if there is correlation value for this row 
	if ($corr_ra) {
	    $row = $self->_feature_markup( $$index_ref[$i], $$corr_ra[$i] );
	}
	# if there is no corralation to display
	else{
	    $row = $self->_feature_markup( $$index_ref[$i] );
	}	    
	# markup the image row
	$row_image = $self->_row_image_markup($$index_ref[$i], $$image_ra[$i], $imgWidth);
	# make a row in an html table
	push @rows, Tr(
		       td(
			  $row_image
			  ), "\n",
		       td({-height=>$self->_zoom_y}, 
			  $row
			  ), "\n",
		       )."\n";
    }
    # make the table from the marked up row
    $row_table = table({-border      => '0',
			-cellborder  => '0',
			-cellpadding => '0',
			-cellspacing => '0'},
		       @rows)."\n";
}

#--------------------------------------------------------------------
sub _searchTool {
#--------------------------------------------------------------------
# This sub creates the searchtool for the toolbar and returns it as 
# html, as a table cell.

    my $self = shift;
    my (@keys_used, %desc_used, $searchform, $cell1);

    @keys_used = $self->_dataset->getFeatureKeys(); # get the keys used here and sort by (future) value
    unshift @keys_used, "ALL";                      # add ALL to search all
                                                    # and sort by (future) value
    @keys_used = sort {$self->{'style'}->{$a}->{'display'} cmp $self->{'style'}->{$b}->{'display'}} @keys_used;

    foreach (@keys_used) {                          # descriptions for used keys
	$desc_used{$_} = $self->{'style'}->{$_}->{'display'};
    }

    # make the html form 
    $searchform  = start_form(-action => $self->{'info'}->{'self'},
			      -target => 'z');
    $searchform .= "<td>";    
    $searchform .= b("Search for ");    
    $searchform .= textfield(-size      => '8',
			     -maxlength => '20',
			     -name      => 'q');    
    $searchform .= b(" in ");
    $searchform .= popup_menu(-values  => \@keys_used,
			      -labels  => \%desc_used,
			      -name    => 'f',
			      -default => 'ALL');
    $searchform .= submit(-label => 'go');

    $searchform .= hidden(-name     => 'a', 
			  -value    => 's', 
			  -override => 1);    
    $searchform .= $self->_hide_params();
    $searchform .= "</td>";
    $searchform .= end_form();
    $searchform  = font({-face => 'verdana,arial,sans-serif',
			 -size => 2}, $searchform
			);
    chomp($searchform);
    return $searchform;
}

#----------------------------------------------------------------------
sub _changeTool {
#----------------------------------------------------------------------
# This subroutine will create the change radar scale tool for the toolbar 
# and returns it as html, as a table cell.

    my $self = shift;
    my (%change_scale, @scale_values, $changeform, %display);
    # labels for changing radar frame scale
    %change_scale = ( "0.5" => " 50%",
		      "1"   => "100%",
		      "2"   => "200%",
		      "4"   => "400%");

    foreach (sort keys %change_scale){
	# display the percentages
	$display{sprintf("%2.2f", $_ * $self->_radar_x)} = $change_scale{$_};
	# submit the new rx values
	push (@scale_values, sprintf("%2.2f", $_ * $self->_radar_x));
    }

    # make the html form for this tool - it is formatted as a table cell
    $changeform  = start_form(-action => $self->{'info'}->{'self'},
			      -target => '_top');    
    $changeform .= "<td>";
    $changeform .= "Radar ";
    $changeform .= popup_menu(-values  => \@scale_values,
			      -labels  => \%display,
			      -name    => 'rx',
			      -default => '1');
    $changeform .= " wide ";
    $changeform .= submit(-label => 'change');
    $changeform .= $self->_hide_params();
    $changeform .= "</td>";
    $changeform .= end_form();
    $changeform  = font({-face => 'verdana,arial,sans-serif',
			 -size => 2}, $changeform
			);
    chomp($changeform);
    return $changeform;
}

#----------------------------------------------------------------------
sub _infobox {
#----------------------------------------------------------------------
# This sub creates the infobox tool for the toolbar and returns it as 
# html, as a table cell.

    my $self = shift;
    my $infobox;
    
    # the html form for this tool 
    $infobox  = start_form({-name => 'infobox'},
			   ""
			   );
    $infobox .= "<td colspan=\"2\">"; # It is a 2 column wide cell
    $infobox .= textfield({-size  => '100',
			   -name  => 'text',
			   -value => 'Put your mouse over elements to see more information here'}
			  );
    $infobox .= "</td>";
    $infobox .= end_form;
    chomp($infobox);
    return $infobox;
}

#--------------------------------------------------------------------
sub _feature_markup {
#--------------------------------------------------------------------
# This subroutine will markup as html the annotations for a row in the 
# zoom table

    my $self        = shift;
    my $feature_num = shift;              # the index of the row to markup in the feature table
    my $corr        = @_ ? shift : undef; # if there is a corr value provided
    my ($data, $spacer, $fieldsUsed, $row, $field);

    # flag for flipping the row background color
    $flip = $flip ? 0 : 1;
    # the fields that are actually used for this dataset
    $fieldsUsed = $self->_style_keys;
    # first format the spacer that will separate the individual fields
    $spacer = $self->_markup_cell("&nbsp;", 'NUM', $flip);    
    # if there is a correlation value, mark it up
    $row .= $self->_markup_cell($corr, 'CORR', $flip) if ($corr);
    $row .= $spacer;
    # mark up each field