oops, this directory was missed...
[cview.git] / lib / CXGN / MapImage.pm
blob94bacadce9f91838203254b2514a3fc453b44461
2 =head1 NAME
4 CXGN::Cview::MapImage - an interface for Cview map images.
6 =head1 DESCRIPTION
8 Inherits from L<CXGN::Cview::ImageI>.
10 =head1 AUTHOR(S)
12 Lukas Mueller (lam87@cornell.edu)
14 =head1 FUNCTIONS
17 =cut
19 use strict;
21 package CXGN::Cview::MapImage;
23 use GD;
24 use CXGN::Cview::ImageI;
26 use base qw / CXGN::Cview::ImageI /;
30 =head2 function MapImage::new()
32 MapImage -> new(map name, map_width [pixels], map_height [pixels])
34 Creates a new map object.
36 =cut
38 sub new {
39 my $class = shift;
40 my $map_name = shift;
41 my $width = shift; # the image width in pixels
42 my $height = shift; # the image height in pixels
44 my $self = $class->SUPER::new();
45 GD::Image->trueColor(1);
46 my $image = GD::Image->new($width, $height);
47 # $image || die "Can't generate image...";
48 $self->set_image($image); # make it truecolor (the last argument =1)
49 $self->{chromosomes} = ();
50 $self->{chr_links} = ();
51 $self->set_width($width);
52 $self->set_height($height);
53 $self->set_name($map_name);
55 return $self;
61 =head2 function render()
63 $map -> render() # takes no parameters
65 renders the map on the internal image.
67 =cut
69 sub render {
70 my $self = shift;
71 # the first color allocated is the background color.
72 $self->{white} = $self->get_image()->colorResolve(255,255,255);
73 $self->get_image()->filledRectangle(0,0 ,$self->{width}, $self->{height}, $self->{white});
76 foreach my $c (@{$self->{chromosomes}}) {
77 #print STDERR "Calling layout...\n";
78 $c -> layout();
79 $c -> draw_chromosome($self->get_image());
81 foreach my $l (@{$self->{chr_links}}) {
82 $l -> render($self->get_image());
84 foreach my $r (@{$self->{rulers}}) {
85 $r -> render($self->get_image());
87 foreach my $p (@{$self->{physical}}) {
88 $p -> render($self->get_image());
90 foreach my $o (@{$self->{image_objects}}) {
91 $o -> render ($self->get_image());
94 foreach my $c (@{$self->{chromosomes}}) {
96 $c -> render_markers($self->get_image());
102 =head2 function render_png()
104 $map->render_png(); # no parameters
106 renders the image as a png to STDOUT.
108 =cut
110 sub render_png {
111 my $self= shift;
112 $self->render();
113 print $self->get_image()->png();
116 =head2 function render_png_string()
118 renders the png and returns it as a string.
120 =cut
124 sub render_png_string {
125 my $self =shift;
126 $self->render();
127 return $self->get_image()->png();
130 =head2 function render_png_file()
132 $map->render_png_file ($filepath)
134 render the image as a png saving the image at $filepath.
136 =cut
138 sub render_png_file {
139 my $self = shift;
140 my $filename = shift;
141 $self -> render();
142 open my $f, '>', $filename
143 or die "Can't open $filename for writing!!! Check write permission in dest directory.";
144 print $f $self->get_image()->png();
147 =head2 function render_jpg()
149 $map->render_jpg()
151 renders the image as a jpg to STDOUT.
153 =cut
156 sub render_jpg {
157 my $self = shift;
158 $self->render();
159 print $self->get_image()->jpeg();
162 =head2 function render_jpg_file()
164 $map->render_jpg_file(filepath)
166 renders the image as a jpg file at filepath
168 =cut
170 sub render_jpg_file {
171 my $self = shift;
172 my $filename = shift;
173 #print STDERR "cview.pm: render_jpg_file.\n";
174 $self ->render();
175 #print STDERR "rendering. Now writing file..\n";
176 open (F, ">$filename") || die "Can't open $filename for writing!!! Check write permission in dest directory.";
177 print F $self->get_image()->jpeg();
178 close(F);
179 #print STDERR "done...\n";
183 sub render_gif_file {
184 my $self = shift;
186 my $filename = shift;
187 $self->render();
188 open(F, ">$filename") || die "Can't open $filename for writing. Check permissions.";
189 print F $self->get_image()->gif();
190 close(F);
193 =head2 function get_image_map()
195 $string = $map->get_image_map()
197 Get the image map as a string. Calls get_image_map for all the objects contained
198 in the MapImage.
200 =cut
202 sub get_image_map {
203 my $self = shift;
204 my $map_name = shift;
205 #print STDERR "get_image_map map\n";
206 #as of 1/6/07, must use both NAME and ID to have both Mozilla and IE conformance, although standard xhtml uses ID only -- Evan
207 my $imagemap = "<map name=\"$map_name\" id=\"$map_name\">";
208 foreach my $c (@{$self->{chromosomes}}) {
209 #print STDERR "getting the chromosome image maps...\n";
210 $imagemap .= $c -> get_image_map();
212 foreach my $p (@{$self->{physical}}) {
213 $imagemap .= $p -> get_image_map();
216 #in xhtml 1.0+, a <map> must have child nodes, so if it doesn't, don't print it -- Evan, 1/6/07
217 if(scalar(@{$self->{chromosomes}}) > 0 or scalar(@{$self->{physical}}) > 0)
219 return $imagemap."</map>";
221 else
223 return "";
227 =head2 function add_chromosome()
229 $map->add_chromosome($chromosome_object)
231 adds the chromosome object to the map. Obviously works also for subclasses of
232 chromosomes such as physical and IL.
234 =cut
236 sub add_image_object {
237 my $self = shift;
238 my $object = shift;
239 push @{$self->{image_objects}}, $object;
242 sub add_chromosome {
243 my $self = shift;
244 my $chromosome = shift;
246 push @{$self->{chromosomes}}, $chromosome;
249 sub get_chromosomes {
250 my $self = shift;
251 return @{$self->{chromosomes}};
254 =head2 function add_chr_link()
256 $map->add_chr_link($chr_link)
258 adds the chromosome linking object $chr_link to the map.
260 =cut
262 sub add_chr_link {
263 my $self = shift;
264 my $chr_link = shift;
265 push @{$self->{chr_links}}, $chr_link;
268 =head2 function add_ruler()
270 $map->add_ruler($ruler)
272 adds the ruler $ruler to the map.
274 =cut
276 sub add_ruler {
277 my $self = shift;
278 my $ruler = shift;
279 push @{$self->{rulers}}, $ruler;
282 =head2 function add_physical()
284 $map->add_physical($physical)
286 adds the physical map $physical to the map.
288 Note: The physical object has to be populated both in terms of marker
289 positions and physical map.
291 =cut
293 sub add_physical {
294 my $self = shift;
295 my $physical = shift;
296 push @{$self->{physical}}, $physical;
300 return 1;