lib/CXGN/Cview/Label.pm

   1
   2
   3 =head1 NAME
   4
   5 CXGN::Cview::Label - a class for managing labels with links and hilite etc.
   6
   7 =head1 DESCRIPTION
   8
   9 This class deals with text labels for the Cview classes. It is similar to the CXGN::Phylo::Label class and should be merged sometimes in the future. The Label class currently supports:
  10
  11 =over 5
  12
  13 =item o
  14
  15 Hiliting
  16
  17 =item o
  18
  19 Left/right alignment
  20
  21 =item o
  22
  23 URL linking
  24
  25 =back
  26
  27 Future/partial support:
  28
  29 =over 5
  30
  31 =item o
  32
  33 vertical orientation for labels
  34
  35 =back
  36
  37 The idea of the label class is that it points to a reference point, which is set using set_reference_point(). Then you specify the distance on the side of the label, and the label will be drawn with a line to the reference point. The actual placement of the label occurs through the set_horizontal_offset and set_vertical_offset routines of the ImageObject interface from which Label inherits. You can also use align_right() to force the text label to align on the right side of the connector line, and set_align_left to force the text to align on the left. The default is if the horizontal coordinate of the reference point is smaller than the horizontal offset of the text label, the text label is aligned right, and left otherwise.
  38
  39 Inherits from L<CXGN::Cview::ImageObject>.
  40
  41 =head1 SEE ALSO
  42
  43 See also the documentation in L<CXGN::Cview>.
  44
  45 =head1 AUTHOR(S)
  46
  47 Lukas Mueller (lam87@cornell.edu)
  48
  49 =head1 FUNCTIONS
  50
  51
  52 =cut
  53
  54
  55 1;
  56
  57 use strict;
  58
  59 use CXGN::Cview::ImageObject;
  60
  61 package CXGN::Cview::Label;
  62
  63 use base qw( CXGN::Cview::ImageObject );
  64
  65 use GD;
  66
  67 sub new {
  68     my $class = shift;
  69     my $self = $class->SUPER::new(@_);
  70     my $args = shift;
  71     $self->set_font(GD::Font->Small());
  72     $self->align_default();
  73     $self->set_hilite_color(255,255,0);
  74     $self->set_line_color(100,100,100);
  75     $self->set_text_color(30,30,30);
  76     $self->set_label_text($args->{name});
  77     $self->set_url($args->{url});
  78     $self->set_vertical_stacking_spacing(0);
  79     $self->set_stacking_height(0);
  80     $self->set_stacking_level(0);
  81     $self->set_label_spacer(30);
  82
  83     return $self;
  84 }
  85
  86 =head2 function get_label_text()
  87
  88   Synopsis:
  89   Arguments:
  90   Returns:
  91   Side effects:
  92   Description:  same as get_name()
  93
  94 =cut
  95
  96 sub get_label_text {
  97     my $self=shift;
  98     return $self->get_name();
  99 }
 100
 101 =head2 function set_label_text()
 102
 103   Synopsis:
 104   Arguments:
 105   Returns:
 106   Side effects: same as set_name()
 107   Description:
 108
 109 =cut
 110
 111 sub set_label_text {
 112     my $self=shift;
 113     my $label = shift;
 114     $self->set_name($label);
 115 }
 116
 117 =head2 functions get_line_color(), function set_line_color()
 118
 119  Synopsis:
 120  Arguments:     gets/sets the color of the line connecting the label
 121                 with the marker. Default is black. Three numbers
 122                 between 0 and 255 for red, green and blue channels
 123                 are required.
 124  Returns:
 125  Side effects:
 126  Description:   gets/sets the line color connecting the label
 127                 to the reference point
 128
 129 =cut
 130
 131 sub get_line_color {
 132     my $self=shift;
 133     if (!exists($self->{line_color}) || (@{$self->{line_color}}==0)) { @{$self->{line_color}}=(255, 0, 0); }
 134     return @{$self->{line_color}};
 135 }
 136
 137 sub set_line_color {
 138     my $self = shift;
 139
 140     $self->{line_color}->[0]=shift;
 141     $self->{line_color}->[1]=shift;
 142     $self->{line_color}->[2]=shift;
 143 }
 144
 145 =head2 functions get_hilited(), set_hilited()
 146
 147   Synopsis:     my $flag = $l->get_hilited()
 148   Args/Returns: a boolean value - true if the label is hilited
 149                 false if it should be drawn without hiliting.
 150   Side effects: label is drawn with the hilite color
 151   Description:
 152
 153 =cut
 154
 155 sub get_hilited {
 156     my $self=shift;
 157     return $self->{hilited};
 158 }
 159
 160 sub set_hilited {
 161     my $self=shift;
 162     $self->{hilited}=shift;
 163 }
 164
 165 =head2 function get_hilite_color(), set_hilite_color()
 166
 167   Synopsis:     $l->set_hilite_color(255,100,100)
 168   Args/Returns: list of three values representing the hilite
 169                 color
 170   Side effects: the hilited markers will be drawn in this
 171                 color
 172   Description:
 173
 174 =cut
 175
 176 sub get_hilite_color {
 177     my $self=shift;
 178     if (!exists($self->{hilite_color})) { @{$self->{hilite_color}}=(255,255,255); }
 179     return @{$self->{hilite_color}};
 180 }
 181
 182 sub set_hilite_color {
 183     my $self=shift;
 184     @{$self->{hilite_color}}=@_;
 185 }
 186
 187
 188
 189 =head2 function is_hidden()
 190
 191   Synopsis:
 192   Arguments:
 193   Returns:
 194   Side effects:
 195   Description:
 196
 197 =cut
 198
 199 sub is_hidden {
 200     my $self=shift;
 201     return $self->{hidden};
 202 }
 203
 204 =head2 function set_hidden()
 205
 206   Synopsis:
 207   Arguments:
 208   Returns:
 209   Side effects:
 210   Description:
 211
 212 =cut
 213
 214 sub set_hidden {
 215     my $self=shift;
 216     $self->{hidden}=shift;
 217 }
 218
 219 =head2 function get_reference_point()
 220
 221   Synopsis:
 222   Arguments:
 223   Returns:      the point of reference that the label is attached to.
 224   Side effects:
 225   Description:
 226
 227 =cut
 228
 229 sub get_reference_point {
 230     my $self=shift;
 231     if (!exists($self->{reference_point})) { @{$self->{reference_point}}=(0,0); }
 232     return @{$self->{reference_point}};
 233 }
 234
 235 =head2 function set_reference_point()
 236
 237   Synopsis:
 238   Arguments:
 239   Returns:
 240   Side effects:
 241   Description:
 242
 243 =cut
 244
 245 sub set_reference_point {
 246     my $self=shift;
 247     @{$self->{reference_point}}=@_;
 248 }
 249
 250 =head2 function align_right()
 251
 252   Synopsis:
 253   Arguments:
 254   Returns:
 255   Side effects:
 256   Description:
 257
 258 =cut
 259
 260 sub align_right {
 261     my $self=shift;
 262     $self->{align_side}="right";
 263 }
 264
 265 =head2 function align_left()
 266
 267   Synopsis:
 268   Arguments:
 269   Returns:
 270   Side effects:
 271   Description:
 272
 273 =cut
 274
 275 sub align_left {
 276     my $self=shift;
 277     $self->{align_side}="left";
 278 }
 279
 280 =head2 function align_center()
 281
 282   Synopsis:
 283   Arguments:
 284   Returns:
 285   Side effects:
 286   Description:
 287
 288 =cut
 289
 290 sub align_center {
 291     my $self = shift;
 292     $self->{align_side}="center";
 293 }
 294
 295 =head2 function align_default()
 296
 297   Synopsis:
 298   Arguments:    none
 299   Returns:      nothing
 300   Side effects: chooses some reasonable default for label alignment
 301   Description:
 302
 303 =cut
 304
 305 sub align_default {
 306     my $self =shift;
 307     $self->{align_side}="default";
 308 }
 309
 310
 311 =head2 function get_align_side()
 312
 313   Synopsis:
 314   Arguments:
 315   Returns:
 316   Side effects:
 317   Description:
 318
 319 =cut
 320
 321 sub get_align_side {
 322     my $self=shift;
 323     return $self->{align_side};
 324 }
 325
 326 =head2 function set_align_side()
 327
 328   Synopsis:
 329   Arguments:
 330   Returns:
 331   Side effects:
 332   Description:
 333
 334 =cut
 335
 336 sub set_align_side {
 337     my $self=shift;
 338     $self->{align_side}=shift;
 339 }
 340
 341 =head2 function get_text_color(), set_text_color()
 342
 343   Synopsis:
 344   Args/Returns: a list of three integers representing
 345                 the three color components
 346   Side effects: the font will be drawn in this color
 347   Description:
 348
 349 =cut
 350
 351 sub get_text_color {
 352     my $self=shift;
 353     return @{$self->{text_color}};
 354 }
 355
 356 sub set_text_color {
 357     my $self=shift;
 358     @{$self->{text_color}}= @_;
 359 }
 360
 361 =head2 function render()
 362
 363   Synopsis:
 364   Arguments:    a GD::Image object
 365   Returns:      nothing
 366   Side effects: renders the marker on the image object
 367   Description:
 368
 369 =cut
 370
 371 sub render {
 372     my $self = shift;
 373     my $image = shift;
 374
 375     $self->calc_coords();
 376     my ($x, $y, $a, $b) = $self->get_enclosing_rect();
 377
 378
 379
 380     my $bg_color = $image->colorResolve($self->get_hilite_color());
 381     my $text_color = $image->colorResolve($self->get_text_color());
 382
 383     # debug
 384 #    $image->rectangle($x, $y, $a, $b, $text_color);
 385
 386
 387     #print STDERR "Rendering label: ".$self->get_name()." Location: $x, $y. \n";
 388     if (!$self->is_hidden()) {
 389         if ($self->get_hilited()) {
 390             $image->filledRectangle($self->get_enclosing_rect(), $bg_color);
 391         }
 392
 393         $image->string($self->get_font(), $x, $y, $self->get_name(),$text_color);
 394         $self->render_line($image);
 395     }
 396 }
 397
 398 # render_line is factored out so that it is easy to create
 399 # subclasses that draw the lines differently (see for
 400 # example CXGN::Cview::Label::RangeLabel).
 401 #
 402 sub render_line {
 403     my $self = shift;
 404     my $image = shift;
 405     my $line_color = $image->colorResolve($self->get_line_color());
 406     $image -> setAntiAliased($line_color);
 407     my $width = 0;
 408
 409     # calculate the point that the line should connect to
 410     # on the label
 411     #
 412     my ($x, $y, $a, $b) = $self->get_enclosing_rect();
 413     my ($connection_x, $connection_y) = (0, 0);
 414
 415     if ($self->get_align_side() eq "right") {
 416         $connection_x = $a;
 417         $connection_y = $y + CXGN::Cview::ImageObject::round(($b - $y ) /2);
 418
 419     }
 420     elsif ($self->get_align_side() eq "left") {
 421         $connection_x = $x;
 422         $connection_y = $y + CXGN::Cview::ImageObject::round(($b - $y)/2);
 423     }
 424
 425     # adjust for label height
 426     #
 427     $image->line($connection_x, $connection_y,  ($self->get_reference_point())[0], ($self->get_reference_point())[1], gdAntiAliased );
 428     #$image->rectangle($self->get_enclosing_rect(), $line_color);
 429 }
 430
 431 sub calc_coords {
 432     my $self = shift;
 433     $self->calculate_width();
 434     $self->calculate_height();
 435
 436     if ($self->get_align_side() eq "default") {
 437         if ($self->get_horizontal_offset()<($self->get_reference_point())[0]) {
 438             $self->align_right();
 439         }
 440         else {
 441             $self->align_left();
 442         }
 443     }
 444
 445     my ($x, $y) = ($self->get_horizontal_offset(), $self->get_vertical_offset());
 446     my ($a, $b);
 447
 448     $x = $self->get_horizontal_offset(); #- $self->get_label_spacer();
 449     $y = $self->get_vertical_offset(); # -int($self->get_height()/2);
 450
 451     if ($self->get_align_side() eq "right" && $self->get_orientation() eq "horizontal") {
 452
 453         my $old_x = $x;
 454         $x = $x - $self->get_width() ;
 455         $a = $old_x;
 456         $b = $y + $self->get_height();
 457 #       $self->set_horizontal_offset($x);
 458 #       $self->set_vertical_offset($y);
 459
 460         #print STDERR "before: calculated label coords: $x, $y, $a, $b\n";
 461     }
 462     if ($self->get_align_side() eq "left" && $self->get_orientation() eq "horizontal") {
 463         #$x += $self->get_label_spacer();
 464         $a = $x + $self->get_width();
 465         $b = $y + $self->get_height();
 466
 467         #print STDERR "after:calculated label coords: $x, $y, $a, $b\n";
 468     }
 469     if ($self->get_align_side() eq "center" && $self->get_orientation() eq "horizontal") {
 470         $x = $x - int($self->get_width()/2);
 471         $y = $y - int($self->get_height()/2);
 472         $a = $x + int($self->get_width()/2);
 473         $b = $y + $self->get_height();
 474     }
 475     # (vertical not yet supported.)
 476
 477     $self->set_enclosing_rect($x, $y -int($self->get_height()/2), $a, $b-int($self->get_height()/2));
 478 }
 479
 480 =head2 function set_orientation_vertical(), get_orientation_vertical()
 481
 482   Synopsis:     not yet supported.
 483   Arguments:
 484   Returns:
 485   Side effects:
 486   Description:
 487
 488 =cut
 489
 490 sub set_orientation_vertical {
 491     my $self = shift;
 492     warn "vertical orientation not yet supported.\n";
 493 }
 494
 495 sub set_orientation_horizontal {
 496     my $self = shift;
 497     $self->{orientation}="horizontal";
 498 }
 499
 500 =head2 function get_orientation()
 501
 502   Synopsis:     not yet supported.
 503   Arguments:
 504   Returns:
 505   Side effects:
 506   Description:
 507
 508 =cut
 509
 510 sub get_orientation {
 511     my $self = shift;
 512     # only horizontal supported at this time.
 513     return "horizontal";
 514 }
 515
 516 sub calculate_width {
 517     my $self =shift;
 518     my $width = $self->get_font()->width()* length($self->get_name());
 519     $self->set_width($width);
 520     return $width;
 521 }
 522
 523 sub get_width {
 524     my $self = shift;
 525     my $width = $self->calculate_width();
 526     if (!defined($width)) { return 0; }
 527     return $width;
 528 }
 529
 530 sub get_height {
 531     my $self = shift;
 532     my $height = $self->calculate_height();
 533     if (!defined($height)) { return 0; }
 534     return $height;
 535 }
 536
 537 sub calculate_height {
 538     my $self = shift;
 539     my $height = $self->get_font()->height();
 540     $self->set_height($height);
 541     return $height;
 542 }
 543
 544 =head2 function get_label_spacer(), set_label_spacer()
 545
 546   Synopsis:     DEPRECATED. Use set_stacking_height instead.
 547   Arguments:
 548   Returns:
 549   Side effects:
 550   Description:
 551
 552 =cut
 553
 554 sub get_label_spacer {
 555     my $self=shift;
 556     return $self->{label_spacer};
 557 }
 558
 559 sub set_label_spacer {
 560     my $self=shift;
 561     $self->{label_spacer}=shift;
 562 }
 563
 564
 565 =head2 accessors get_stacking_level(), set_stacking_level()
 566
 567   Synopsis:
 568   Args, Ret:    the level that some label features are moved
 569                 horizontally, by get_stacking_level()*get_stacking_height()
 570                 pixels. The chromosome renderer will adjust this value
 571                 such that certain label types, ie CXGN::Cview::Label::RangeLabel,
 572                 won\'t clobber each other visually in the horizontal
 573                 dimension.
 574   Side effects: affects the rendering of the Label object.
 575   Description:
 576
 577 =cut
 578
 579 sub get_stacking_level {
 580     my $self=shift;
 581     return $self->{stacking_level};
 582 }
 583
 584 sub set_stacking_level {
 585     my $self=shift;
 586     $self->{stacking_level}=shift;
 587 }
 588
 589
 590
 591 =head2 accessors get_stacking_height(), set_stacking_height()
 592
 593   Synopsis:
 594   Args/Ret:     the stacking height, which is the number of pixels
 595                 that label features will be pushed over in the horizontal
 596                 dimension to prevent labels from overlapping.
 597                 This is currently implemented only in RangeLabel.
 598   Side effects:
 599   Description:
 600
 601 =cut
 602
 603 sub get_stacking_height {
 604     my $self=shift;
 605     return $self->{stacking_height} || 3;
 606 }
 607
 608 sub set_stacking_height {
 609     my $self=shift;
 610     $self->{stacking_height}=shift;
 611 }
 612
 613 =head2 accessors set_vertical_stacking_spacing, get_vertical_stacking_spacing
 614
 615   Property:     the space that is allowed to remain when two labels
 616                 are physically next to each other
 617   Setter Args:
 618   Getter Args:
 619   Getter Ret:
 620   Side Effects:
 621   Description:
 622
 623 =cut
 624
 625 sub get_vertical_stacking_spacing {
 626 my $self=shift;
 627 return $self->{vertical_stacking_spacing};
 628 }
 629
 630 sub set_vertical_stacking_spacing {
 631 my $self=shift;
 632 $self->{vertical_stacking_spacing}=shift;
 633 }
 634
 635
 636
 637
 638
 639 =head2 functions get_north_position(), set_north_position
 640
 641   Synopsis:     $m->set_north_position(57)
 642   Args/returns: position in pixels that describes the northern limit
 643                 of the marker\'s range
 644   Side effects:
 645   Description:
 646
 647 =cut
 648
 649 sub get_north_position {
 650     my $self=shift;
 651     return $self->{north_position};
 652 }
 653
 654 sub set_north_position {
 655     my $self=shift;
 656     my $pos = shift;
 657     $self->{north_position}=$pos;
 658 }
 659
 660 =head2 functions get_south_position(), set_south_position()
 661
 662   Synopsis:     $m->set_south_position(78)
 663   Description:  see set_north_position()
 664
 665 =cut
 666
 667 sub get_south_position {
 668     my $self=shift;
 669     return $self->{south_position};
 670 }
 671
 672 sub set_south_position {
 673     my $self=shift;
 674     my $pos = shift;
 675     $self->{south_position}=$pos;
 676
 677 }
 678
 679
 680
 681 =head2 function get_image_map()
 682
 683   Synopsis:
 684   Arguments:
 685   Returns:      an html image map for this label, if set_url() was
 686                 used to set a http link.
 687   Side effects:
 688   Description:
 689
 690 =cut
 691
 692 sub get_image_map {
 693     my $self = shift;
 694     my $s = "";
 695
 696     if ($self->get_url()) {
 697         $s .= "<area shape=\"rect\" coords=\"".(join ",", $self->get_enclosing_rect())."\" href=\"".$self->get_url()."\" alt=\"\" />\n";
 698     }
 699     return $s;
 700 }
 701
 702
 703
 704 sub copy {
 705     my $self = shift;
 706
 707
 708 }
 709
 710
 711 1;
 712
 713
 714