4 CXGN::Cview::Utils - library for cview-related helper code
10 Lukas Mueller (lam87@cornell.edu)
16 package CXGN
::Cview
::Utils
;
18 use CXGN
::Cview
::ChrLinkList
;
21 our (@ISA) = qw(Exporter);
22 our (@EXPORT_OK) = qw
| get_maps_select set_marker_color get_chromosome_links
|; # symbols to export on request
24 =head2 get_chromosome_links
26 Usage: my @chromosome_links = CXGN::Cview::Utils::get_chromosome_links($chr1_object, $chr2_object)
27 Desc: get_chromosome_links gets all the links between two
28 chromosomes (CXGN::Cview::Chromosome and subclasses).
29 Ret: returns a list of CXGN::Cview::ChrLink objects
30 Args: two CXGN::Cview::Chromosome objects (or subclasses)
36 sub get_chromosome_links
{
43 my $link_list = CXGN
::Cview
::ChrLinkList
->new();
45 #print STDERR "Finding links between chr ".$chr1->get_caption()." and ".$chr2->get_caption()."\n";
47 foreach my $m1 ($chr1->get_markers()) {
48 my $name1 = uc($m1->get_marker_name());
49 $find_by_name{$name1}=$m1->get_offset();
50 $find_by_id{$m1->get_id()}=$m1->get_offset();
52 foreach my $m2 ($chr2->get_markers()) {
53 # we want to connect if either the marker names are identical (but not undef),
54 # or the ids are identical (but not undef).
55 my $name2 = uc($m2->get_marker_name());
56 my $id2 = $m2->get_id();
58 if (exists($find_by_name{$name2}) && defined($find_by_name{$name2})) {
59 $offset1=$find_by_name{$name2};
62 if (exists($find_by_id{$id2}) && defined($find_by_id{$id2})) {
63 $offset1=$find_by_id{$id2};
66 my $clink = CXGN
::Cview
::ChrLink
-> new
($chr1, $offset1, $chr2, $m2->get_offset(), $name2) ;
67 $clink -> set_color
(100,100,100);
68 $link_list->add_link($name2, $clink);
77 =head2 function get_maps_select()
81 Returns: a string with html code for the maps select pull down menu
92 my $selected_map_version = shift;
93 my $field_name = shift;
94 my $add_empty_selection =1;
95 if (!$field_name) { $field_name = "map_version_id"; }
97 # my $query = "select map.map_id, short_name from map join "
98 # . "map_version using (map_id) where current_version = 't' order by short_name";
99 # my $sth = $self -> prepare($query);
102 my $select = qq { <select name
="$field_name" > };
104 my $map_factory = CXGN
::Cview
::MapFactory
->new($dbh);
105 my @maps = $map_factory->get_all_maps();
107 if ($add_empty_selection) {
108 $select .= qq { <option value
=""></option
> };
111 foreach my $m (@maps) {
112 my ($map_version_id, $short_name) = ($m->get_id(), $m->get_short_name());
113 if ($map_version_id =~ /^$selected_map_version$/) { $selected="selected=\"selected\""; }
114 else {$selected=""; }
115 $select .= "<option value=\"$map_version_id\" $selected>$short_name</option>";
117 $select .= "</select>";
121 =head2 function set_marker_color()
124 Parameters: marker object [CXGN::Cview::Marker], color model [string]
126 Side effects: sets the marker color according to the supplied marker color model
127 the color model is a string from the list:
128 "marker_types", "confidence"
131 Note: this function was moved to Utils from Chromosome_viewer, such that
132 it is available for other scripts, such as view_maps.pl
136 sub set_marker_color
{
138 my $color_model = shift;
139 if ($color_model eq "marker_types") {
140 if ($m->get_marker_type() =~ /RFLP/i) {
141 $m->set_color(255, 0, 0);
142 $m->set_label_line_color(255, 0,0);
143 $m->set_text_color(255,0,0);
145 elsif ($m->get_marker_type() =~ /SSR/i) {
146 $m->set_color(0, 255, 0);
147 $m->set_label_line_color(0, 255,0);
148 $m->set_text_color(0,255,0);
150 elsif ($m->get_marker_type() =~ /CAPS/i) {
151 $m->set_color(0, 0, 255);
152 $m->set_label_line_color(0, 0,255);
153 $m->set_text_color(0,0,255);
155 elsif ($m->get_marker_type() =~ /COS/i) {
156 $m->set_color(255,0 , 255);
157 $m->set_label_line_color(255,0, 255);
158 $m->set_text_color(255,0,255);
161 $m->set_color(0, 0, 0);
162 $m->set_label_line_color(0, 0,0);
163 $m->set_text_color(0,0,0);
168 my $c = $m -> get_confidence
();
170 $m->set_color(0,0,0);
171 $m->set_label_line_color(0,0,0);
172 $m->set_text_color(0,0,0);
175 $m->set_color(0,0,255);
176 $m->set_label_line_color(0,0,255);
177 $m->set_text_color(0,0,255);
181 $m->set_color(0,255, 0);
182 $m->set_label_line_color(0,255,0);
183 $m->set_text_color(0,255,0);
186 $m->set_color(255, 0, 0);
187 $m->set_label_line_color(255, 0,0);
188 $m->set_text_color(255, 0,0);
191 $m->set_color(128, 128, 128);
192 $m->set_label_line_color(128, 128, 128);
193 $m->set_text_color(128, 128, 128);