File: fixedwidth.pm

package info (click to toggle)
libbio-graphics-perl 2.40-7
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 3,276 kB
  • sloc: perl: 21,801; makefile: 14
file content (341 lines) | stat: -rwxr-xr-x 9,021 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
package Bio::Graphics::Glyph::fixedwidth;

use strict;
use base 'Bio::Graphics::Glyph::box';
use Carp 'cluck';
use constant TOP_SPACING => 8;

sub my_description {
    return <<END;
This glyph is a base class for glyphs that wish to draw a fixed width
content, such as an icon, image, scatterplot, and it would be
inappropriate for the content to be stretched to match the start and
end point of the associated feature. Instead the glyph draws a simple
box spanning the feature\'s start:end region, two diagonal connecting
lines, and then a fixed width rectangle beneath the box.

See the "stackedplot" glyph for an example of a glyph that uses this base
class.
END
}

sub my_options {
    {
	fixed_width => [
	    'integer',
	    0,
	    'Width of the content.'],
	fixed_height => [
	    'integer',
	    undef,
	    'Height of the content. If undef, then the glyph -height is used.'],
	fixed_gap => [
	    'integer',
	    8,
	    'Vertical gap between the box that shows the extent of the',
	    'feature and the fixed-width content. If -fixed_gap is less',
	    'than 8 then the diagonal connecting lines are not drawn.'],
    }
}

sub pad_left {
  my $self   = shift;
  my $pl     = $self->SUPER::pad_left;
  my $width  = $self->width;
  my $needed = $self->width_needed;
  my $extra  = ($needed-$width)/2 + 1;
  if ($extra > $pl) {
    return $extra;
  } else {
    return $pl;
  }
}

sub pad_right {
  my $self   = shift;
  my $pr     = $self->SUPER::pad_right;
  my $width  = $self->width;
  my $needed = $self->width_needed;
  my $extra  = ($needed-$width)/2;
  $extra = 0 if $extra < 0;
  if ($extra > 0 && $extra > $pr) {
    return $extra;
  } else {
    return $pr-$extra;
  }
}

sub width_needed {
  my $self = shift;
  $self->option('fixed_width');
}

sub height_needed {
  my $self = shift;
  my $h = $self->option('fixed_height');
  return $h if defined $h;
  return $self->SUPER::height;
}

sub height {
  shift->height_needed;
}

sub span_height {
  shift->option('span_height') || 3;
}

sub top_spacing {
  my $self = shift;
  my $spacing = $self->option('fixed_gap');
  return $spacing if defined $spacing;
  return TOP_SPACING;
}

sub pad_top {
  my $self    = shift;
  my $top  = $self->SUPER::pad_top;
  return $top + $self->top_spacing + $self->span_height;
}

sub maxdepth { 0 }

sub draw {
  my $self = shift;
  my $gd       = shift;
  my ($dx,$dy) = @_;
  my($x1,$y1,$x2,$y2) = $self->bounds(@_);

  my $width        = $self->width_needed;
  my $xmid         = ($x1+$x2) / 2;

  my $top    = $y1 - $self->span_height-$self->top_spacing;
  my $bottom = $y2;

  my $left         = $xmid - $width/2;
  my $right        = $xmid + $width/2;

   my $fgcolor      = $self->fgcolor;

  my $span_height = $self->span_height;
  $self->filled_box($gd,$x1,$top,$x2,$top+$span_height);

  if ($self->top_spacing >= 8) {
    $top += $span_height;
    $gd->line($x1,$top+2,$x1,$top+4,$fgcolor);
    $gd->line($x2,$top+2,$x2,$top+4,$fgcolor);
    $gd->line($x1,$top+4,$left,$y1-4,$fgcolor);
    $gd->line($x2,$top+4,$right,$y1-4,$fgcolor);
    $gd->line($left,$y1-4,$left,$y1-2,$fgcolor);
    $gd->line($right,$y1-4,$right,$y1-2,$fgcolor);
  }

  $self->draw_contents($gd,$left,$y1,$right,$y2);

  my $pl = $self->pad_left;
  $self->draw_label($gd,$dx-$pl,$dy)       if $self->option('label');
  $self->draw_description($gd,$dx-$pl,$dy) if $self->option('description');
}

sub draw_contents {
  my $self = shift;
  my ($gd,$left,$top,$right,$bottom) = @_;
  $self->filled_box($gd,$left,$top,$right,$bottom);
}

1;

__END__

=head1 NAME

Bio::Graphics::Glyph::fixedwidth - A base class fixed width glyphs

=head1 SYNOPSIS

 use Bio::Graphics;
 use Bio::Seq;
 use Bio::SeqFeature::Generic;

 my $bsg = 'Bio::SeqFeature::Generic';

 my $seq    = Bio::Seq->new(-length=>1000);

 my $whole  = $bsg->new(-display_name => 'Clone82',
 		        -start        => 1,
		        -end          => $seq->length);

 my $f1     = $bsg->new(-start        => 100,
		        -end          => 300,
		        -display_name => 'feature 1',
		       );

 my $f2      = $bsg->new(-start        => 500,
		         -end          => 800,
		         -display_name => 'feature 2',
		       );

 my $panel = Bio::Graphics::Panel->new(-length    => $seq->length,
				       -width     => 800,
				       -key_style => 'between',
				       -pad_left  => 10,
				       -pad_right => 10,
				      );

 $panel->add_track($whole,
		   -glyph    => 'arrow',
		   -double   => 1,
		   -tick     => 2,
		   -label    => 1,
		   );

 $panel->add_track([$f1,$f2],
		   -glyph    => 'fixedwidth',
		   -label    => 1,
                   -fixed_height => 20,
                   -fixed_width  => 20,
		   -key       => 'fixed width');

 binmode STDOUT;
 print $panel->png;

=head1 DESCRIPTION

This glyph is a base class for glyphs that wish to draw a fixed width
content, such as an icon, image, scatterplot, and it would be
inappropriate for the content to be stretched to match the start and
end point of the associated feature. Instead the glyph draws a simple
box spanning the feature's start:end region, two diagonal connecting
lines, and then a fixed width rectangle beneath the box.

This glyph does nothing very interesting itself. It is intended that
subclasses should override the draw_contents() method to draw
something interesting. See "Subclassing" for a simple example.

=head2 OPTIONS

The following options are standard among all Glyphs.  See
L<Bio::Graphics::Glyph> for a full explanation.

  Option      Description                      Default
  ------      -----------                      -------

  -fgcolor      Foreground color	       black

  -outlinecolor	Synonym for -fgcolor

  -bgcolor      Background color               turquoise

  -fillcolor    Synonym for -bgcolor

  -linewidth    Line width                     1

  -height       Height of glyph		       10

  -font         Glyph font		       gdSmallFont

  -connector    Connector type                 0 (false)

  -connector_color
                Connector color                black

  -label        Whether to draw a label	       0 (false)

  -description  Whether to draw a description  0 (false)

  -hilite       Highlight color                undef (no color)

The following additional options are available to the "fixedwidth" glyph:

  Option            Description                       Default
  ------            -----------                       -------

  -fixed_width      Width of the content                 0


  -fixed_height     Height of the content                Same as -height

  -fixed_gap        Vertical gap between the box         8
                    that shows the extent of the
                    feature and the fixed-width
                    content.

                    If -fixed_gap is less than 8
                    then the diagonal connecting
                    lines are not drawn.

=head2 EXAMPLE SUBCLASS

To draw something interesting in the fixed rectangle, override the
draw_contents method. It takes four arguments consisting of the GD
object, and the left, top, right and bottom coordinates of the fixed
rectangle. Example:

 package Bio::Graphics::Glyph::fixedexample;
 use strict;
 use base 'Bio::Graphics::Glyph::fixedwidth';

 sub draw_contents {
   my $self = shift;
   my ($gd,$left,$top,$right,$bottom) = @_;
   $self->unfilled_box($gd,$left,$top,$right,$bottom);
   $gd->line($left,$top,$right,$bottom,$self->fgcolor);
   $gd->line($left,$bottom,$right,$top,$self->fgcolor);
 }

 1;

This will draw the outline of the fixed rectangle. The rectangle will
contain two diagonal lines. Not very interesting, but an example,
nonetheless.

See the stackedplot glyph for a more interesting subclass.

=head1 BUGS AND LIMITATIONS

This glyph should used as the base for the image glyph, but
isn't. This will be fixed.

=head1 SEE ALSO

L<Bio::Graphics::Panel>,
L<Bio::Graphics::Glyph>,
L<Bio::Graphics::Glyph::arrow>,
L<Bio::Graphics::Glyph::cds>,
L<Bio::Graphics::Glyph::crossbox>,
L<Bio::Graphics::Glyph::diamond>,
L<Bio::Graphics::Glyph::dna>,
L<Bio::Graphics::Glyph::dot>,
L<Bio::Graphics::Glyph::ellipse>,
L<Bio::Graphics::Glyph::extending_arrow>,
L<Bio::Graphics::Glyph::generic>,
L<Bio::Graphics::Glyph::graded_segments>,
L<Bio::Graphics::Glyph::heterogeneous_segments>,
L<Bio::Graphics::Glyph::line>,
L<Bio::Graphics::Glyph::pinsertion>,
L<Bio::Graphics::Glyph::primers>,
L<Bio::Graphics::Glyph::rndrect>,
L<Bio::Graphics::Glyph::segments>,
L<Bio::Graphics::Glyph::ruler_arrow>,
L<Bio::Graphics::Glyph::toomany>,
L<Bio::Graphics::Glyph::transcript>,
L<Bio::Graphics::Glyph::transcript2>,
L<Bio::Graphics::Glyph::translation>,
L<Bio::Graphics::Glyph::triangle>,
L<Bio::DB::GFF>,
L<Bio::SeqI>,
L<Bio::SeqFeatureI>,
L<Bio::Das>,
L<GD>

=head1 AUTHOR

Lincoln Stein E<lt>lstein@cshl.orgE<gt>

Copyright (c) 2007 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