Beautiful Code [177]
This choice implies that all glyphs contained inside the track share the same class. In other words, if a particular feature contains three nested levels of subfeatures, and the user has selected the arrow glyph to use for the features in the track, then each arrow glyph contains arrow subglyphs, and these contain arrow sub-subglyphs. This sounds like a serious limitation, but it actually makes some sense. Typically, a glyph and its subparts act together, and making them all of the subclass allows one to keep all the relevant code in one place. Furthermore, glyphs can escape this restriction by overriding their new() constructors in order to create subglyphs of whatever type they choose.
The final Bio::Graphics::Glyph::Factory class has just a few methods:
The constructor
The constructor creates a new factory:
Code View: Scroll / Show All
$factory = Bio::Graphics::Glyph::Factory->new(-options=> \%options, -panel => $panel);
During construction, it takes a list of options passed to it by the panel's add_track() method and stores them internally. The factory can also hold a copy of the panel. I added this so that the factory could provide information about the panel, such as the panel's scale.
The options are actually passed as a reference to a hash (a Perl dictionary of name/ value pairs). The Panel's add_track() method has the minor duty of turning the list of -option=>$value pairs passed to it into a hash to pass to the factory's new() method.
The option( ) method
Given an option name, the factory looks up its value and returns it:
$option_value = $factory->option ('option_name')
If no option by this name is set, option() looks to see whether there is a default value and returns that.
The make_glyph( ) method
Given a list of features, the factory creates a list of glyphs of the appropriate class:
@glyphs = $factory->make_glyph($feature1,$feature2,$feature3...)
Now we'll look at a simplified version of the Bio::Graphics::Glyph::Factory code:
Code View: Scroll / Show All
1 package Bio::Graphics::Glyph::Factory;
2 use strict;
3 my %GENERIC_OPTIONS = (
4 bgcolor => 'turquoise',
5 fgcolor => 'black',
6 fontcolor => 'black',
7 font2color => 'turquoise',
8 height => 8,
9 font => 'gdSmallFont',
10 glyph => 'generic',
11 );
12 sub new {
13 my $class = shift;
14 my %args = @_;
15 my $options = $args{-options}; # the options, as a hash reference
16 my $panel = $args{-panel};
17 return bless {
18 options => $options,
19 panel => $panel,
20 },$class;
21 }
22 sub option {
23 my $self = shift;
24 my $option_name = shift;
25 $option_name = lc $option_name; # all options are lower case
26 if (exists $self->{options}{$option_name}) {
27 return $self->{options}{$option_name};
28 } else {
29 return $GENERIC_OPTIONS{$option_name};
30 }
31 }
32 sub make_glyph {
33 my $self = shift;
34 my @result;
35 my $glyph_type = $self->option('glyph');
36 my $glyph_class = 'Bio::Graphics::Glyph::' . $glyph_type;
37 eval("require $glyph_class"!) unless $glyph_class->can('new');
38 for my $feature (@_) {
39 my $glyph = $glyph_class->new(-feature => $f,
40 -factory => $self);
41 push @result,$glyph;
42 }
43 return @result;
44 }
45 1;
I start by declaring the package name and turning on strict type checking (lines 1 and 2).
I then define a package-specific hash containing some generic glyph options to use as fallback defaults. Among the options are a default background color, a default height, and a default font (lines 3–11).
The new() constructor reads its arguments from @_ (the Perl subroutine argument list) into a hash named %args. It then looks for two named arguments, -options and -panel. It saves these options into an internal