comparison variant_effect_predictor/Bio/Graphics/Glyph/transcript2.pm @ 0:21066c0abaf5 draft

Uploaded
author willmclaren
date Fri, 03 Aug 2012 10:04:48 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:21066c0abaf5
1 package Bio::Graphics::Glyph::transcript2;
2
3 # $Id: transcript2.pm,v 1.15.2.1 2003/07/05 00:32:04 lstein Exp $
4
5 use strict;
6 use Bio::Graphics::Glyph::transcript;
7 use vars '@ISA';
8 @ISA = 'Bio::Graphics::Glyph::transcript';
9
10 use constant MIN_WIDTH_FOR_ARROW => 8;
11
12 sub pad_left {
13 my $self = shift;
14 my $pad = $self->Bio::Graphics::Glyph::generic::pad_left;
15 return $pad unless ($self->feature->strand||0) < 0; #uninitialized var warning
16 my $first = ($self->parts)[0] || $self;
17 my @rect = $first->bounds();
18 my $width = abs($rect[2] - $rect[0]);
19 return $self->SUPER::pad_left if $width < MIN_WIDTH_FOR_ARROW;
20 return $pad;
21 }
22
23 sub pad_right {
24 my $self = shift;
25 my $pad = $self->Bio::Graphics::Glyph::generic::pad_right;
26 return $pad if $self->{level} > 0;
27 my $last = ($self->parts)[-1] || $self;
28 my @rect = $last->bounds();
29 my $width = abs($rect[2] - $rect[0]);
30 return $self->SUPER::pad_right if $width < MIN_WIDTH_FOR_ARROW;
31 return $pad
32 }
33
34 sub draw_component {
35 my $self = shift;
36 return unless $self->level > 0;
37
38 my $gd = shift;
39 my ($left,$top) = @_;
40 my @rect = $self->bounds(@_);
41
42 my $width = abs($rect[2] - $rect[0]);
43 my $filled = defined($self->{partno}) && $width >= MIN_WIDTH_FOR_ARROW;
44
45 if ($filled) {
46 my $f = $self->feature;
47 my $strand = $f->strand;
48 my ($first,$last) = ($self->{partno} == 0 , $self->{partno} == $self->{total_parts}-1);
49 ($first,$last) = ($last,$first) if $self->{flip};
50
51 if ($strand < 0 && $first) { # first exon, minus strand transcript
52 $self->filled_arrow($gd,-1,@rect);
53 } elsif ($strand >= 0 && $last) { # last exon, plus strand
54 $self->filled_arrow($gd,+1,@rect);
55 } else {
56 $self->SUPER::draw_component($gd,@_);
57 }
58 }
59
60 else {
61 $self->SUPER::draw_component($gd,@_);
62 }
63
64 }
65
66 sub draw_connectors {
67 my $self = shift;
68 my ($gd,$dx,$dy) = @_;
69
70 my $part;
71 my $strand = $self->feature->strand;
72 $strand *= -1 if $self->{flip}; #sigh
73 if (my @parts = $self->parts) {
74 $part = $strand >= 0 ? $parts[-1] : $parts[0];
75 } else {
76 # no parts -- so draw an intron spanning whole thing
77 my($x1,$y1,$x2,$y2) = $self->bounds(0,0);
78 $self->_connector($gd,$dx,$dy,$x1,$y1,$x1,$y2,$x2,$y1,$x2,$y2);
79 $part = $self;
80 }
81 my @rect = $part->bounds();
82 my $width = abs($rect[2] - $rect[0]);
83 my $filled = $width >= MIN_WIDTH_FOR_ARROW;
84
85 if ($filled) {
86 $self->Bio::Graphics::Glyph::generic::draw_connectors(@_);
87 } else {
88 $self->SUPER::draw_connectors(@_);
89 }
90 }
91
92 sub bump {
93 my $self = shift;
94 return $self->SUPER::bump(@_) if $self->all_callbacks;
95 return 0; # never allow our components to bump
96 }
97
98 1;
99
100
101 __END__
102
103 =head1 NAME
104
105 Bio::Graphics::Glyph::transcript2 - The "transcript2" glyph
106
107 =head1 SYNOPSIS
108
109 See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
110
111 =head1 DESCRIPTION
112
113 This glyph is used for drawing transcripts. It is like "transcript"
114 except that if there is sufficient room the terminal exon is shaped
115 like an arrow in order to indicate the direction of transcription. If
116 there isn't enough room, a small arrow is drawn.
117
118 =head2 OPTIONS
119
120 The following options are standard among all Glyphs. See
121 L<Bio::Graphics::Glyph> for a full explanation.
122
123 Option Description Default
124 ------ ----------- -------
125
126 -fgcolor Foreground color black
127
128 -outlinecolor Synonym for -fgcolor
129
130 -bgcolor Background color turquoise
131
132 -fillcolor Synonym for -bgcolor
133
134 -linewidth Line width 1
135
136 -height Height of glyph 10
137
138 -font Glyph font gdSmallFont
139
140 -connector Connector type 0 (false)
141
142 -connector_color
143 Connector color black
144
145 -label Whether to draw a label 0 (false)
146
147 -description Whether to draw a description 0 (false)
148
149 -strand_arrow Whether to indicate 0 (false)
150 strandedness
151
152 In addition, the alignment glyph recognizes the following
153 glyph-specific options:
154
155 Option Description Default
156 ------ ----------- -------
157
158 -arrow_length Length of the directional 8
159 arrow.
160
161 =head1 BUGS
162
163 Please report them.
164
165 =head1 SEE ALSO
166
167
168 L<Bio::Graphics::Panel>,
169 L<Bio::Graphics::Glyph>,
170 L<Bio::Graphics::Glyph::arrow>,
171 L<Bio::Graphics::Glyph::cds>,
172 L<Bio::Graphics::Glyph::crossbox>,
173 L<Bio::Graphics::Glyph::diamond>,
174 L<Bio::Graphics::Glyph::dna>,
175 L<Bio::Graphics::Glyph::dot>,
176 L<Bio::Graphics::Glyph::ellipse>,
177 L<Bio::Graphics::Glyph::extending_arrow>,
178 L<Bio::Graphics::Glyph::generic>,
179 L<Bio::Graphics::Glyph::graded_segments>,
180 L<Bio::Graphics::Glyph::heterogeneous_segments>,
181 L<Bio::Graphics::Glyph::line>,
182 L<Bio::Graphics::Glyph::pinsertion>,
183 L<Bio::Graphics::Glyph::primers>,
184 L<Bio::Graphics::Glyph::rndrect>,
185 L<Bio::Graphics::Glyph::segments>,
186 L<Bio::Graphics::Glyph::ruler_arrow>,
187 L<Bio::Graphics::Glyph::toomany>,
188 L<Bio::Graphics::Glyph::transcript>,
189 L<Bio::Graphics::Glyph::transcript2>,
190 L<Bio::Graphics::Glyph::translation>,
191 L<Bio::Graphics::Glyph::triangle>,
192 L<Bio::DB::GFF>,
193 L<Bio::SeqI>,
194 L<Bio::SeqFeatureI>,
195 L<Bio::Das>,
196 L<GD>
197
198 =head1 AUTHOR
199
200 Lincoln Stein E<lt>lstein@cshl.orgE<gt>
201
202 Copyright (c) 2001 Cold Spring Harbor Laboratory
203
204 This library is free software; you can redistribute it and/or modify
205 it under the same terms as Perl itself. See DISCLAIMER.txt for
206 disclaimers of warranty.
207
208 =cut