[Bio] / FigWebServices / subsys.cgi Repository:
ViewVC logotype

Diff of /FigWebServices/subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.51, Sat Feb 26 11:01:13 2005 UTC revision 1.52, Fri Mar 4 22:37:06 2005 UTC
# Line 746  Line 746 
746      push(@$html,$cgi->checkbox(-name => 'ext_ids', -value => 1, -checked => 0, -label => 'use external ids'),$cgi->br);      push(@$html,$cgi->checkbox(-name => 'ext_ids', -value => 1, -checked => 0, -label => 'use external ids'),$cgi->br);
747      push(@$html,$cgi->checkbox(-name => 'show_clusters', -value => 1, -checked => 0, -override => 1,-label => 'show clusters'),$cgi->br);      push(@$html,$cgi->checkbox(-name => 'show_clusters', -value => 1, -checked => 0, -override => 1,-label => 'show clusters'),$cgi->br);
748      push(@$html,$cgi->checkbox(-name => 'pirsf_color', -value => 1, -checked => 0, -override => 1,-label => 'show PIR superfamilies'),$cgi->br);      push(@$html,$cgi->checkbox(-name => 'pirsf_color', -value => 1, -checked => 0, -override => 1,-label => 'show PIR superfamilies'),$cgi->br);
749        my $opt=$fig->get_tags("genome"); # all the tags we know about
750        my @options=sort {uc($a) cmp uc($b)} keys %$opt;
751        unshift(@options, undef); # a blank field at the start
752        push(@$html,$cgi->popup_menu(-name => 'color_by_ga', -values=>\@options), "   color by an organism's attribute",$cgi->br);
753      push(@$html,$cgi->checkbox(-name => 'show_missing', -value => 1, -checked => 0, -override => 1,-label => 'show missing'),$cgi->br);      push(@$html,$cgi->checkbox(-name => 'show_missing', -value => 1, -checked => 0, -override => 1,-label => 'show missing'),$cgi->br);
754    
755      push(@$html,$cgi->checkbox(-name => 'show_missing_including_matches', -value => 1, -checked => 0, -override => 1,-label => 'show missing with matches'),      push(@$html,$cgi->checkbox(-name => 'show_missing_including_matches', -value => 1, -checked => 0, -override => 1,-label => 'show missing with matches'),
# Line 1350  Line 1354 
1354              # RAE added a new call to get tag/value pairs              # RAE added a new call to get tag/value pairs
1355              # Note that $color_of is not overwritten.              # Note that $color_of is not overwritten.
1356              my $superscript;              my $superscript;
1357                if ($cgi->param('color_by_ga'))
1358                {
1359                   # add colors based on the genome attributes
1360                   # get the value
1361                   my $ga=$cgi->param('color_by_ga');
1362                   my $valuetype=$fig->guess_value_format($ga);
1363                   my $value=$fig->get_attributes($genome, $ga);
1364                   if (defined $value) # we don't want to color undefined values
1365                   {
1366                      my @color=&cool_colors();
1367                      my $colval; # what we are basing the color on.
1368                      if ($valuetype->[0] eq "string") {$colval=$value} # strings are easy, we color based on string;
1369                      else {
1370                        # at the moment we will spllit numbers into groups of 10.
1371                        # $valuetype->[2] is the maximum number for this value
1372                        $colval = int($valuetype/$valuetype->[2]*10);
1373                      }
1374    
1375    
1376                      if (!$tagvalcolor->{$colval}) {
1377                        # figure out the highest number used in the array
1378                        $tagvalcolor->{$colval}=0;
1379                        foreach my $t (keys %$tagvalcolor) {
1380                          ($tagvalcolor->{$t} > $tagvalcolor->{$colval}) ? $tagvalcolor->{$colval}=$tagvalcolor->{$t} : 1;
1381                        }
1382                        $tagvalcolor->{$colval}++;
1383                      }
1384    
1385                      foreach my $cell (@cells) {
1386                        foreach $_ (@$cell)
1387                          {
1388                            $color_of->{$_->[0]} = $color[$tagvalcolor->{$colval}]
1389                          }
1390                      }
1391                   }
1392                }
1393              if ($cgi->param("pirsf_color"))              if ($cgi->param("pirsf_color"))
1394              {              {
1395               ($color_of, $superscript, $tagvalcolor) = color_by_tag($fig, \@pegs, $color_of, $tagvalcolor, "PIRSF");               ($color_of, $superscript, $tagvalcolor) = color_by_tag($fig, \@pegs, $color_of, $tagvalcolor, "PIRSF");
# Line 1466  Line 1506 
1506                  $cgi->textfield(-name => "include_these_variants", -size => 50)                  $cgi->textfield(-name => "include_these_variants", -size => 50)
1507            );            );
1508        }        }
1509    
1510        # add an explanation for the colors if we want one.
1511        if ($cgi->param('color_by_ga'))
1512        {
1513         print STDERR "Adding color at ", time, "\n";
1514         push(@$html, &HTML::make_table(undef,&describe_colors($tagvalcolor),"Color Descriptions"));
1515        }
1516  }  }
1517    
1518  sub group_by_clusters {  sub group_by_clusters {
# Line 1510  Line 1557 
1557              }              }
1558          }          }
1559    
1560          @colors =          @colors =  &cool_colors();
             (  
              '#C0C0C0',  
              '#FF40C0',  
              '#FF8040',  
              '#FF0080',  
              '#FFC040',  
              '#40C0FF',  
              '#40FFC0',  
              '#C08080',  
              '#C0FF00',  
              '#00FF80',  
              '#00C040'  
             );  
1561    
1562          @clusters = grep { @$_ > 1 } sort { @$a <=> @$b } @clusters;          @clusters = grep { @$_ > 1 } sort { @$a <=> @$b } @clusters;
1563    
# Line 1588  Line 1622 
1622      #### so I am just correcting those. This is not good, and I should change the urls in the tag/value pairs or something      #### so I am just correcting those. This is not good, and I should change the urls in the tag/value pairs or something
1623      if ($want eq "PIRSF") {      if ($want eq "PIRSF") {
1624       $val =~ /(^PIRSF\d+)/;       $val =~ /(^PIRSF\d+)/;
      #my $url = $cgi->a({href => "subsys.cgi?SPROUT=$sprout&user=$user&ssa_name=$sub&request=show_ssa"}, $sub);  
1625       $url->{$peg} = $cgi->a({href => "pir.cgi?&user=$user&pirsf=$1"}, $number->{$peg});       $url->{$peg} = $cgi->a({href => "pir.cgi?&user=$user&pirsf=$1"}, $number->{$peg});
1626      }      }
1627    }    }
# Line 1596  Line 1629 
1629    
1630    
1631   # if we want to assign some colors, lets do so now   # if we want to assign some colors, lets do so now
1632   my @colors =   my @colors = &cool_colors();
  (  
    '#C0C0C0',  
    '#FF40C0',  
    '#FF8040',  
    '#FF0080',  
    '#FFC040',  
    '#40C0FF',  
    '#40FFC0',  
    '#C08080',  
    '#C0FF00',  
    '#00FF80',  
    '#00C040'  
  );  
1633   unless ($cgi->param('show_clusters')) {   unless ($cgi->param('show_clusters')) {
1634    foreach my $peg (@$pegs) { $color_of->{$peg} = '#FFFFFF' }    foreach my $peg (@$pegs) { $color_of->{$peg} = '#FFFFFF' }
1635    foreach my $peg (keys %$number) {    foreach my $peg (keys %$number) {
# Line 2764  Line 2784 
2784          return $aliases[0];          return $aliases[0];
2785      }      }
2786  }  }
2787    
2788    sub cool_colors {
2789     # just an array of "websafe" colors or whatever colors we want to use. Feel free to remove bad colors (hence the lines not being equal length!)
2790     return (
2791     '#C0C0C0', '#FF40C0', '#FF8040', '#FF0080', '#FFC040', '#40C0FF', '#40FFC0', '#C08080', '#C0FF00', '#00FF80', '#00C040',
2792     "#6B8E23", "#483D8B", "#2E8B57", "#008000", "#006400", "#800000", "#00FF00", "#7FFFD4",
2793     "#87CEEB", "#A9A9A9", "#90EE90", "#D2B48C", "#8DBC8F", "#D2691E", "#87CEFA", "#E9967A", "#FFE4C4", "#FFB6C1",
2794     "#E0FFFF", "#FFA07A", "#DB7093", "#9370DB", "#008B8B", "#FFDEAD", "#DA70D6", "#DCDCDC", "#FF00FF", "#6A5ACD",
2795     "#00FA9A", "#228B22", "#1E90FF", "#FA8072", "#CD853F", "#DC143C", "#FF6347", "#98FB98", "#4682B4",
2796     "#D3D3D3", "#7B68EE", "#2F4F4F", "#FF7F50", "#FF69B4", "#BC8F8F", "#A0522D", "#DEB887", "#00DED1",
2797     "#6495ED", "#800080", "#FFD700", "#F5DEB3", "#66CDAA", "#FF4500", "#4B0082", "#CD5C5C",
2798     "#EE82EE", "#7CFC00", "#FFFF00", "#191970", "#FFFFE0", "#DDA0DD", "#00BFFF", "#DAA520", "#008080",
2799     "#00FF7F", "#9400D3", "#BA55D3", "#D8BFD8", "#8B4513", "#3CB371", "#00008B", "#5F9EA0",
2800     "#4169E1", "#20B2AA", "#8A2BE2", "#ADFF2F", "#556B2F",
2801     "#F0FFFF", "#B0E0E6", "#FF1493", "#B8860B", "#FF0000", "#F08080", "#7FFF00", "#8B0000",
2802     "#40E0D0", "#0000CD", "#48D1CC", "#8B008B", "#696969", "#AFEEEE", "#FF8C00", "#EEE8AA", "#A52A2A",
2803     "#FFE4B5", "#B0C4DE", "#FAF0E6", "#9ACD32", "#B22222", "#FAFAD2", "#808080", "#0000FF",
2804     "#000080", "#32CD32", "#FFFACD", "#9932CC", "#FFA500", "#F0E68C", "#E6E6FA", "#F4A460", "#C71585",
2805     "#BDB76B", "#00FFFF", "#FFDAB9", "#ADD8E6", "#778899",
2806     );
2807    }
2808    
2809    sub describe_colors {
2810     my ($tvc)=@_;
2811     my $tab = [];
2812     my @colors=&cool_colors();
2813     my @labels=sort keys %$tvc;
2814     my $row;
2815     for (my $i=0; $i<= scalar @labels; $i++) {
2816      next unless (defined $labels[$i]);
2817      push @$row, [$labels[$i], "td style=\"background-color: $colors[$tvc->{$labels[$i]}]\""];
2818      unless (($i+1) % 10) {
2819       push @$tab, $row;
2820       undef $row;
2821      }
2822     }
2823     push @$tab, $row;
2824     return $tab;
2825    }

Legend:
Removed from v.1.51  
changed lines
  Added in v.1.52

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3