← Back to branch summary

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

« back to all changes in this revision

Viewing changes to examples/biographics/dynamic_glyphs.pl

  • 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:
examples/biographics/dynamic_glyphs.pl
1
 
#!/usr/bin/perl
2
 
 
3
 
use lib '.','../..','./blib/lib','../../blib/lib','../..';
4
 
use strict;
5
 
use Bio::Graphics::Panel;
6
 
use Bio::Graphics::Feature;
7
 
 
8
 
chomp (my $PKG = shift);
9
 
$PKG or die "\nUsage: lots_of_glyphs IMAGE_CLASS
10
 
\t- where IMAGE_CLASS is one of GD or GD::SVG
11
 
\t- GD generate png output; GD::SVG generates SVG.\n";
12
 
 
13
 
my $ftr = 'Bio::Graphics::Feature';
14
 
 
15
 
my $segment = $ftr->new(-start=>-100,-end=>1400,-name=>'ZK154',-type=>'clone');
16
 
my $zk154_1 = $ftr->new(-start=>-50,-end=>800,-name=>'ZK154.1',-type=>'gene');
17
 
my $zk154_2 = $ftr->new(-segments=>[[200,300],[380,800]],-name=>'ZK154.2',-type=>'gene');
18
 
my $zk154_3 = $ftr->new(-start=>900,-end=>1200,-name=>'ZK154.3',-type=>'gene');
19
 
 
20
 
my $zed_27 = $ftr->new(-segments=>[[550,600],[800,950],[1200,1300]],
21
 
                   -name=>'zed-27',
22
 
                   -subtype=>'exon',-type=>'transcript');
23
 
my $abc3 = $ftr->new(-segments=>[[100,200],[350,400],[500,550]],
24
 
                    -name=>'abc53',
25
 
                     -strand => -1,
26
 
                    -subtype=>'exon',-type=>'transcript');
27
 
my $xyz4 = $ftr->new(-segments=>[[40,80],[100,120],[200,280],[300,320]],
28
 
                     -name=>'xyz4',
29
 
                     -subtype=>'predicted',-type=>'alignment');
30
 
 
31
 
my $m3 = $ftr->new(-segments=>[[20,40],[30,60],[90,270],[290,300]],
32
 
                   -name=>'M3',
33
 
                   -subtype=>'predicted',-type=>'alignment');
34
 
 
35
 
my $bigone = $ftr->new(-segments=>[[-200,-120],[90,270],[290,300]],
36
 
                   -name=>'big one',
37
 
                   -subtype=>'predicted',-type=>'alignment');
38
 
 
39
 
my $fred_12 = $ftr->new(-segments=>[$xyz4,$zed_27],
40
 
                        -type => 'group',
41
 
                        -name =>'fred-12');
42
 
 
43
 
my $confirmed_exon1 = $ftr->new(-start=>1,-stop=>20,
44
 
                                -type=>'exon',
45
 
                                -source=>'confirmed',
46
 
                                -name => 'confirmed1',
47
 
                               );
48
 
my $predicted_exon1 = $ftr->new(-start=>30,-stop=>50,
49
 
                                -type=>'exon',
50
 
                                -name=>'predicted1',
51
 
                                -source=>'predicted');
52
 
my $predicted_exon2 = $ftr->new(-start=>60,-stop=>100,
53
 
                                -name=>'predicted2',
54
 
                                -type=>'exon',-source=>'predicted');
55
 
 
56
 
my $confirmed_exon3 = $ftr->new(-start=>150,-stop=>190,
57
 
                                -type=>'exon',-source=>'confirmed',
58
 
                               -name=>'abc123');
59
 
my $partial_gene = $ftr->new(-segments=>[$confirmed_exon1,$predicted_exon1,$predicted_exon2,$confirmed_exon3],
60
 
                             -name => 'partial gene',
61
 
                             -type => 'transcript',
62
 
                             -source => '(from a big annotation pipeline)'
63
 
                            );
64
 
my @segments = $partial_gene->segments;
65
 
my $score = 10;
66
 
foreach (@segments) {
67
 
  $_->score($score);
68
 
  $score += 10;
69
 
}
70
 
 
71
 
my $panel = Bio::Graphics::Panel->new(
72
 
                                      -gridcolor => 'lightcyan',
73
 
                                      -grid => 1,
74
 
                                      -segment => $segment,
75
 
                                      -spacing => 15,
76
 
                                      -width   => 600,
77
 
                                      -pad_top  => 20,
78
 
                                      -pad_bottom  => 20,
79
 
                                      -pad_left => 20,
80
 
                                      -pad_right=> 20,
81
 
                                      -key_style => 'between',
82
 
                                      -image_class=> $PKG,
83
 
                                     );
84
 
my @colors = $panel->color_names();
85
 
 
86
 
my $t = $panel->add_track(
87
 
                          transcript2 => [$abc3,$zed_27],
88
 
                          -label => 1,
89
 
                          -bump => 1,
90
 
                          -key => 'Prophecies',
91
 
                          #               -tkcolor => $colors[rand @colors],
92
 
                         );
93
 
$t->configure(-bump=>1);
94
 
$panel->add_track($segment,
95
 
                  -glyph => 'arrow',
96
 
                  -label => sub {scalar localtime},
97
 
#                 -labelfont => 'gdMediumBoldFont',
98
 
                  -double => 1,
99
 
                  -bump => 0,
100
 
                  -height => 10,
101
 
                  -arrowstyle=>'regular',
102
 
                  -linewidth=>1,
103
 
                  -tick => 2,
104
 
                 );
105
 
 
106
 
$panel->add_track(generic => [$segment,$abc3,$zk154_1,[$zk154_2,$xyz4]],
107
 
                  -label     => sub { $_[-1]->level == 0 } ,
108
 
                  -bgcolor   => sub { shift->primary_tag eq 'predicted' ? 'green' : 'blue'},
109
 
                  -connector => sub { my $primary_tag = shift->primary_tag;
110
 
                                      $primary_tag eq 'transcript' ? 'hat'
111
 
                                    : $primary_tag eq 'alignment'  ? 'solid'
112
 
                                    : 'solid'},
113
 
                  -connector_color => 'black',
114
 
                  -height => 10,
115
 
                  -bump => 1,
116
 
#                 -tkcolor => $colors[rand @colors],
117
 
                  -key => 'Signals',
118
 
                 );
119
 
 
120
 
my $track = $panel->add_track('transcript2'=> [$bigone],
121
 
                              -label   => 1,
122
 
                              -connector => 'solid',
123
 
                              -point  => 0,
124
 
                              -orient => 'N',
125
 
                              -height => 8,
126
 
                              -base => 1,
127
 
                              -relative_coords => 1,
128
 
                              -tick  => 2,
129
 
                              -bgcolor => 'red',
130
 
                              -key     => 'Dynamically Added');
131
 
#$track->add_feature($bigone,$zed_27,$abc3);
132
 
#$track->add_group($predicted_exon1,$predicted_exon2,$confirmed_exon3);
133
 
$track->add_group($bigone,$zed_27,$zk154_2,$bigone);
134
 
 
135
 
my $gd    = $panel->gd;
136
 
my @boxes = $panel->boxes;
137
 
my $red   = $panel->translate_color('red');
138
 
for my $box (@boxes) {
139
 
  my ($feature,@points) = @$box;
140
 
}
141
 
my $type = ($PKG eq 'GD') ? 'png' : 'svg';
142
 
print $gd->$type;