Skip to content
Browse files

This is a preliminary rewrite of the Ace::Graphics module. It

provides flexible lightweight drawing of horizontal maps for
sequences, contigs and other biological maps.
  • Loading branch information...
0 parents commit d0fd22eddefb91668fbe380c91e1986578240d88 @lstein lstein committed
6 Changes
@@ -0,0 +1,6 @@
+Revision history for Perl extension Bio::Graphics.
+
+0.01 Tue Jun 5 07:26:52 2001
+ - original version; created by h2xs 1.20 with options
+ -n Bio::Graphics -A
+
115 Graphics/Feature.pm
@@ -0,0 +1,115 @@
+package Bio::Graphics::Feature;
+
+use strict;
+*stop = \&end;
+*info = \&name;
+*seqname = \&name;
+*primary_tag = \&type;
+*exons = *sub_SeqFeature = *merged_segments = \&segments;
+
+# usage:
+# Ace::Graphics::Feature->new(
+# -start => 1,
+# -end => 100,
+# -name => 'fred feature',
+# -strand => +1);
+#
+# Alternatively, use -segments => [ [start,stop],[start,stop]...]
+# to create a multisegmented feature.
+sub new {
+ my $class= shift;
+ my %arg = @_;
+
+ my $self = bless {},$class;
+
+ $arg{-strand} ||= 0;
+ $self->{strand} = $arg{-strand} >= 0 ? +1 : -1;
+ $self->{name} = $arg{-name};
+ $self->{type} = $arg{-type} || 'feature';
+ $self->{source} = $arg{-source} || $arg{-source_tag} || 'dummy';
+
+ if (my $s = $arg{-segments}) {
+
+ my @segments;
+ for my $seg (@$s) {
+ if (ref($seg) eq 'ARRAY') {
+ push @segments,$class->new(-start=>$seg->[0],
+ -stop=>$seg->[1],
+ -strand=>$self->{strand},
+ -type => $arg{-subtype}||'feature');
+ } else {
+ push @segments,$seg;
+ }
+ }
+
+ $self->{segments} = [ sort {$a->start <=> $b->start } @segments ];
+ $self->{start} = $self->{segments}[0]->start;
+ ($self->{end}) = sort { $b <=> $a } map { $_->stop} @segments;
+
+ } else {
+ $self->{start} = $arg{-start};
+ $self->{end} = $arg{-end} || $arg{-stop};
+ }
+
+ $self;
+}
+
+sub segments {
+ my $self = shift;
+ my $s = $self->{segments} or return;
+ @$s;
+}
+sub type { shift->{type} }
+sub strand { shift->{strand} }
+sub name { shift->{name} }
+sub start {
+ my $self = shift;
+ return $self->{start};
+}
+sub end {
+ my $self = shift;
+ return $self->{end};
+}
+sub length {
+ my $self = shift;
+ return $self->end - $self->start + 1;
+}
+sub introns {
+ my $self = shift;
+ return;
+}
+sub source_tag { shift->{source} }
+
+1;
+
+__END__
+
+=head1 NAME
+
+Ace::Graphics::Fk - A dummy feature object used for generating panel key tracks
+
+=head1 SYNOPSIS
+
+None. Used internally by Ace::Graphics::Panel.
+
+=head1 DESCRIPTION
+
+None. Used internally by Ace::Graphics::Panel.
+
+=head1 SEE ALSO
+
+L<Ace::Sequence>,L<Ace::Sequence::Feature>,
+L<Ace::Graphics::Track>,L<Ace::Graphics::Glyph>,
+L<GD>
+
+=head1 AUTHOR
+
+Lincoln Stein <lstein@cshl.org>.
+
+Copyright (c) 2001 Cold Spring Harbor Laboratory
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. See DISCLAIMER.txt for
+disclaimers of warranty.
+
+=cut
457 Graphics/Glyph.pm
@@ -0,0 +1,457 @@
+package Bio::Graphics::Glyph;
+use GD;
+
+use strict;
+use Carp 'croak';
+use constant BUMP_SPACING => 2; # vertical distance between bumped glyphs
+
+# a bumpable graphical object that has bumpable graphical subparts
+
+# args: -feature => $feature_object (may contain subsequences)
+# -factory => $factory_object (called to create glyphs for subsequences)
+# In this scheme, the factory decides based on stylesheet information what glyph to
+# draw and what configurations options to us. This allows for heterogeneous tracks.
+sub new {
+ my $class = shift;
+ my %arg = @_;
+
+ my $feature = $arg{-feature} or die "No feature";
+ my $factory = $arg{-factory} || $class->default_factory;
+
+ my $self = bless {},$class;
+ $self->{feature} = $feature;
+ $self->{factory} = $factory;
+ $self->{top} = 0;
+
+ if (my @subfeatures = $self->subseq($feature)) {
+ my @subglyphs = sort { $a->left <=> $b->left }
+ $factory->make_glyph(@subfeatures); # dynamic glyph resolution
+
+ $self->{left} = $subglyphs[0]->{left};
+ my $right = (sort { $b<=>$a } map {$_->{left} + $_->{width} - 1} @subglyphs)[0];
+ $self->{width} = $right - $self->{left} + 1;
+ $self->{parts} = \@subglyphs;
+ }
+
+ else {
+ my ($left,$right) = $factory->map_pt($feature->start,$feature->stop);
+ ($left,$right) = ($right,$left) if $left > $right; # paranoia
+ $self->{left} = $left;
+ $self->{width} = $right - $left + 1;
+ }
+ return $self;
+}
+
+sub parts {
+ my $self = shift;
+ return unless $self->{parts};
+ return wantarray ? @{$self->{parts}} : $self->{parts};
+}
+
+sub feature { shift->{feature} }
+sub factory { shift->{factory} }
+sub panel { shift->factory->panel }
+sub scale { shift->factory->scale }
+sub start { shift->{feature}->start}
+sub stop { shift->{feature}->stop}
+sub end { shift->{feature}->stop}
+sub map_pt { shift->{factory}->map_pt(@_) }
+
+sub top {
+ my $self = shift;
+ my $g = $self->{top};
+ $self->{top} = shift if @_;
+ $g;
+}
+sub left {
+ my $self = shift;
+ $self->{left} - $self->pad_left;
+}
+sub right {
+ my $self = shift;
+ $self->left + $self->layout_width - 1;
+}
+sub bottom {
+ my $self = shift;
+ $self->top + $self->layout_height - 1;
+}
+sub height {
+ my $self = shift;
+ return $self->{height} if exists $self->{height};
+ my $baseheight = $self->option('height'); # what the factory says
+ return $self->{height} = $baseheight;
+}
+sub width {
+ my $self = shift;
+ my $g = $self->{width};
+ $self->{width} = shift if @_;
+ $g;
+}
+sub layout_height {
+ my $self = shift;
+ return $self->layout;
+}
+sub layout_width {
+ my $self = shift;
+ $self->{layout_width} ||= $self->width + $self->pad_left + $self->pad_right;
+ return $self->{layout_width};
+}
+
+# returns the rectangle that surrounds the physical part of the
+# glyph, excluding labels and other "extra" stuff
+sub bounds {
+ my $self = shift;
+ my ($dx,$dy) = @_;
+ $dx += 0; $dy += 0;
+ ($dx + $self->{left},
+ $dy + $self->top + $self->pad_top,
+ $dx + $self->{left} + $self->{width} -1,
+ $dy + $self->bottom - $self->pad_bottom);
+}
+sub box {
+ my $self = shift;
+ ($self->left,$self->top,$self->right,$self->bottom);
+}
+
+# return boxes surrounding each part
+sub boxes {
+ my $self = shift;
+ my ($left,$top) = @_;
+ $top += 0; $left += 0;
+ my @result;
+
+ $self->layout;
+ for my $part ($self->parts) {
+ if ($part->feature->type eq 'group') {
+ push @result,$part->boxes($left+$self->left,$top+$self->top);
+ } else {
+ my ($x1,$y1,$x2,$y2) = $part->box;
+ push @result,[$part->feature,$left+$x1,$top+$self->top+$y1,$left+$x2,$top+$self->top+$y2];
+ }
+ }
+ return wantarray ? @result : \@result;
+}
+
+# this should be overridden for labels, etc.
+# allows glyph to make itself thicker or thinner depending on
+# domain-specific knowledge
+sub pad_top {
+ my $self = shift;
+ return 0;
+}
+sub pad_bottom {
+ my $self = shift;
+ return 0;
+}
+sub pad_left {
+ my $self = shift;
+ return 0;
+}
+sub pad_right {
+ my $self = shift;
+ return 0;
+}
+
+# move relative to parent
+sub move {
+ my $self = shift;
+ my ($dx,$dy) = @_;
+ $self->{left} += $dx;
+ $self->{top} += $dy;
+}
+
+# get an option
+sub option {
+ my $self = shift;
+ my ($option_name,$partno) = @_;
+ my $factory = $self->factory;
+ return unless $factory;
+ $factory->option($self,$option_name,$partno);
+}
+
+# some common options
+sub color {
+ my $self = shift;
+ my $color = shift;
+ my $partno = shift;
+ my $index = $self->option($color,$partno);
+ # turn into a color index
+ return $self->factory->translate_color($index) if defined $index;
+ return 0;
+}
+
+sub connector {
+ return shift->option('connector',@_);
+}
+
+# return value:
+# 0 no bumping
+# +1 bump down
+# -1 bump up
+sub bump {
+ my $self = shift;
+ return $self->option('bump');
+}
+
+sub fgcolor {
+ shift->color('fgcolor');
+}
+sub bgcolor {
+ shift->color('bgcolor');
+}
+sub font {
+ shift->option('font');
+}
+sub fontcolor {
+ my $self = shift;
+ $self->color('fontcolor') || $self->fgcolor;
+}
+sub connector_color {
+ my $self = shift;
+ my $partno = shift;
+ $self->color('connector_color',$partno) || $self->fgcolor;
+}
+
+# handle collision detection
+sub layout {
+ my $self = shift;
+ return $self->{layout_height} if exists $self->{layout_height};
+
+ my @parts = $self->parts
+ or return $self->{layout_height} = $self->height + $self->pad_top + $self->pad_bottom;
+ my $bump_direction = $self->bump;
+
+ unless ($bump_direction) { # no layout to do. everything overlaps
+ return $self->{layout_height} = $self->height;
+ }
+
+ $_->layout foreach @parts; # recursively lay out
+
+ my @occupied;
+ my $rightmost = -2;
+ for my $g (sort { $a->left <=> $b->left} @parts) {
+
+ my $pos = 0;
+ while (1) {
+ # look for collisions
+ last if $g->left > $rightmost + 2;
+ my $bottom = $pos + $g->layout_height;
+
+ my $collision = 0;
+ for my $old (@occupied) {
+ last if $old->right + 2 < $g->left;
+ next if $old->bottom < $pos;
+ next if $old->top > $bottom;
+ $collision = $old;
+ last;
+ }
+ last unless $collision;
+ if ($bump_direction > 0) {
+ $pos += $collision->height + BUMP_SPACING; # collision, so bump
+
+ } else {
+ $pos -= $g->height - BUMP_SPACING;
+ }
+ }
+ $g->move(0,$pos);
+ @occupied = sort { $b->right <=> $a->right } ($g,@occupied);
+ $rightmost = $g->right if $g->right > $rightmost;
+ }
+
+ # If -1 bumping was allowed, then normalize so that the top glyph is at zero
+ if ($bump_direction < 0) {
+ my ($topmost) = sort {$a->top <=> $b->top} @parts;
+ my $offset = 0 - $topmost->top;
+ $_->move(0,$offset) foreach @parts;
+ }
+
+ # find new height
+ my $bottom = 0;
+ foreach (@parts) {
+ $bottom = $_->bottom if $_->bottom > $bottom;
+ }
+ return $self->{layout_height} = $self->pad_bottom + $self->pad_top + $bottom - $self->top + 1;
+}
+
+sub draw {
+ my $self = shift;
+ my $gd = shift;
+ my ($left,$top,$partno,$total_parts) = @_;
+
+ $self->layout;
+ if (my @parts = $self->parts) {
+ my $connector = $self->connector;
+ my $x = $left;
+ my $y = $top + $self->top + $self->pad_top;
+ for (my $i=0; $i<@parts; $i++) {
+ $parts[$i]->draw($gd,$x,$y,$i,scalar(@parts));
+ }
+ $self->draw_connectors($gd,$x,$y) if $connector;
+ } else { # no part
+ $self->draw_component($gd,$left,$top,$partno,$total_parts);
+ }
+}
+
+sub draw_connectors {
+ my $self = shift;
+ my $gd = shift;
+ my ($dx,$dy) = @_;
+ my @parts = sort { $a->left <=> $b->left } $self->parts;
+ for (my $i = 0; $i < @parts-1; $i++) {
+ my($xl,$xt,$xr,$xb) = $parts[$i]->bounds;
+ my($yl,$yt,$yr,$yb) = $parts[$i+1]->bounds;
+
+ my $left = $dx + $xr;
+ my $right = $dx + $yl;
+ my $top1 = $dy + $xt;
+ my $bottom1 = $dy + $xb;
+ my $top2 = $dy + $yt;
+ my $bottom2 = $dy + $yb;
+
+ $self->draw_connector($gd,$i,
+ $top1,$bottom1,$left,
+ $top2,$bottom2,$right,
+ );
+ }
+}
+
+sub draw_connector {
+ my $self = shift;
+ my $gd = shift;
+ my $partno = shift;
+
+ my $color = $self->connector_color($partno||0);
+ my $connector_type = $self->connector($partno) or return;
+ if ($connector_type eq 'hat') {
+ $self->draw_hat_connector($gd,$color,@_);
+ } elsif ($connector_type eq 'solid') {
+ $self->draw_solid_connector($gd,$color,@_);
+ } elsif ($connector_type eq 'dashed') {
+ $self->draw_dashed_connector($gd,$color,@_);
+ } else {
+ ; # draw nothing
+ }
+}
+
+sub draw_hat_connector {
+ my $self = shift;
+ my $gd = shift;
+ my $color = shift;
+ my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;
+
+ my $center1 = ($top1 + $bottom1)/2;
+ my $quarter1 = $top1 + ($bottom1-$top1)/4;
+ my $center2 = ($top2 + $bottom2)/2;
+ my $quarter2 = $top2 + ($bottom2-$top2)/4;
+
+ if ($center1 != $center2) {
+ $self->draw_solid_connector($gd,$color,@_);
+ return;
+ }
+
+ if ($right - $left > 3) { # room for the inverted "V"
+ my $middle = $left + ($right - $left)/2;
+ $gd->line($left,$center1,$middle,$top1,$color);
+ $gd->line($middle,$top1,$right,$center1,$color);
+ } elsif ($right-$left > 1) { # no room, just connect
+ $gd->line($left,$quarter1,$right,$quarter1,$color);
+ }
+
+}
+
+sub draw_solid_connector {
+ my $self = shift;
+ my $gd = shift;
+ my $color = shift;
+ my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;
+
+ my $center1 = ($top1 + $bottom1)/2;
+ my $center2 = ($top2 + $bottom2)/2;
+
+ $gd->line($left,$center1,$right,$center2,$color);
+}
+
+sub draw_dashed_connector {
+ my $self = shift;
+ my $gd = shift;
+ my $color = shift;
+ my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;
+
+ my $center1 = ($top1 + $bottom1)/2;
+ my $center2 = ($top2 + $bottom2)/2;
+
+ $gd->setStyle($color,$color,gdTransparent,gdTransparent,);
+ $gd->line($left,$center1,$right,$center2,gdStyled);
+}
+
+sub filled_box {
+ my $self = shift;
+ my $gd = shift;
+ my ($x1,$y1,$x2,$y2) = @_;
+
+ my $linewidth = $self->option('linewidth') || 1;
+ $gd->filledRectangle($x1,$y1,$x2,$y2,$self->bgcolor);
+ $gd->rectangle($x1,$y1,$x2,$y2,$self->fgcolor);
+
+ # if the left end is off the end, then cover over
+ # the leftmost line
+ my ($width) = $gd->getBounds;
+ $gd->line($x1,$y1,$x1,$y2,$self->bgcolor)
+ if $x1 < 0;
+
+ $gd->line($x2,$y1,$x2,$y2,$self->bgcolor)
+ if $x2 > $width;
+}
+
+sub filled_oval {
+ my $self = shift;
+ my $gd = shift;
+ my ($x1,$y1,$x2,$y2) = @_;
+ my $cx = ($x1+$x2)/2;
+ my $cy = ($y1+$y2)/2;
+
+ my $linewidth = $self->option('linewidth') || 1;
+ if ($linewidth > 1) {
+ my $pen = $self->make_pen($linewidth);
+ # draw a box
+ $gd->setBrush($pen);
+ $gd->arc($cx,$cy,$x2-$x1,$y2-$y1,0,360,gdBrushed);
+ } else {
+ $gd->arc($cx,$cy,$x2-$x1,$y2-$y1,0,360,$self->fgcolor);
+ }
+
+ # and fill it
+ $gd->fill($cx,$cy,$self->bgcolor);
+}
+sub fill {
+ my $self = shift;
+ my $gd = shift;
+ my ($x1,$y1,$x2,$y2) = @_;
+ if ( ($x2-$x1) >= 2 && ($y2-$y1) >= 2 ) {
+ $gd->fill($x1+1,$y1+1,$self->bgcolor);
+ }
+}
+
+sub draw_component {
+ my $self = shift;
+ my $gd = shift;
+ my ($left,$top) = @_;
+ my($x1,$y1,$x2,$y2) = $self->bounds(@_);
+ $self->filled_box($gd,
+ $x1, $y1,
+ $x2, $y2);
+}
+
+sub subseq {
+ my $class = shift;
+ my $feature = shift;
+ return $feature->merged_segments if $feature->can('merged_segments');
+ return $feature->segments if $feature->can('segments');
+ return $feature->sub_SeqFeature if $feature->can('sub_SeqFeature');
+}
+
+sub default_factory {
+ croak "no default factory implemented";
+}
+
+1;
105 Graphics/Glyph/Factory.pm
@@ -0,0 +1,105 @@
+package Bio::Graphics::Glyph::Factory;
+use strict;
+use Carp qw(:DEFAULT cluck);
+use GD;
+
+my %LOADED_GLYPHS = ();
+my %GENERIC_OPTIONS = (
+ bgcolor => 'cyan',
+ fgcolor => 'black',
+ height => 10,
+ font => gdSmallFont,
+ fontcolor => 'black',
+ bump => +1, # bump by default (perhaps a mistake?)
+ connector => 'none',
+ );
+
+sub new {
+ my $class = shift;
+ my $panel = shift;
+ my %args = @_;
+ my $stylesheet = $args{-stylesheet}; # optional, for Bio::Das compatibility
+ my $map = $args{-map}; # map type name to glyph name
+ my $options = $args{-options}; # map type name to glyph options
+ return bless {
+ stylesheet => $stylesheet,
+ glyph_map => $map,
+ options => $options,
+ panel => $panel,
+ },$class;
+}
+sub stylesheet { shift->{stylesheet} }
+sub glyph_map { shift->{glyph_map} }
+sub option_map { shift->{options} }
+sub global_opts{ shift->{global_opts} }
+sub panel { shift->{panel} }
+sub scale { shift->{panel}->scale }
+sub font {
+ my $self = shift;
+ my $glyph = shift;
+ $self->option($glyph,'font') || $self->{font};
+}
+
+sub map_pt {
+ my $self = shift;
+ my @result = $self->panel->map_pt(@_);
+ return wantarray ? @result : $result[0];
+}
+
+sub translate_color {
+ my $self = shift;
+ my $color_name = shift;
+ $self->panel->translate_color($color_name);
+}
+
+# create a glyph
+sub make_glyph {
+ my $self = shift;
+ my @result;
+
+ for my $f (@_) {
+
+ my $type = $self->feature_to_glyph($f);
+ my $glyphclass = 'Bio::Graphics::Glyph';
+ $type ||= 'generic';
+ $glyphclass .= "\:\:\L$type";
+
+ unless ($LOADED_GLYPHS{$glyphclass}++) {
+ carp("the requested glyph class, ``$type'' is not available: $@")
+ unless (eval "require $glyphclass");
+ }
+ push @result, $glyphclass->new(-feature => $f,
+ -factory => $self);
+ }
+ return wantarray ? @result : $result[0];
+}
+
+sub feature_to_glyph {
+ my $self = shift;
+ my $feature = shift;
+
+ return scalar $self->{stylesheet}->glyph($feature) if $self->{stylesheet};
+ my $map = $self->glyph_map or return 'generic';
+ return $map->($feature) || 'generic' if ref($map) eq 'CODE';
+ return $map->{$feature->type} || 'generic';
+}
+
+sub option {
+ my $self = shift;
+ my ($glyph,$option_name,$partno) = @_;
+ return unless defined $option_name;
+ $option_name = lc $option_name; # canonicalize
+
+ if (my $ss = $self->stylesheet) {
+ my($glyph,%options) = $ss->glyph($glyph->feature);
+ return $options{$option_name};
+ }
+ my $map = $self->option_map or return $GENERIC_OPTIONS{$option_name};
+ my $value = $map->{$option_name} or return $GENERIC_OPTIONS{$option_name};
+
+ my $feature = $glyph->feature;
+ return $value unless ref $value eq 'CODE';
+ return $value->($feature,$option_name,$partno);
+}
+
+1;
209 Graphics/Glyph/arrow.pm
@@ -0,0 +1,209 @@
+package Bio::Graphics::Glyph::arrow;
+# package to use for drawing an arrow
+
+use strict;
+use base 'Bio::Graphics::Glyph::generic';
+
+sub pad_bottom {
+ my $self = shift;
+ my $val = $self->SUPER::pad_bottom(@_);
+ $val += $self->font->height if $self->option('tick');
+ $val;
+}
+
+# override draw method
+sub draw {
+ my $self = shift;
+ my $parallel = $self->option('parallel');
+ $parallel = 1 unless defined $parallel;
+ $self->draw_parallel(@_) if $parallel;
+ $self->draw_perpendicular(@_) unless $parallel;
+}
+
+sub draw_perpendicular {
+ my $self = shift;
+ my $gd = shift;
+ my ($dx,$dy) = @_;
+ my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
+
+ my $ne = $self->option('northeast');
+ my $sw = $self->option('southwest');
+ $ne = $sw = 1 unless defined($ne) || defined($sw);
+
+ # draw a perpendicular arrow at position indicated by $x1
+ my $fg = $self->fgcolor;
+ my $a2 = ($y2-$y1)/4;
+
+ my @positions = $x1 == $x2 ? ($x1) : ($x1,$x2);
+ for my $x (@positions) {
+ if ($ne) {
+ $gd->line($x,$y1,$x,$y2,$fg);
+ $gd->line($x-$a2,$y1+$a2,$x,$y1,$fg);
+ $gd->line($x+$a2,$y1+$a2,$x,$y1,$fg);
+ }
+ if ($sw) {
+ $gd->line($x,$y1,$x,$y2,$fg);
+ $gd->line($x-$a2,$y2-$a2,$x,$y2,$fg);
+ $gd->line($x+$a2,$y2-$a2,$x,$y2,$fg);
+ }
+ }
+
+ # add a label if requested
+ $self->draw_label($gd,$dx,$dy) if $self->option('label'); # this draws the label aligned to the left
+}
+
+sub draw_parallel {
+ my $self = shift;
+ my $gd = shift;
+ my ($dx,$dy) = @_;
+ my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
+
+ my $fg = $self->fgcolor;
+ my $a2 = ($y2-$y1)/2;
+ my $center = $y1+$a2;
+
+ my $ne = $self->option('northeast');
+ my $sw = $self->option('southwest');
+ # turn on both if neither specified
+ $ne = $sw = 1 unless defined($ne) || defined($sw);
+
+ $gd->line($x1,$center,$x2,$center,$fg);
+ if ($sw) { # west arrow
+ $gd->line($x1,$center,$x1+$a2,$center-$a2,$fg);
+ $gd->line($x1,$center,$x1+$a2,$center+$a2,$fg);
+ }
+ if ($ne) { # east arrow
+ $gd->line($x2,$center,$x2-$a2,$center+$a2,$fg);
+ $gd->line($x2,$center,$x2-$a2,$center-$a2,$fg);
+ }
+
+ # turn on ticks
+ if ($self->option('tick')) {
+ my $left = shift;
+
+ my $scale = $self->scale;
+
+ # figure out tick mark scale
+ # we want no more than 1 tick mark every 30 pixels
+ # and enough room for the labels
+ my $font = $self->font;
+ my $width = $font->width;
+ my $font_color = $self->fontcolor;
+
+ my $interval = 1;
+ my $mindist = 30;
+ my $widest = 5 + (length($self->end) * $width);
+ $mindist = $widest if $widest > $mindist;
+
+ while (1) {
+ my $pixels = $interval * $scale;
+ last if $pixels >= $mindist;
+ $interval *= 10;
+ }
+
+ my $first_tick = $interval * int(0.5 + $self->start/$interval);
+
+ for (my $i = $first_tick; $i < $self->end; $i += $interval) {
+ my $tickpos = $left + $self->map_pt($i);
+ $gd->line($tickpos,$center-$a2,$tickpos,$center+$a2,$fg);
+ my $middle = $tickpos - (length($i) * $width)/2;
+ $gd->string($font,$middle,$center+$a2-1,$i,$font_color);
+ }
+
+ if ($self->option('tick') >= 2) {
+ my $a4 = ($y2-$y1)/4;
+ for (my $i = $self->start+$interval/10; $i < $self->end; $i += $interval/10) {
+ my $tickpos = $dx + $self->map_pt($i);
+ $gd->line($tickpos,$center-$a4,$tickpos,$center+$a4,$fg);
+ }
+ }
+ }
+
+ # add a label if requested
+ $self->draw_label($gd,$dx,$dy) if $self->option('label');
+
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Ace::Graphics::Glyph::arrow - The "arrow" glyph
+
+=head1 SYNOPSIS
+
+ See L<Ace::Graphics::Panel> and L<Ace::Graphics::Glyph>.
+
+=head1 DESCRIPTION
+
+This glyph draws arrows. Depending on options, the arrows can be
+labeled, be oriented vertically or horizontally, or can contain major
+and minor ticks suitable for use as a scale.
+
+=head2 OPTIONS
+
+In addition to the common options, the following glyph-specific
+options are recognized:
+
+ Option Description Default
+ ------ ----------- -------
+
+ -tick Whether to draw major 0
+ and minor ticks.
+ 0 = no ticks
+ 1 = major ticks
+ 2 = minor ticks
+
+ -parallel Whether to draw the arrow true
+ parallel to the sequence
+ or perpendicular to it.
+
+ -northeast Whether to draw the true
+ north or east arrowhead
+ (depending on orientation)
+
+ -southwest Whether to draw the true
+ south or west arrowhead
+ (depending on orientation)
+
+Set -parallel to false to display a point-like feature such as a
+polymorphism, or to indicate an important location. If the feature
+start == end, then the glyph will draw a single arrow at the
+designated location:
+
+ ^
+ |
+
+Otherwise, there will be two arrows at the start and end:
+
+ ^ ^
+ | |
+
+=head1 BUGS
+
+Please report them.
+
+=head1 SEE ALSO
+
+L<Ace::Sequence>, L<Ace::Sequence::Feature>, L<Ace::Graphics::Panel>,
+L<Ace::Graphics::Track>, L<Ace::Graphics::Glyph::anchored_arrow>,
+L<Ace::Graphics::Glyph::arrow>,
+L<Ace::Graphics::Glyph::box>,
+L<Ace::Graphics::Glyph::primers>,
+L<Ace::Graphics::Glyph::segments>,
+L<Ace::Graphics::Glyph::toomany>,
+L<Ace::Graphics::Glyph::transcript>,
+
+=head1 AUTHOR
+
+Lincoln Stein <lstein@cshl.org>.
+
+Copyright (c) 2001 Cold Spring Harbor Laboratory
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. See DISCLAIMER.txt for
+disclaimers of warranty.
+
+=cut
98 Graphics/Glyph/generic.pm
@@ -0,0 +1,98 @@
+package Bio::Graphics::Glyph::generic;
+
+use strict;
+use base 'Bio::Graphics::Glyph';
+
+# new options are 'label' -- short label to print over glyph
+# 'long_label' -- long label to print under glyph
+# label and long_label can be flags or coderefs.
+# If a flag, label will be taken from seqname, if it exists or primary_tag().
+# long_label will be taken from source_tag().
+
+sub font {
+ my $self = shift;
+ $self->factory->font($self);
+}
+sub pad_top {
+ my $self = shift;
+ my $pad = $self->SUPER::pad_top;
+ $pad += $self->labelheight if defined $self->label ;
+ $pad;
+}
+sub pad_bottom {
+ my $self = shift;
+ my $pad = $self->SUPER::pad_bottom;
+ $pad += $self->labelheight if defined $self->long_label;
+ $pad;
+}
+
+sub labelheight {
+ my $self = shift;
+ return $self->{labelheight} ||= $self->font->height;
+}
+sub label {
+ my $self = shift;
+ return exists $self->{label} ? $self->{label}
+ : $self->{label} = $self->_label;
+}
+sub long_label {
+ my $self = shift;
+ return exists $self->{long_label} ? $self->{long_label}
+ : $self->{long_label} = $self->_long_label;
+}
+sub _label {
+ my $self = shift;
+
+ # allow caller to specify the label
+ my $label = $self->option('label');
+ return unless defined $label;
+ return $label unless $label eq '1';
+
+ # figure it out ourselves
+ my $f = $self->feature;
+ my $info = eval {$f->info};
+ return $info if $info;
+ return $f->seqname if $f->can('seqname');
+ return $f->primary_tag;
+}
+sub _long_label {
+ my $self = shift;
+
+ # allow caller to specify the long label
+ my $label = $self->option('long_label');
+ return unless defined $label;
+ return $label unless $label eq '1';
+
+ # fetch deeply-imbedded acedb sequence object information
+ # for backward compatibility with wormbase implementation
+ my $f = $self->feature;
+ my $acedb_info = eval {
+ my $t = $f->info;
+ my $id = $f->Brief_identification;
+ my $comment = $t->Locus;
+ $comment .= $comment ? " ($id)" : $id if $id;
+ $comment;
+ };
+ return $acedb_info if $acedb_info;
+ return $f->source_tag;
+}
+
+sub draw {
+ my $self = shift;
+ $self->SUPER::draw(@_);
+ $self->draw_label(@_) if $self->option('label');
+}
+
+sub draw_label {
+ my $self = shift;
+ my ($gd,$left,$top,$partno,$total_parts) = @_;
+ my $label = $self->label or return;
+ $gd->string($self->font,
+ $self->left + $left,
+ $self->top + $top,
+ $label,
+ $self->fontcolor);
+}
+
+
+1;
11 Graphics/Glyph/group.pm
@@ -0,0 +1,11 @@
+package Bio::Graphics::Glyph::group;
+
+use strict;
+use base 'Bio::Graphics::Glyph';
+
+# group sets connector to 'dashed'
+sub connector {
+ return 'dashed';
+}
+
+1;
18 Graphics/Glyph/oval.pm
@@ -0,0 +1,18 @@
+package Bio::Graphics::Glyph::oval;
+
+use strict;
+use base 'Bio::Graphics::Glyph';
+
+# override draw_component to draw an oval rather than a rectangle (weird)
+sub draw_component {
+ my $self = shift;
+ my $gd = shift;
+ my ($left,$top) = @_;
+ my($x1,$y1,$x2,$y2) = $self->bounds(@_);
+ $self->filled_oval($gd,
+ $x1, $y1,
+ $x2, $y2);
+}
+
+
+1;
11 Graphics/Glyph/track.pm
@@ -0,0 +1,11 @@
+package Bio::Graphics::Glyph::track;
+
+use strict;
+use base 'Bio::Graphics::Glyph';
+
+# track sets connector to empty
+sub connector {
+ return 'none';
+}
+
+1;
44 Graphics/Glyph/transcript.pm
@@ -0,0 +1,44 @@
+package Bio::Graphics::Glyph::transcript;
+
+use strict;
+use base 'Bio::Graphics::Glyph::generic';
+use constant ARROW_SIZE => 4;
+
+sub pad_left { shift->feature->strand > 0 ? 0 : ARROW_SIZE }
+sub pad_right { shift->feature->strand < 0 ? 0 : ARROW_SIZE }
+
+sub draw_connectors {
+ my $self = shift;
+ my $gd = shift;
+ my ($left,$top) = @_;
+ $self->SUPER::draw_connectors($gd,$left,$top);
+ my($x1,$y1,$x2,$y2) = $self->bounds(@_);
+ if ($self->feature->strand >= 0) {
+ $self->draw_arrow($gd,$x2,$x2+ARROW_SIZE,$top+($y2-$y1)/2);
+ } else {
+ $self->draw_arrow($gd,$x1,$x1 - ARROW_SIZE,$top+($y2-$y1)/2);
+ }
+}
+
+sub draw_arrow {
+ my $self = shift;
+ my ($gd,$start,$stop,$y) = @_;
+ my $color = $self->connector_color(0);
+ my $a2 = abs($stop-$start)/2;
+ if ($start < $stop) { #rightward arrow
+ $gd->line($start,$y,$stop,$y,$color);
+ $gd->line($stop,$y,$stop-$a2,$y-$a2,$color);
+ $gd->line($stop,$y,$stop-$a2,$y+$a2,$color);
+ } else {
+ $gd->line($stop,$y,$start,$y,$color);
+ $gd->line($stop,$y,$stop+$a2,$y-$a2,$color);
+ $gd->line($stop,$y,$stop+$a2,$y+$a2,$color);
+ }
+}
+
+# override option() for force the "hat" type of connector
+sub connector {
+ return 'hat';
+}
+
+1;
59 Graphics/Glyph/transcript2.pm
@@ -0,0 +1,59 @@
+package Bio::Graphics::Glyph::transcript2;
+
+use strict;
+use base 'Bio::Graphics::Glyph::generic';
+
+sub draw_component {
+ my $self = shift;
+ my $gd = shift;
+ my ($left,$top,$partno,$total_parts) = @_;
+ my @rect = $self->bounds(@_);
+
+ if ($self->feature->strand < 0 && $partno == 0) { # first exon, minus strand transcript
+ $self->filled_arrow($gd,-1,@rect);
+ } elsif ($self->feature->strand >= 0 && $partno == $total_parts-1) { # last exon, plus strand
+ $self->filled_arrow($gd,+1,@rect);
+ } else {
+ $self->SUPER::draw_component($gd,@_);
+ }
+}
+
+sub filled_arrow {
+ my $self = shift;
+ my $gd = shift;
+ my $orientation = shift;
+
+ my ($x1,$y1,$x2,$y2) = @_;
+ my ($width) = $gd->getBounds;
+ my $indent = ($y2-$y1);
+
+ return $self->filled_box($gd,@_)
+ if ($orientation == 0)
+ or ($x1 < 0 && $orientation < 0)
+ or ($x2 > $width && $orientation > 0)
+ or ($x2 - $x1 < $indent);
+
+ my $fg = $self->fgcolor;
+ if ($orientation >= 0) {
+ $gd->line($x1,$y1,$x2-$indent,$y1,$fg);
+ $gd->line($x2-$indent,$y1,$x2,($y2+$y1)/2,$fg);
+ $gd->line($x2,($y2+$y1)/2,$x2-$indent,$y2,$fg);
+ $gd->line($x2-$indent,$y2,$x1,$y2,$fg);
+ $gd->line($x1,$y2,$x1,$y1,$fg);
+ $gd->fill($x1+1,($y1+$y2)/2,$self->bgcolor);
+ } else {
+ $gd->line($x1,($y2+$y1)/2,$x1+$indent,$y1,$fg);
+ $gd->line($x1+$indent,$y1,$x2,$y1,$fg);
+ $gd->line($x2,$y2,$x1+$indent,$y2,$fg);
+ $gd->line($x1+$indent,$y2,$x1,($y1+$y2)/2,$fg);
+ $gd->line($x2,$y1,$x2,$y2,$fg);
+ $gd->fill($x2-1,($y1+$y2)/2,$self->bgcolor);
+ }
+}
+
+# override option() for force the "hat" type of connector
+sub connector {
+ return 'hat';
+}
+
+1;
443 Graphics/Panel.pm
@@ -0,0 +1,443 @@
+package Bio::Graphics::Panel;
+use Bio::Graphics::Glyph::Factory;
+use GD;
+
+use strict;
+use Carp 'cluck';
+our $VERSION = '0.50';
+
+use constant KEYLABELFONT => gdSmallFont;
+use constant KEYSPACING => 10; # extra space between key columns
+use constant KEYPADTOP => 5; # extra padding before the key starts
+use constant KEYCOLOR => 'cornsilk';
+
+my %COLORS; # translation table for symbolic color names to RGB triple
+
+# Create a new panel of a given width and height, and add lists of features
+# one by one
+sub new {
+ my $class = shift;
+ my %options = @_;
+
+ $class->read_colors() unless %COLORS;
+
+ my $length = $options{-length} || 0;
+ my $offset = $options{-offset} || 0;
+ my $spacing = $options{-spacing} || 5;
+ my $keycolor = $options{-keycolor} || KEYCOLOR;
+ my $keyspacing = $options{-keyspacing} || KEYSPACING;
+
+ $length ||= $options{-segment}->length if $options{-segment};
+ $offset ||= $options{-segment}->start-1 if $options{-segment};
+
+ return bless {
+ tracks => [],
+ width => $options{-width} || 600,
+ pad_top => $options{-pad_top}||0,
+ pad_bottom => $options{-pad_bottom}||0,
+ pad_left => $options{-pad_left}||0,
+ pad_right => $options{-pad_right}||0,
+ length => $length,
+ offset => $offset,
+ height => 0, # AUTO
+ spacing => $spacing,
+ keycolor => $keycolor,
+ keyspacing => $keyspacing,
+ },$class;
+}
+
+sub pad_left {
+ my $self = shift;
+ my $g = $self->{pad_left};
+ $self->{pad_left} = shift if @_;
+ $g;
+}
+sub pad_right {
+ my $self = shift;
+ my $g = $self->{pad_right};
+ $self->{pad_right} = shift if @_;
+ $g;
+}
+sub pad_top {
+ my $self = shift;
+ my $g = $self->{pad_top};
+ $self->{pad_top} = shift if @_;
+ $g;
+}
+sub pad_bottom {
+ my $self = shift;
+ my $g = $self->{pad_bottom};
+ $self->{pad_bottom} = shift if @_;
+ $g;
+}
+sub map_pt {
+ my $self = shift;
+ my $offset = $self->{offset};
+ my $scale = $self->scale;
+ my @result;
+ foreach (@_) {
+ push @result,($_-$offset) * $scale;
+ }
+ @result;
+}
+sub scale {
+ my $self = shift;
+ $self->{scale} ||= $self->width/$self->length;
+}
+
+sub width {
+ my $self = shift;
+ my $d = $self->{width};
+ $self->{width} = shift if @_;
+ $d + $self->pad_left + $self->pad_right;
+}
+
+sub spacing {
+ my $self = shift;
+ my $d = $self->{spacing};
+ $self->{spacing} = shift if @_;
+ $d;
+}
+
+sub length {
+ my $self = shift;
+ my $d = $self->{length};
+ if (@_) {
+ my $l = shift;
+ $l = $l->length if ref($l) && $l->can('length');
+ $self->{length} = $l;
+ }
+ $d;
+}
+
+# create a feature and factory pair
+# see Factory.pm for the format of the options
+# The thing returned is actually a generic Glyph
+sub add_track {
+ my $self = shift;
+
+ # due to indecision, we accept features
+ # and/or glyph types in the first two arguments
+ my ($features,$glyph_name) = ([],'generic');
+ while ( @_ && $_[0] !~ /^-/) {
+ my $arg = shift;
+ $features = $arg and next if ref($arg);
+ $glyph_name = $arg and next unless ref($arg);
+ }
+
+ my %args = @_;
+ my ($map,$ss,%options);
+
+ foreach (keys %args) {
+ (my $canonical = lc $_) =~ s/^-//;
+ if ($canonical eq 'map') {
+ $map = $args{$_};
+ delete $args{$_};
+ } elsif ($canonical eq 'stylesheet') {
+ $ss = $args{$_};
+ delete $args{$_};
+ } else {
+ $options{$canonical} = $args{$_};
+ }
+ }
+
+ my $panel_map = $map
+ ? sub {
+ my $feature = shift;
+ return 'track' if $feature->type eq 'track';
+ return 'group' if $feature->type eq 'group';
+ return $map->($feature);
+ }
+ :
+ sub {
+ my $feature = shift;
+ return 'track' if $feature->type eq 'track';
+ return 'group' if $feature->type eq 'group';
+ return $glyph_name;
+ };
+
+ $self->_add_track($features,+1,-map=>$panel_map,-stylesheet=>$ss,-options=>\%options);
+}
+
+sub _add_track {
+ my $self = shift;
+ my ($features,$direction,@options) = @_;
+
+ # build the list of features into a Bio::Graphics::Feature object
+ $features = [$features] unless ref $features eq 'ARRAY';
+
+ # optional middle-level glyph is the group
+ foreach my $f (@$features) {
+ next unless ref $f eq 'ARRAY';
+ $f = Bio::Graphics::Feature->new(
+ -segments=>$f,
+ -type => 'group'
+ );
+ }
+
+ # top-level glyph is the track
+ my $feature = Bio::Graphics::Feature->new(
+ -segments=>$features,
+ -type => 'track'
+ );
+
+ my $factory = Bio::Graphics::Glyph::Factory->new($self,@options);
+ my $track = $factory->make_glyph($feature);
+
+ if ($direction >= 0) {
+ push @{$self->{tracks}},$track;
+ } else {
+ unshift @{$self->{tracks}},$track;
+ }
+ return $track;
+}
+
+sub height {
+ my $self = shift;
+ my $spacing = $self->spacing;
+ my $height = 0;
+ $height += $_->layout_height + $spacing foreach @{$self->{tracks}};
+ $height + $self->pad_top + $self->pad_bottom;
+}
+
+sub gd {
+ my $self = shift;
+
+ return $self->{gd} if $self->{gd};
+
+ my $width = $self->width;
+ my $height = $self->height;
+ my $gd = GD::Image->new($width,$height);
+ my %translation_table;
+ for my $name ('white','black',keys %COLORS) {
+ my $idx = $gd->colorAllocate(@{$COLORS{$name}});
+ $translation_table{$name} = $idx;
+ }
+
+ $self->{translations} = \%translation_table;
+ $self->{gd} = $gd;
+ my $offset = 0;
+ my $pl = $self->pad_left;
+ my $pt = $self->pad_top;
+
+ for my $track (@{$self->{tracks}}) {
+ $track->draw($gd,$pl,$offset+$pt,0,1);
+ $offset += $track->layout_height + $self->spacing;
+ }
+
+ return $self->{gd} = $gd;
+}
+
+sub boxes {
+ my $self = shift;
+ my @boxes;
+ my $offset = 0;
+ my $pl = $self->pad_left;
+ my $pt = $self->pad_top;
+ for my $track (@{$self->{tracks}}) {
+ my $boxes = $track->boxes($pl,$offset+$pt);
+ push @boxes,@$boxes;
+ $offset += $track->layout_height + $self->spacing;
+ }
+ return wantarray ? @boxes : \@boxes;
+}
+
+# reverse of translate(); given index, return rgb tripler
+sub rgb {
+ my $self = shift;
+ my $idx = shift;
+ my $gd = $self->{gd} or return;
+ return $gd->rgb($idx);
+}
+
+sub translate_color {
+ my $self = shift;
+ my $color = shift;
+ if ($color =~ /^\#([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})$/i) {
+ my $gd = $self->gd or return 1;
+ my ($r,$g,$b) = (hex($1),hex($2),hex($3));
+ return $gd->colorClosest($r,$g,$b);
+ } else {
+ my $table = $self->{translations} or return 1;
+ return defined $table->{$color} ? $table->{$color} : 1;
+ }
+}
+
+sub set_pen {
+ my $self = shift;
+ my ($linewidth,$color) = @_;
+ return $self->{pens}{$linewidth} if $self->{pens}{$linewidth};
+
+ my $pen = $self->{pens}{$linewidth} = GD::Image->new($linewidth,$linewidth);
+ my @rgb = $self->rgb($color);
+ my $bg = $pen->colorAllocate(255,255,255);
+ my $fg = $pen->colorAllocate(@rgb);
+ $pen->fill(0,0,$fg);
+ $self->{gd}->setBrush($pen);
+}
+
+sub png {
+ my $gd = shift->gd;
+ $gd->png;
+}
+
+sub read_colors {
+ my $class = shift;
+ while (<DATA>) {
+ chomp;
+ last if /^__END__/;
+ my ($name,$r,$g,$b) = split /\s+/;
+ $COLORS{$name} = [hex $r,hex $g,hex $b];
+ }
+}
+
+sub color_names {
+ my $class = shift;
+ $class->read_colors unless %COLORS;
+ return wantarray ? keys %COLORS : [keys %COLORS];
+}
+
+1;
+
+__DATA__
+white FF FF FF
+black 00 00 00
+aliceblue F0 F8 FF
+antiquewhite FA EB D7
+aqua 00 FF FF
+aquamarine 7F FF D4
+azure F0 FF FF
+beige F5 F5 DC
+bisque FF E4 C4
+blanchedalmond FF EB CD
+blue 00 00 FF
+blueviolet 8A 2B E2
+brown A5 2A 2A
+burlywood DE B8 87
+cadetblue 5F 9E A0
+chartreuse 7F FF 00
+chocolate D2 69 1E
+coral FF 7F 50
+cornflowerblue 64 95 ED
+cornsilk FF F8 DC
+crimson DC 14 3C
+cyan 00 FF FF
+darkblue 00 00 8B
+darkcyan 00 8B 8B
+darkgoldenrod B8 86 0B
+darkgray A9 A9 A9
+darkgreen 00 64 00
+darkkhaki BD B7 6B
+darkmagenta 8B 00 8B
+darkolivegreen 55 6B 2F
+darkorange FF 8C 00
+darkorchid 99 32 CC
+darkred 8B 00 00
+darksalmon E9 96 7A
+darkseagreen 8F BC 8F
+darkslateblue 48 3D 8B
+darkslategray 2F 4F 4F
+darkturquoise 00 CE D1
+darkviolet 94 00 D3
+deeppink FF 14 100
+deepskyblue 00 BF FF
+dimgray 69 69 69
+dodgerblue 1E 90 FF
+firebrick B2 22 22
+floralwhite FF FA F0
+forestgreen 22 8B 22
+fuchsia FF 00 FF
+gainsboro DC DC DC
+ghostwhite F8 F8 FF
+gold FF D7 00
+goldenrod DA A5 20
+gray 80 80 80
+green 00 80 00
+greenyellow AD FF 2F
+honeydew F0 FF F0
+hotpink FF 69 B4
+indianred CD 5C 5C
+indigo 4B 00 82
+ivory FF FF F0
+khaki F0 E6 8C
+lavender E6 E6 FA
+lavenderblush FF F0 F5
+lawngreen 7C FC 00
+lemonchiffon FF FA CD
+lightblue AD D8 E6
+lightcoral F0 80 80
+lightcyan E0 FF FF
+lightgoldenrodyellow FA FA D2
+lightgreen 90 EE 90
+lightgrey D3 D3 D3
+lightpink FF B6 C1
+lightsalmon FF A0 7A
+lightseagreen 20 B2 AA
+lightskyblue 87 CE FA
+lightslategray 77 88 99
+lightsteelblue B0 C4 DE
+lightyellow FF FF E0
+lime 00 FF 00
+limegreen 32 CD 32
+linen FA F0 E6
+magenta FF 00 FF
+maroon 80 00 00
+mediumaquamarine 66 CD AA
+mediumblue 00 00 CD
+mediumorchid BA 55 D3
+mediumpurple 100 70 DB
+mediumseagreen 3C B3 71
+mediumslateblue 7B 68 EE
+mediumspringgreen 00 FA 9A
+mediumturquoise 48 D1 CC
+mediumvioletred C7 15 85
+midnightblue 19 19 70
+mintcream F5 FF FA
+mistyrose FF E4 E1
+moccasin FF E4 B5
+navajowhite FF DE AD
+navy 00 00 80
+oldlace FD F5 E6
+olive 80 80 00
+olivedrab 6B 8E 23
+orange FF A5 00
+orangered FF 45 00
+orchid DA 70 D6
+palegoldenrod EE E8 AA
+palegreen 98 FB 98
+paleturquoise AF EE EE
+palevioletred DB 70 100
+papayawhip FF EF D5
+peachpuff FF DA B9
+peru CD 85 3F
+pink FF C0 CB
+plum DD A0 DD
+powderblue B0 E0 E6
+purple 80 00 80
+red FF 00 00
+rosybrown BC 8F 8F
+royalblue 41 69 E1
+saddlebrown 8B 45 13
+salmon FA 80 72
+sandybrown F4 A4 60
+seagreen 2E 8B 57
+seashell FF F5 EE
+sienna A0 52 2D
+silver C0 C0 C0
+skyblue 87 CE EB
+slateblue 6A 5A CD
+slategray 70 80 90
+snow FF FA FA
+springgreen 00 FF 7F
+steelblue 46 82 B4
+tan D2 B4 8C
+teal 00 80 80
+thistle D8 BF D8
+tomato FF 63 47
+turquoise 40 E0 D0
+violet EE 82 EE
+wheat F5 DE B3
+whitesmoke F5 F5 F5
+yellow FF FF 00
+yellowgreen 9A CD 32
+__END__
17 MANIFEST
@@ -0,0 +1,17 @@
+Changes
+Graphics/Feature.pm
+Graphics/Glyph.pm
+Graphics/Glyph/Factory.pm
+Graphics/Glyph/arrow.pm
+Graphics/Glyph/generic.pm
+Graphics/Glyph/group.pm
+Graphics/Glyph/oval.pm
+Graphics/Glyph/track.pm
+Graphics/Glyph/transcript.pm
+Graphics/Glyph/transcript2.pm
+Graphics/Panel.pm
+MANIFEST
+README
+Makefile.PL
+eg/testit.pl
+test.pl
708 Makefile
@@ -0,0 +1,708 @@
+# This Makefile is for the Bio::Graphics extension to perl.
+#
+# It was generated automatically by MakeMaker version
+# 5.45 (Revision: 1.222) from the contents of
+# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
+#
+# ANY CHANGES MADE HERE WILL BE LOST!
+#
+# MakeMaker ARGV: ()
+#
+# MakeMaker Parameters:
+
+# DEFINE => q[]
+# INC => q[]
+# LIBS => [q[]]
+# NAME => q[Bio::Graphics]
+# PREREQ_PM => { GD=>q[1.2] }
+# VERSION_FROM => q[Graphics/Panel.pm]
+
+# --- MakeMaker post_initialize section:
+
+
+# --- MakeMaker const_config section:
+
+# These definitions are from config.sh (via /usr/local/lib/perl5/5.6.0/i586-linux/Config.pm)
+
+# They may have been overridden via Makefile.PL or on the command line
+AR = ar
+CC = cc
+CCCDLFLAGS = -fpic
+CCDLFLAGS = -rdynamic
+DLEXT = so
+DLSRC = dl_dlopen.xs
+LD = cc
+LDDLFLAGS = -shared -L/usr/local/lib
+LDFLAGS = -L/usr/local/lib
+LIBC = /lib/libc-2.1.so
+LIB_EXT = .a
+OBJ_EXT = .o
+OSNAME = linux
+OSVERS = 2.4.0
+RANLIB = :
+SO = so
+EXE_EXT =
+FULL_AR = /usr/local/bin/ar
+
+
+# --- MakeMaker constants section:
+AR_STATIC_ARGS = cr
+NAME = Bio::Graphics
+DISTNAME = Bio-Graphics
+NAME_SYM = Bio_Graphics
+VERSION = 0.50
+VERSION_SYM = 0_50
+XS_VERSION = 0.50
+INST_BIN = blib/bin
+INST_EXE = blib/script
+INST_LIB = blib/lib
+INST_ARCHLIB = blib/arch
+INST_SCRIPT = blib/script
+PREFIX = /usr/local
+INSTALLDIRS = site
+INSTALLPRIVLIB = $(PREFIX)/lib/perl5/5.6.0
+INSTALLARCHLIB = $(PREFIX)/lib/perl5/5.6.0/i586-linux
+INSTALLSITELIB = $(PREFIX)/lib/perl5/site_perl/5.6.0
+INSTALLSITEARCH = $(PREFIX)/lib/perl5/site_perl/5.6.0/i586-linux
+INSTALLBIN = $(PREFIX)/bin
+INSTALLSCRIPT = $(PREFIX)/bin
+PERL_LIB = /usr/local/lib/perl5/5.6.0
+PERL_ARCHLIB = /usr/local/lib/perl5/5.6.0/i586-linux
+SITELIBEXP = /usr/local/lib/perl5/site_perl/5.6.0
+SITEARCHEXP = /usr/local/lib/perl5/site_perl/5.6.0/i586-linux
+LIBPERL_A = libperl.a
+FIRST_MAKEFILE = Makefile
+MAKE_APERL_FILE = Makefile.aperl
+PERLMAINCC = $(CC)
+PERL_INC = /usr/local/lib/perl5/5.6.0/i586-linux/CORE
+PERL = /usr/local/bin/perl
+FULLPERL = /usr/local/bin/perl
+FULL_AR = /usr/local/bin/ar
+
+VERSION_MACRO = VERSION
+DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
+PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
+
+MAKEMAKER = /usr/local/lib/perl5/5.6.0/ExtUtils/MakeMaker.pm
+MM_VERSION = 5.45
+
+# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
+# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!!
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE = Basename part of dynamic library. May be just equal BASEEXT.
+FULLEXT = Bio/Graphics
+BASEEXT = Graphics
+PARENT_NAME = Bio
+DLBASE = $(BASEEXT)
+VERSION_FROM = Graphics/Panel.pm
+INC =
+DEFINE =
+OBJECT =
+LDFROM = $(OBJECT)
+LINKTYPE = dynamic
+
+# Handy lists of source code files:
+XS_FILES=
+C_FILES =
+O_FILES =
+H_FILES =
+HTMLLIBPODS =
+HTMLSCRIPTPODS =
+MAN1PODS =
+MAN3PODS = Graphics/Feature.pm \
+ Graphics/Glyph/arrow.pm
+HTMLEXT = html
+INST_MAN1DIR = blib/man1
+INSTALLMAN1DIR = /usr/local/man/man1
+MAN1EXT = 1
+INST_MAN3DIR = blib/man3
+INSTALLMAN3DIR = /usr/local/man/man3
+MAN3EXT = 3
+PERM_RW = 644
+PERM_RWX = 755
+
+# work around a famous dec-osf make(1) feature(?):
+makemakerdflt: all
+
+.SUFFIXES: .xs .c .C .cpp .cxx .cc $(OBJ_EXT)
+
+# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that
+# some make implementations will delete the Makefile when we rebuild it. Because
+# we call false(1) when we rebuild it. So make(1) is not completely wrong when it
+# does so. Our milage may vary.
+# .PRECIOUS: Makefile # seems to be not necessary anymore
+
+.PHONY: all config static dynamic test linkext manifest
+
+# Where is the Config information that we are using/depend on
+CONFIGDEP = $(PERL_ARCHLIB)/Config.pm $(PERL_INC)/config.h
+
+# Where to put things:
+INST_LIBDIR = $(INST_LIB)/Bio
+INST_ARCHLIBDIR = $(INST_ARCHLIB)/Bio
+
+INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
+INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
+
+INST_STATIC =
+INST_DYNAMIC =
+INST_BOOT =
+
+EXPORT_LIST =
+
+PERL_ARCHIVE =
+
+TO_INST_PM = Graphics/Feature.pm \
+ Graphics/Glyph.pm \
+ Graphics/Glyph/Factory.pm \
+ Graphics/Glyph/arrow.pm \
+ Graphics/Glyph/generic.pm \
+ Graphics/Glyph/group.pm \
+ Graphics/Glyph/oval.pm \
+ Graphics/Glyph/track.pm \
+ Graphics/Glyph/transcript.pm \
+ Graphics/Glyph/transcript2.pm \
+ Graphics/Panel.pm
+
+PM_TO_BLIB = Graphics/Glyph/generic.pm \
+ $(INST_LIBDIR)/Graphics/Glyph/generic.pm \
+ Graphics/Glyph/arrow.pm \
+ $(INST_LIBDIR)/Graphics/Glyph/arrow.pm \
+ Graphics/Glyph/group.pm \
+ $(INST_LIBDIR)/Graphics/Glyph/group.pm \
+ Graphics/Glyph/transcript.pm \
+ $(INST_LIBDIR)/Graphics/Glyph/transcript.pm \
+ Graphics/Feature.pm \
+ $(INST_LIBDIR)/Graphics/Feature.pm \
+ Graphics/Glyph/oval.pm \
+ $(INST_LIBDIR)/Graphics/Glyph/oval.pm \
+ Graphics/Glyph/Factory.pm \
+ $(INST_LIBDIR)/Graphics/Glyph/Factory.pm \
+ Graphics/Glyph/track.pm \
+ $(INST_LIBDIR)/Graphics/Glyph/track.pm \
+ Graphics/Glyph.pm \
+ $(INST_LIBDIR)/Graphics/Glyph.pm \
+ Graphics/Panel.pm \
+ $(INST_LIBDIR)/Graphics/Panel.pm \
+ Graphics/Glyph/transcript2.pm \
+ $(INST_LIBDIR)/Graphics/Glyph/transcript2.pm
+
+
+# --- MakeMaker tool_autosplit section:
+
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;'
+
+
+# --- MakeMaker tool_xsubpp section:
+
+
+# --- MakeMaker tools_other section:
+
+SHELL = /bin/sh
+CHMOD = chmod
+CP = cp
+LD = cc
+MV = mv
+NOOP = $(SHELL) -c true
+RM_F = rm -f
+RM_RF = rm -rf
+TEST_F = test -f
+TOUCH = touch
+UMASK_NULL = umask 0
+DEV_NULL = > /dev/null 2>&1
+
+# The following is a portable way to say mkdir -p
+# To see which directories are created, change the if 0 to if 1
+MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
+
+# This helps us to minimize the effect of the .exists files A yet
+# better solution would be to have a stable file in the perl
+# distribution with a timestamp of zero. But this solution doesn't
+# need any changes to the core distribution and works with older perls
+EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
+
+# Here we warn users that an old packlist file was found somewhere,
+# and that they should call some uninstall routine
+WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \
+-e 'print "WARNING: I have found an old package in\n";' \
+-e 'print "\t$$ARGV[0].\n";' \
+-e 'print "Please make sure the two installations are not conflicting\n";'
+
+UNINST=0
+VERBINST=1
+
+MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
+-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');"
+
+DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \
+-e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", shift, ">";' \
+-e 'print "=over 4";' \
+-e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \
+-e 'print "=back";'
+
+UNINSTALL = $(PERL) -MExtUtils::Install \
+-e 'uninstall($$ARGV[0],1,1); print "\nUninstall is deprecated. Please check the";' \
+-e 'print " packlist above carefully.\n There may be errors. Remove the";' \
+-e 'print " appropriate files manually.\n Sorry for the inconveniences.\n"'
+
+
+# --- MakeMaker dist section:
+
+DISTVNAME = $(DISTNAME)-$(VERSION)
+TAR = tar
+TARFLAGS = cvf
+ZIP = zip
+ZIPFLAGS = -r
+COMPRESS = gzip --best
+SUFFIX = .gz
+SHAR = shar
+PREOP = @$(NOOP)
+POSTOP = @$(NOOP)
+TO_UNIX = @$(NOOP)
+CI = ci -u
+RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
+DIST_CP = best
+DIST_DEFAULT = tardist
+
+
+# --- MakeMaker macro section:
+
+
+# --- MakeMaker depend section:
+
+
+# --- MakeMaker cflags section:
+
+
+# --- MakeMaker const_loadlibs section:
+
+
+# --- MakeMaker const_cccmd section:
+
+
+# --- MakeMaker post_constants section:
+
+
+# --- MakeMaker pasthru section:
+
+PASTHRU = LIB="$(LIB)"\
+ LIBPERL_A="$(LIBPERL_A)"\
+ LINKTYPE="$(LINKTYPE)"\
+ PREFIX="$(PREFIX)"\
+ OPTIMIZE="$(OPTIMIZE)"
+
+
+# --- MakeMaker c_o section:
+
+
+# --- MakeMaker xs_c section:
+
+
+# --- MakeMaker xs_o section:
+
+
+# --- MakeMaker top_targets section:
+
+#all :: config $(INST_PM) subdirs linkext manifypods
+
+all :: pure_all htmlifypods manifypods
+ @$(NOOP)
+
+pure_all :: config pm_to_blib subdirs linkext
+ @$(NOOP)
+
+subdirs :: $(MYEXTLIB)
+ @$(NOOP)
+
+config :: Makefile $(INST_LIBDIR)/.exists
+ @$(NOOP)
+
+config :: $(INST_ARCHAUTODIR)/.exists
+ @$(NOOP)
+
+config :: $(INST_AUTODIR)/.exists
+ @$(NOOP)
+
+$(INST_AUTODIR)/.exists :: /usr/local/lib/perl5/5.6.0/i586-linux/CORE/perl.h
+ @$(MKPATH) $(INST_AUTODIR)
+ @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.0/i586-linux/CORE/perl.h $(INST_AUTODIR)/.exists
+
+ -@$(CHMOD) $(PERM_RWX) $(INST_AUTODIR)
+
+$(INST_LIBDIR)/.exists :: /usr/local/lib/perl5/5.6.0/i586-linux/CORE/perl.h
+ @$(MKPATH) $(INST_LIBDIR)
+ @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.0/i586-linux/CORE/perl.h $(INST_LIBDIR)/.exists
+
+ -@$(CHMOD) $(PERM_RWX) $(INST_LIBDIR)
+
+$(INST_ARCHAUTODIR)/.exists :: /usr/local/lib/perl5/5.6.0/i586-linux/CORE/perl.h
+ @$(MKPATH) $(INST_ARCHAUTODIR)
+ @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.0/i586-linux/CORE/perl.h $(INST_ARCHAUTODIR)/.exists
+
+ -@$(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR)
+
+config :: $(INST_MAN3DIR)/.exists
+ @$(NOOP)
+
+
+$(INST_MAN3DIR)/.exists :: /usr/local/lib/perl5/5.6.0/i586-linux/CORE/perl.h
+ @$(MKPATH) $(INST_MAN3DIR)
+ @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.0/i586-linux/CORE/perl.h $(INST_MAN3DIR)/.exists
+
+ -@$(CHMOD) $(PERM_RWX) $(INST_MAN3DIR)
+
+help:
+ perldoc ExtUtils::MakeMaker
+
+Version_check:
+ @$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+ -MExtUtils::MakeMaker=Version_check \
+ -e "Version_check('$(MM_VERSION)')"
+
+
+# --- MakeMaker linkext section:
+
+linkext :: $(LINKTYPE)
+ @$(NOOP)
+
+
+# --- MakeMaker dlsyms section:
+
+
+# --- MakeMaker dynamic section:
+
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make dynamic"
+#dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM)
+dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT)
+ @$(NOOP)
+
+
+# --- MakeMaker dynamic_bs section:
+
+BOOTSTRAP =
+
+
+# --- MakeMaker dynamic_lib section:
+
+
+# --- MakeMaker static section:
+
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make static"
+#static :: Makefile $(INST_STATIC) $(INST_PM)
+static :: Makefile $(INST_STATIC)
+ @$(NOOP)
+
+
+# --- MakeMaker static_lib section:
+
+
+# --- MakeMaker htmlifypods section:
+
+htmlifypods : pure_all
+ @$(NOOP)
+
+
+# --- MakeMaker manifypods section:
+POD2MAN_EXE = /usr/local/bin/pod2man
+POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \
+-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "Makefile";' \
+-e 'print "Manifying $$m{$$_}\n";' \
+-e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\047t install $$m{$$_}\n";' \
+-e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}'
+
+manifypods : pure_all Graphics/Feature.pm \
+ Graphics/Glyph/arrow.pm
+ @$(POD2MAN) \
+ Graphics/Feature.pm \
+ $(INST_MAN3DIR)/Bio::Graphics::Feature.$(MAN3EXT) \
+ Graphics/Glyph/arrow.pm \
+ $(INST_MAN3DIR)/Bio::Graphics::Glyph::arrow.$(MAN3EXT)
+
+# --- MakeMaker processPL section:
+
+
+# --- MakeMaker installbin section:
+
+
+# --- MakeMaker subdirs section:
+
+# none
+
+# --- MakeMaker clean section:
+
+# Delete temporary files but do not touch installed files. We don't delete
+# the Makefile here so a later make realclean still has a makefile to use.
+
+clean ::
+ -rm -rf ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core core.*perl.*.? *perl.core so_locations pm_to_blib *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp
+ -mv Makefile Makefile.old $(DEV_NULL)
+
+
+# --- MakeMaker realclean section:
+
+# Delete temporary files (via clean) and also delete installed files
+realclean purge :: clean
+ rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR)
+ rm -f $(INST_LIBDIR)/Graphics/Glyph/generic.pm $(INST_LIBDIR)/Graphics/Glyph/arrow.pm $(INST_LIBDIR)/Graphics/Glyph/group.pm $(INST_LIBDIR)/Graphics/Glyph/transcript.pm $(INST_LIBDIR)/Graphics/Feature.pm $(INST_LIBDIR)/Graphics/Glyph/oval.pm $(INST_LIBDIR)/Graphics/Glyph/Factory.pm $(INST_LIBDIR)/Graphics/Glyph/track.pm $(INST_LIBDIR)/Graphics/Glyph.pm $(INST_LIBDIR)/Graphics/Panel.pm $(INST_LIBDIR)/Graphics/Glyph/transcript2.pm
+ rm -rf Makefile Makefile.old
+
+
+# --- MakeMaker dist_basics section:
+
+distclean :: realclean distcheck
+
+distcheck :
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \
+ -e fullcheck
+
+skipcheck :
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \
+ -e skipcheck
+
+manifest :
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \
+ -e mkmanifest
+
+
+# --- MakeMaker dist_core section:
+
+dist : $(DIST_DEFAULT)
+ @$(PERL) -le 'print "Warning: Makefile possibly out of date with $$vf" if ' \
+ -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "Makefile";'
+
+tardist : $(DISTVNAME).tar$(SUFFIX)
+
+zipdist : $(DISTVNAME).zip
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+ $(PREOP)
+ $(TO_UNIX)
+ $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
+ $(RM_RF) $(DISTVNAME)
+ $(COMPRESS) $(DISTVNAME).tar
+ $(POSTOP)
+
+$(DISTVNAME).zip : distdir
+ $(PREOP)
+ $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
+ $(RM_RF) $(DISTVNAME)
+ $(POSTOP)
+
+uutardist : $(DISTVNAME).tar$(SUFFIX)
+ uuencode $(DISTVNAME).tar$(SUFFIX) \
+ $(DISTVNAME).tar$(SUFFIX) > \
+ $(DISTVNAME).tar$(SUFFIX)_uu
+
+shdist : distdir
+ $(PREOP)
+ $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
+ $(RM_RF) $(DISTVNAME)
+ $(POSTOP)
+
+
+# --- MakeMaker dist_dir section:
+
+distdir :
+ $(RM_RF) $(DISTVNAME)
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \
+ -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
+
+
+# --- MakeMaker dist_test section:
+
+disttest : distdir
+ cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL
+ cd $(DISTVNAME) && $(MAKE)
+ cd $(DISTVNAME) && $(MAKE) test
+
+
+# --- MakeMaker dist_ci section:
+
+ci :
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \
+ -e "@all = keys %{ maniread() };" \
+ -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \
+ -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
+
+
+# --- MakeMaker install section:
+
+install :: all pure_install doc_install
+
+install_perl :: all pure_perl_install doc_perl_install
+
+install_site :: all pure_site_install doc_site_install
+
+install_ :: install_site
+ @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_install :: pure_$(INSTALLDIRS)_install
+
+doc_install :: doc_$(INSTALLDIRS)_install
+ @echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
+
+pure__install : pure_site_install
+ @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+doc__install : doc_site_install
+ @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_perl_install ::
+ @$(MOD_INSTALL) \
+ read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \
+ write $(INSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \
+ $(INST_LIB) $(INSTALLPRIVLIB) \
+ $(INST_ARCHLIB) $(INSTALLARCHLIB) \
+ $(INST_BIN) $(INSTALLBIN) \
+ $(INST_SCRIPT) $(INSTALLSCRIPT) \
+ $(INST_HTMLLIBDIR) $(INSTALLHTMLPRIVLIBDIR) \
+ $(INST_HTMLSCRIPTDIR) $(INSTALLHTMLSCRIPTDIR) \
+ $(INST_MAN1DIR) $(INSTALLMAN1DIR) \
+ $(INST_MAN3DIR) $(INSTALLMAN3DIR)
+ @$(WARN_IF_OLD_PACKLIST) \
+ $(SITEARCHEXP)/auto/$(FULLEXT)
+
+
+pure_site_install ::
+ @$(MOD_INSTALL) \
+ read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
+ write $(INSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
+ $(INST_LIB) $(INSTALLSITELIB) \
+ $(INST_ARCHLIB) $(INSTALLSITEARCH) \
+ $(INST_BIN) $(INSTALLBIN) \
+ $(INST_SCRIPT) $(INSTALLSCRIPT) \
+ $(INST_HTMLLIBDIR) $(INSTALLHTMLSITELIBDIR) \
+ $(INST_HTMLSCRIPTDIR) $(INSTALLHTMLSCRIPTDIR) \
+ $(INST_MAN1DIR) $(INSTALLMAN1DIR) \
+ $(INST_MAN3DIR) $(INSTALLMAN3DIR)
+ @$(WARN_IF_OLD_PACKLIST) \
+ $(PERL_ARCHLIB)/auto/$(FULLEXT)
+
+doc_perl_install ::
+ -@$(MKPATH) $(INSTALLARCHLIB)
+ -@$(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLPRIVLIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(INSTALLARCHLIB)/perllocal.pod
+
+doc_site_install ::
+ -@$(MKPATH) $(INSTALLARCHLIB)
+ -@$(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLSITELIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(INSTALLARCHLIB)/perllocal.pod
+
+
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+
+uninstall_from_perldirs ::
+ @$(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist
+
+uninstall_from_sitedirs ::
+ @$(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
+
+
+# --- MakeMaker force section:
+# Phony target to force checking subdirectories.
+FORCE:
+ @$(NOOP)
+
+
+# --- MakeMaker perldepend section:
+
+
+# --- MakeMaker makefile section:
+
+# We take a very conservative approach here, but it\'s worth it.
+# We move Makefile to Makefile.old here to avoid gnu make looping.
+Makefile : Makefile.PL $(CONFIGDEP)
+ @echo "Makefile out-of-date with respect to $?"
+ @echo "Cleaning current config before rebuilding Makefile..."
+ -@$(RM_F) Makefile.old
+ -@$(MV) Makefile Makefile.old
+ -$(MAKE) -f Makefile.old clean $(DEV_NULL) || $(NOOP)
+ $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
+ @echo "==> Your Makefile has been rebuilt. <=="
+ @echo "==> Please rerun the make command. <=="
+ false
+
+# To change behavior to :: would be nice, but would break Tk b9.02
+# so you find such a warning below the dist target.
+#Makefile :: $(VERSION_FROM)
+# @echo "Warning: Makefile possibly out of date with $(VERSION_FROM)"
+
+
+# --- MakeMaker staticmake section:
+
+# --- MakeMaker makeaperl section ---
+MAP_TARGET = perl
+FULLPERL = /usr/local/bin/perl
+
+$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
+ $(MAKE) -f $(MAKE_APERL_FILE) $@
+
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
+ @echo Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
+ @$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+ Makefile.PL DIR= \
+ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+ MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
+
+
+# --- MakeMaker test section:
+
+TEST_VERBOSE=0
+TEST_TYPE=test_$(LINKTYPE)
+TEST_FILE = test.pl
+TEST_FILES =
+TESTDB_SW = -d
+
+testdb :: testdb_$(LINKTYPE)
+
+test :: $(TEST_TYPE)
+
+test_dynamic :: pure_all
+ PERL_DL_NONLAZY=1 $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
+
+testdb_dynamic :: pure_all
+ PERL_DL_NONLAZY=1 $(FULLPERL) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
+
+test_ : test_dynamic
+
+test_static :: test_dynamic
+testdb_static :: testdb_dynamic
+
+
+# --- MakeMaker ppd section:
+# Creates a PPD (Perl Package Description) for a binary distribution.
+ppd:
+ @$(PERL) -e "print qq{<SOFTPKG NAME=\"Bio-Graphics\" VERSION=\"0,50,0,0\">\n}. qq{\t<TITLE>Bio-Graphics</TITLE>\n}. qq{\t<ABSTRACT></ABSTRACT>\n}. qq{\t<AUTHOR></AUTHOR>\n}. qq{\t<IMPLEMENTATION>\n}. qq{\t\t<DEPENDENCY NAME=\"GD\" VERSION=\"1,2,0,0\" />\n}. qq{\t\t<OS NAME=\"$(OSNAME)\" />\n}. qq{\t\t<ARCHITECTURE NAME=\"i586-linux\" />\n}. qq{\t\t<CODEBASE HREF=\"\" />\n}. qq{\t</IMPLEMENTATION>\n}. qq{</SOFTPKG>\n}" > Bio-Graphics.ppd
+
+# --- MakeMaker pm_to_blib section:
+
+pm_to_blib: $(TO_INST_PM)
+ @$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
+ "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
+ -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'$(INST_LIB)/auto')"
+ @$(TOUCH) $@
+
+
+# --- MakeMaker selfdocument section:
+
+
+# --- MakeMaker postamble section:
+
+
+# End.
11 Makefile.PL
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Bio::Graphics',
+ 'VERSION_FROM' => 'Graphics/Panel.pm', # finds $VERSION
+ 'PREREQ_PM' => {GD => 1.20}, # e.g., Module::Name => 1.1
+ 'LIBS' => [''], # e.g., '-lm'
+ 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
+ 'INC' => '', # e.g., '-I/usr/include/other'
+);
2 README
@@ -0,0 +1,2 @@
+First pass on rewrite of Bio::Graphics module for displaying
+horizontal sequence and clone maps.
96 eg/testit.pl
@@ -0,0 +1,96 @@
+#!/usr/bin/perl -w
+
+use lib '.','./blib/lib','../blib/lib';
+use strict;
+
+use Bio::Graphics::Panel;
+use Bio::Graphics::Feature;
+
+my $ftr = 'Bio::Graphics::Feature';
+
+my $segment = $ftr->new(-start=>1,-end=>1000,-name=>'ZK154',-type=>'clone');
+my $zk154_1 = $ftr->new(-start=>300,-end=>800,-name=>'ZK154.1',-type=>'gene');
+my $zk154_2 = $ftr->new(-start=>380,-end=>500,-name=>'ZK154.2',-type=>'gene');
+
+my $zed_27 = $ftr->new(-segments=>[[400,500],[550,600],[800,950]],
+ -name=>'zed-27',
+ -subtype=>'exon',-type=>'transcript');
+my $abc3 = $ftr->new(-segments=>[[100,200],[350,400],[500,550]],
+ -name=>'abc3',
+ -strand => -1,
+ -subtype=>'exon',-type=>'transcript');
+my $xyz4 = $ftr->new(-segments=>[[40,80],[100,120],[200,280],[300,320]],
+ -name=>'xyz4',
+ -subtype=>'predicted',-type=>'alignment');
+
+my $m3 = $ftr->new(-segments=>[[20,40],[30,60],[90,270],[290,300]],
+ -name=>'M3',
+ -subtype=>'predicted',-type=>'alignment');
+
+my $fred_12 = $ftr->new(-segments=>[$xyz4,$zed_27],
+ -type => 'group',
+ -name =>'fred-12');
+
+my $predicted_exon1 = $ftr->new(-start=>32,-stop=>42,
+ -type=>'exon',-source=>'predicted');
+my $predicted_exon2 = $ftr->new(-start=>55,-stop=>85,
+ -type=>'exon',-source=>'predicted');
+
+my $confirmed_exon3 = $ftr->new(-start=>150,-stop=>190,
+ -type=>'exon',-source=>'confirmed');
+