• Choose a category
• All
• Classic-Fiction

By Root 5185 0

is represented as a floating-point number between 0 and 1.0, I return an option value of white if the score is less than 0.25, a value of pink if the score is greater than 0.25 but less than 0.75, and red if it is greater than 0.75. Figure 12-3 shows how this might look.

Figure 12-3. Colorizing the background according to dynamically changing values

In the end, I made it possible to use code callbacks for every option passed to add_track(), including the -glyph option itself. This gives the end user an amazing amount of flexibility for customizing and extending the library. For example, it greatly simplifies "semantic zooming," or changing the appearance of tracks depending on the size of the region to display. The following callback turns off collision control when the region gets larger than 50,000 bp:

-bump => sub {

my ($feature,$option_name,$glyph) = @_; # get all args

return $glyph->panel->length < 50_000;

}

Let's now have a look at a simplified version of the revised option-processing code. First, I modified Bio::Graphics::Glyph::Factory to look like this:

Code View: Scroll / Show All

# In Bio::Graphics::Glyph::Factory

sub option {

my $self = shift;

my ($glyph,$option_name) = @_;

$option_name = lc $option_name; # all options are lowercase

my $value;

if (exists $self->{options}{$option_name}) {

$value = $self->{options}{$option_name};

} else {

$value = $GENERIC_OPTIONS{$option_name};

}

return $value unless ref $value eq 'CODE';

my $feature = $glyph->feature;

my $eval = eval {$value->($feature,$option_name,$glyph)};

warn "Error while evaluating "$option_name' option for glyph $glyph, feature

$feature: ",$@,"\n"

if $@;

return defined $eval && $eval eq '*default*' ?

$GENERIC_OPTIONS{$option_name}

: $eval;

}

The method now takes two arguments rather than one. The first argument is the current glyph, while the second one is the option name as before. Once again, the factory looks first in its hash of track-specific options and then in the defaults hash (%GENERIC_OPTIONS)if the option wasn't named in the track configuration.

However, additional logic now comes after retrieving the option value. I call Perl's ref() function to look up the data type of the contents of $value. If it is a code reference, ref() returns the string CODE. If I don't get CODE, I just return the value as before. Otherwise, I get the corresponding feature by calling the glyph's feature() method, and then invoke the code reference by using Perl's anonymous code reference invocation syntax:

$value->($feature,$option_name,$glyph)

The first argument passed to the callback is the feature, the second is the option name, and the third is the glyph itself.

Because the callback might cause a runtime error, I defend against this possibility by wrapping the entire call in an eval {} block. In case of a fatal error in the callback, this will return an undefined value and place Perl error diagnostics into the special scalar $@. After invoking the callback, I check whether $@ is nonempty and, if so, print a nonfatal warning.

The last step is to return the value derived from the callback. I thought it would be useful for the callback to be able to indicate that it wanted to use the default value for the named option. The last line of code simply checks whether the callback returned the string *default* and, if so, returns the value from the defaults hash.

To accommodate this change in the factory's option() method, I had to make a corresponding change to Bio::Graphics::Glyph->option():

# In Bio::Graphics::Glyph

sub option {

my $self = shift;

my ($option_name) = @_;

return $self->factory->option($self,$option_name);

}

As I worked with callbacks, I found them to be an increasingly useful concept. For example, I realized that callbacks handle semantic zooming very nicely. The gene glyph draws a detailed representation of a protein-coding gene's internal structure, which is fine at high magnifications, but doesn't work when viewing very large regions,