← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to Bio/Graphics/Glyph/transcript.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Graphics/Glyph/transcript.pm
1
 
package Bio::Graphics::Glyph::transcript;
2
 
# $Id: transcript.pm,v 1.23.4.1 2006/10/02 23:10:20 sendu Exp $
3
 
 
4
 
use strict;
5
 
use base qw(Bio::Graphics::Glyph::segments);
6
 
 
7
 
sub pad_left  {
8
 
  my $self = shift;
9
 
  return 0 unless $self->{level} == 0;
10
 
  my $pad  = $self->SUPER::pad_left;
11
 
  my $strand = $self->feature->strand;
12
 
  return $pad unless defined $strand && $strand < 0;
13
 
  return $self->arrow_length > $pad ? $self->arrow_length : $pad;
14
 
}
15
 
 
16
 
sub pad_right {
17
 
  my $self = shift;
18
 
  return 0 unless $self->{level} == 0;
19
 
  my $pad = $self->SUPER::pad_right;
20
 
  my $strand = $self->feature->strand;
21
 
  return $pad unless defined($strand) && $strand > 0;
22
 
  return $self->arrow_length > $pad ? $self->arrow_length : $pad;
23
 
}
24
 
 
25
 
sub draw_component {
26
 
  my $self = shift;
27
 
  return unless $self->level > 0;
28
 
  $self->SUPER::draw_component(@_);
29
 
}
30
 
 
31
 
sub part_label_merge {
32
 
  my $self = shift;
33
 
  my $label = $self->SUPER::part_label_merge;
34
 
  return $label if defined $label;
35
 
  1;
36
 
}
37
 
 
38
 
sub draw_connectors {
39
 
  my $self = shift;
40
 
  my $gd = shift;
41
 
  my ($left,$top) = @_;
42
 
 
43
 
  $self->SUPER::draw_connectors($gd,$left,$top);
44
 
  my @parts = $self->parts; # or return;
45
 
 
46
 
  # H'mmm.  No parts.  Must be in an intron, so draw intron
47
 
  # spanning entire range
48
 
  if (!@parts) {
49
 
    return unless $self->feature_has_subparts;
50
 
    my($x1,$y1,$x2,$y2) = $self->bounds(0,0);
51
 
    $self->_connector($gd,$left,$top,$x1,$y1,$x1,$y2,$x2,$y1,$x2,$y2);
52
 
    @parts = ($self);
53
 
  }
54
 
 
55
 
  # flip argument makes this confusing
56
 
  # certainly there's a simpler way to express this idea
57
 
  my $strand    = $self->feature->strand;
58
 
  my ($first,$last) = ($parts[0],$parts[-1]);
59
 
 
60
 
  ($first,$last) = ($last,$first) if exists $self->{flip};
61
 
 
62
 
  if ($strand > 0) {
63
 
    my($x1,$y1,$x2,$y2) = $last->bounds(@_);
64
 
    my $center = ($y2+$y1)/2;
65
 
    $self->{flip} ?
66
 
        $self->arrow($gd,$x1,$x1-$self->arrow_length,$center)
67
 
      :
68
 
        $self->arrow($gd,$x2,$x2+$self->arrow_length,$center);
69
 
  }
70
 
 
71
 
  elsif ($strand < 0) {
72
 
    my($x1,$y1,$x2,$y2) = $first->bounds(@_);
73
 
    my $center = ($y2+$y1)/2;
74
 
    $self->{flip } ?
75
 
        $self->arrow($gd,$x2,$x2+$self->arrow_length,$center)
76
 
      :
77
 
        $self->arrow($gd,$x1,$x1 - $self->arrow_length,$center);
78
 
  }
79
 
}
80
 
 
81
 
sub arrow_length {
82
 
  my $self = shift;
83
 
  return $self->option('arrow_length') || 8;
84
 
}
85
 
 
86
 
# override option() for force the "hat" type of connector
87
 
sub connector {
88
 
  my $self = shift;
89
 
  return $self->SUPER::connector(@_) if $self->all_callbacks;
90
 
  return ($self->option('connector') || 'hat');
91
 
}
92
 
 
93
 
 
94
 
1;
95
 
 
96
 
__END__
97
 
 
98
 
=head1 NAME
99
 
 
100
 
Bio::Graphics::Glyph::transcript - The "transcript" glyph
101
 
 
102
 
=head1 SYNOPSIS
103
 
 
104
 
  See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
105
 
 
106
 
=head1 DESCRIPTION
107
 
 
108
 
This glyph is used for drawing transcripts.  It is essentially a
109
 
"segments" glyph in which the connecting segments are hats.  The
110
 
direction of the transcript is indicated by an arrow attached to the
111
 
end of the glyph.
112
 
 
113
 
=head2 OPTIONS
114
 
 
115
 
The following options are standard among all Glyphs.  See
116
 
L<Bio::Graphics::Glyph> for a full explanation.
117
 
 
118
 
  Option      Description                      Default
119
 
  ------      -----------                      -------
120
 
 
121
 
  -fgcolor      Foreground color               black
122
 
 
123
 
  -outlinecolor Synonym for -fgcolor
124
 
 
125
 
  -bgcolor      Background color               turquoise
126
 
 
127
 
  -fillcolor    Synonym for -bgcolor
128
 
 
129
 
  -linewidth    Line width                     1
130
 
 
131
 
  -height       Height of glyph                10
132
 
 
133
 
  -font         Glyph font                     gdSmallFont
134
 
 
135
 
  -connector    Connector type                 0 (false)
136
 
 
137
 
  -connector_color
138
 
                Connector color                black
139
 
 
140
 
  -label        Whether to draw a label        0 (false)
141
 
 
142
 
  -description  Whether to draw a description  0 (false)
143
 
 
144
 
  -hilite       Highlight color                undef (no color)
145
 
 
146
 
In addition, the alignment glyph recognizes the following
147
 
glyph-specific options:
148
 
 
149
 
  Option         Description                  Default
150
 
  ------         -----------                  -------
151
 
 
152
 
  -arrow_length  Length of the directional   8
153
 
                 arrow.
154
 
 
155
 
=head1 BUGS
156
 
 
157
 
Please report them.
158
 
 
159
 
=head1 SEE ALSO
160
 
 
161
 
 
162
 
L<Bio::Graphics::Panel>,
163
 
L<Bio::Graphics::Glyph>,
164
 
L<Bio::Graphics::Glyph::arrow>,
165
 
L<Bio::Graphics::Glyph::cds>,
166
 
L<Bio::Graphics::Glyph::crossbox>,
167
 
L<Bio::Graphics::Glyph::diamond>,
168
 
L<Bio::Graphics::Glyph::dna>,
169
 
L<Bio::Graphics::Glyph::dot>,
170
 
L<Bio::Graphics::Glyph::ellipse>,
171
 
L<Bio::Graphics::Glyph::extending_arrow>,
172
 
L<Bio::Graphics::Glyph::generic>,
173
 
L<Bio::Graphics::Glyph::graded_segments>,
174
 
L<Bio::Graphics::Glyph::heterogeneous_segments>,
175
 
L<Bio::Graphics::Glyph::line>,
176
 
L<Bio::Graphics::Glyph::pinsertion>,
177
 
L<Bio::Graphics::Glyph::primers>,
178
 
L<Bio::Graphics::Glyph::rndrect>,
179
 
L<Bio::Graphics::Glyph::segments>,
180
 
L<Bio::Graphics::Glyph::ruler_arrow>,
181
 
L<Bio::Graphics::Glyph::toomany>,
182
 
L<Bio::Graphics::Glyph::transcript>,
183
 
L<Bio::Graphics::Glyph::transcript2>,
184
 
L<Bio::Graphics::Glyph::translation>,
185
 
L<Bio::Graphics::Glyph::triangle>,
186
 
L<Bio::DB::GFF>,
187
 
L<Bio::SeqI>,
188
 
L<Bio::SeqFeatureI>,
189
 
L<Bio::Das>,
190
 
L<GD>
191
 
 
192
 
=head1 AUTHOR
193
 
 
194
 
Lincoln Stein E<lt>lstein@cshl.orgE<gt>
195
 
 
196
 
Copyright (c) 2001 Cold Spring Harbor Laboratory
197
 
 
198
 
This library is free software; you can redistribute it and/or modify
199
 
it under the same terms as Perl itself.  See DISCLAIMER.txt for
200
 
disclaimers of warranty.
201
 
 
202
 
=cut