← Back to branch summary

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

« back to all changes in this revision

Viewing changes to Bio/Graphics/Glyph/primers.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/primers.pm
1
 
package Bio::Graphics::Glyph::primers;
2
 
#$Id: primers.pm,v 1.7.4.3 2006/10/02 23:10:20 sendu Exp $
3
 
# package to use for drawing something that looks like
4
 
# primer pairs.
5
 
 
6
 
use strict;
7
 
use base qw(Bio::Graphics::Glyph::generic);
8
 
 
9
 
use constant HEIGHT => 8;
10
 
 
11
 
# override draw method
12
 
sub draw_component {
13
 
  my $self = shift;
14
 
  my $gd = shift;
15
 
  my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
16
 
  my $height = $self->option('height') || $self->option('size') || HEIGHT;
17
 
 
18
 
  my $fg = $self->fgcolor;
19
 
  my $a2 = $height/2;
20
 
  my $center = $y1 + $a2;
21
 
 
22
 
 
23
 
  # just draw us as a solid line -- very simple
24
 
  if ($x2-$x1 < $height*2) {
25
 
    $gd->line($x1,$center,$x2,$center,$fg);
26
 
    return;
27
 
  }
28
 
 
29
 
  # otherwise draw two pairs of arrows
30
 
  # -->   <--
31
 
  my $trunc_left  = $x1 < $self->panel->left;
32
 
  my $trunc_right = $x2 > $self->panel->right;
33
 
 
34
 
  unless ($trunc_left) { 
35
 
    $gd->setThickness(2) if $height > 6;
36
 
    $gd->line($x1,$center,$x1 + $height,$center,$fg);
37
 
    $gd->line($x1 + $height,$center,$x1 + $height - $a2,$center-$a2,$fg);
38
 
    $gd->line($x1 + $height,$center,$x1 + $height - $a2,$center+$a2,$fg);
39
 
    $gd->setThickness(1);
40
 
  }
41
 
 
42
 
  unless ($trunc_right) {
43
 
    $gd->setThickness(2) if $height > 6;
44
 
    $gd->line($x2,$center,$x2 - $height,$center,$fg);
45
 
    $gd->line($x2 - $height,$center,$x2 - $height + $a2,$center+$a2,$fg);
46
 
    $gd->line($x2 - $height,$center,$x2 - $height + $a2,$center-$a2,$fg);
47
 
    $gd->setThickness(1);
48
 
  }
49
 
 
50
 
  # connect the dots if requested
51
 
  if ($self->connect) {
52
 
    my $c = $self->color('connect_color') || $self->bgcolor;
53
 
    $gd->line($x1 + ($trunc_left  ? 0 : $height + 2),$center,
54
 
              $x2 - ($trunc_right ? 0 : $height + 2),$center,
55
 
              $c);
56
 
  }
57
 
 
58
 
  # add a label if requested
59
 
  $self->draw_label($gd,@_)       if $self->option('label');
60
 
  $self->draw_description($gd,@_) if $self->option('description');
61
 
 
62
 
}
63
 
 
64
 
sub connect {
65
 
  my $self = shift;
66
 
  return $self->option('connect') if defined $self->option('connect');
67
 
  1;  # default
68
 
}
69
 
 
70
 
1;
71
 
 
72
 
__END__
73
 
 
74
 
=head1 NAME
75
 
 
76
 
Bio::Graphics::Glyph::primers - The "STS primers" glyph
77
 
 
78
 
=head1 SYNOPSIS
79
 
 
80
 
  See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
81
 
 
82
 
=head1 DESCRIPTION
83
 
 
84
 
This glyph draws two arrows oriented towards each other and connected
85
 
by a line of a contrasting color.  The length of the arrows is
86
 
immaterial, but the length of the glyph itself corresponds to the
87
 
length of the scaled feature.
88
 
 
89
 
=head2 OPTIONS
90
 
 
91
 
In addition to the common options, the following glyph-specific
92
 
options are recognized:
93
 
 
94
 
  Option      Description               Default
95
 
  ------      -----------               -------
96
 
 
97
 
  -connect    Whether to connect the      true
98
 
              two arrowheads by a line.
99
 
 
100
 
  -connect_color  The color to use for the    bgcolor
101
 
              connecting line.
102
 
 
103
 
=head1 BUGS
104
 
 
105
 
Please report them.
106
 
 
107
 
=head1 SEE ALSO
108
 
 
109
 
 
110
 
L<Bio::Graphics::Panel>,
111
 
L<Bio::Graphics::Glyph>,
112
 
L<Bio::Graphics::Glyph::arrow>,
113
 
L<Bio::Graphics::Glyph::cds>,
114
 
L<Bio::Graphics::Glyph::crossbox>,
115
 
L<Bio::Graphics::Glyph::diamond>,
116
 
L<Bio::Graphics::Glyph::dna>,
117
 
L<Bio::Graphics::Glyph::dot>,
118
 
L<Bio::Graphics::Glyph::ellipse>,
119
 
L<Bio::Graphics::Glyph::extending_arrow>,
120
 
L<Bio::Graphics::Glyph::generic>,
121
 
L<Bio::Graphics::Glyph::graded_segments>,
122
 
L<Bio::Graphics::Glyph::heterogeneous_segments>,
123
 
L<Bio::Graphics::Glyph::line>,
124
 
L<Bio::Graphics::Glyph::pinsertion>,
125
 
L<Bio::Graphics::Glyph::primers>,
126
 
L<Bio::Graphics::Glyph::rndrect>,
127
 
L<Bio::Graphics::Glyph::segments>,
128
 
L<Bio::Graphics::Glyph::ruler_arrow>,
129
 
L<Bio::Graphics::Glyph::toomany>,
130
 
L<Bio::Graphics::Glyph::transcript>,
131
 
L<Bio::Graphics::Glyph::transcript2>,
132
 
L<Bio::Graphics::Glyph::translation>,
133
 
L<Bio::Graphics::Glyph::triangle>,
134
 
L<Bio::DB::GFF>,
135
 
L<Bio::SeqI>,
136
 
L<Bio::SeqFeatureI>,
137
 
L<Bio::Das>,
138
 
L<GD>
139
 
 
140
 
=head1 AUTHOR
141
 
 
142
 
Allen Day E<lt>day@cshl.orgE<gt>.
143
 
 
144
 
Copyright (c) 2001 Cold Spring Harbor Laboratory
145
 
 
146
 
This library is free software; you can redistribute it and/or modify
147
 
it under the same terms as Perl itself.  See DISCLAIMER.txt for
148
 
disclaimers of warranty.
149
 
 
150
 
=cut