######### # Author: rmp@sanger.ac.uk # Maintainer: webmaster@sanger.ac.uk # Created: 2001 # package Sanger::Graphics::GlyphSet; use strict; use warnings; no warnings 'uninitialized'; use base qw( Sanger::Graphics::Root ); use Sanger::Graphics::Glyph::Diagnostic; use Sanger::Graphics::Glyph::Text; use Sanger::Graphics::Root; use Sanger::Graphics::Glyph::Space; ######### # constructor # sub new { my ($class, $Container, $Config, $highlights, $strand, $extra_config) = @_; my $self = { 'glyphs' => [], 'x' => undef, 'y' => undef, 'width' => undef, 'highlights' => $highlights, 'strand' => $strand, 'minx' => undef, 'miny' => undef, 'maxx' => undef, 'maxy' => undef, 'label' => undef, 'bumped' => undef, 'bumpbutton' => undef, 'label2' => undef, 'container' => $Container, 'config' => $Config, 'extras' => $extra_config, }; bless($self, $class); $self->init_label() if($self->can('init_label')); return $self; } ######### # _init creates masses of Glyphs from a data source. # It should executes bumping and globbing on the fly and also # keep track of x,y,width,height as it goes. # sub _init { my ($self) = @_; print STDERR qq($self unimplemented\n); } # Gets the number of Base Pairs per pixel sub basepairs_per_pixel { my ($self) = @_; my $pixels = $self->{'config'}->get_parameter( 'width' ); return (defined $pixels && $pixels) ? $self->{'container'}->length() / $pixels : undef; } sub glob_bp { my ($self) = @_; return int( $self->basepairs_per_pixel()*2 ); } # join_tag joins between glyphsets in different tracks #$self->join_tag( # $tglyph, # A glyph you've drawn... # $key, # Key for glyph # $T, # X position in glyph (0-1) # 0, # Y position in glyph (0-1) 0 nearest contigs # $colour, # colour to draw shape # 'fill', # whether to fill or draw line # -99 # z-index #); sub join_tag { my( $self, $glyph, $tag, $x_pos, $y_pos, $col, $style, $zindex, $href, $alt ) = @_; if( ref($x_pos) eq 'HASH' ) { CORE::push @{$self->{'tags'}{$tag}}, { %$x_pos, 'glyph' => $glyph }; } else { CORE::push @{$self->{'tags'}{$tag}}, { 'glyph' => $glyph, 'x' => $x_pos, 'y' => $y_pos, 'col' => $col, 'style' => $style, 'z' => $zindex, 'href' => $href, 'alt' => $alt }; } } ######### # return our list of glyphs # sub glyphs { my ($self) = @_; return @{$self->{'glyphs'}}; } ######### # push either a Glyph or a GlyphSet on to our list # sub push { my $self = CORE::shift; my ($gx, $gx1, $gy, $gy1); foreach my $Glyph (@_) { CORE::push @{$self->{'glyphs'}}, $Glyph; $gx = $Glyph->x() || 0; $gx1 = $gx + ($Glyph->width() || 0); $gy = $Glyph->y() || 0; $gy1 = $gy + ($Glyph->height() || 0); ######### track max and min dimensions $self->minx($gx) unless defined $self->minx && $self->minx < $gx; $self->maxx($gx1) unless defined $self->maxx && $self->maxx > $gx1; $self->miny($gy) unless defined $self->miny && $self->miny < $gy; $self->maxy($gy1) unless defined $self->maxy && $self->maxy > $gy1; } } ######### # unshift a Glyph or GlyphSet onto our list # sub unshift { my $self = CORE::shift; my ($gx, $gx1, $gy, $gy1); foreach my $Glyph (reverse @_) { CORE::unshift @{$self->{'glyphs'}}, $Glyph; $gx = $Glyph->x(); $gx1 = $gx + $Glyph->width(); $gy = $Glyph->y(); $gy1 = $gy + $Glyph->height(); $self->minx($gx) unless defined $self->minx && $self->minx < $gx; $self->maxx($gx1) unless defined $self->maxx && $self->maxx > $gx1; $self->miny($gy) unless defined $self->miny && $self->miny < $gy; $self->maxy($gy1) unless defined $self->maxy && $self->maxy > $gy1; } } ########## pop/shift a Glyph off our list # needs to shrink glyphset dimensions if the glyph/glyphset we pop off sub pop { my ($self) = @_; return CORE::pop @{$self->{'glyphs'}}; } sub shift { my ($self) = @_; return CORE::shift @{$self->{'glyphs'}}; } ########## read-only getters sub x { my ($self) = @_; return $self->{'x'}; } sub y { my ($self) = @_; return $self->{'y'}; } sub highlights { my ($self) = @_; return defined $self->{'highlights'} ? @{$self->{'highlights'}} : (); } ########## read-write get/setters... sub minx { my ($self, $minx) = @_; $self->{'minx'} = $minx if(defined $minx); return $self->{'minx'}; } sub miny { my ($self, $miny) = @_; $self->{'miny'} = $miny if(defined $miny); return $self->{'miny'}; } sub maxx { my ($self, $maxx) = @_; $self->{'maxx'} = $maxx if(defined $maxx); return $self->{'maxx'}; } sub maxy { my ($self, $maxy) = @_; $self->{'maxy'} = $maxy if(defined $maxy); return $self->{'maxy'}; }; sub strand { my ($self, $strand) = @_; $self->{'strand'} = $strand if(defined $strand); return $self->{'strand'}; } sub label { my ($self, $val) = @_; $self->{'label'} = $val if(defined $val); return $self->{'label'}; } sub bumped { my ($self, $val) = @_; $self->{'bumped'} = $val if(defined $val); return $self->{'bumped'}; } ## ## additional derived functions ## sub height { my ($self) = @_; return abs($self->{'maxy'}-$self->{'miny'}); } sub width { my ($self) = @_; return abs($self->{'maxx'}-$self->{'minx'}); } sub length { my ($self) = @_; return scalar @{$self->{'glyphs'}}; } sub transform { my ($self) = @_; my $T = $self->{'config'}->{'transform'}; foreach( @{$self->{'glyphs'}} ) { $_->transform($T); } } sub _dump { my($self) = CORE::shift; $self->push( new Sanger::Graphics::Glyph::Diagnostic({ 'x' =>0 , 'y' =>0 , 'track' => ref($self), 'strand' => $self->strand(), 'glyphs' => scalar @{$self->{'glyphs'}}, @_ })); return; } sub errorTrack { my ($self, $message, $x, $y) = @_; my $length = $self->{'config'}->image_width(); my $w = $self->{'config'}->texthelper()->width('Tiny'); my $h = $self->{'config'}->texthelper()->height('Tiny'); my $h2 = $self->{'config'}->texthelper()->height('Small'); $self->push( new Sanger::Graphics::Glyph::Text({ 'x' => $x || int( ($length - $w * CORE::length($message))/2 ), 'y' => $y || int( ($h2-$h)/2 ), 'height' => $h2, 'font' => 'Tiny', 'colour' => "red", 'text' => $message, 'absolutey' => 1, 'absolutex' => 1, 'absolutewidth' => 1, 'pixperbp' => $self->{'config'}->{'transform'}->{'scalex'} , }) ); return; } sub commify { CORE::shift; local $_ = reverse $_[0]; s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; return scalar reverse $_; } sub check { my $self = CORE::shift; my ($name) = ref($self) =~ /::([^:]+)$/; return $name; } 1;