1#!/usr/bin/perl -w
2
3use lib '.','..','./blib/lib','../blib/lib';
4use strict;
5
6use Bio::Graphics::Panel;
7use Bio::Graphics::Feature;
8
9my $ftr = 'Bio::Graphics::Feature';
10
11my $segment = $ftr->new(-start=>-100,-end=>1000,-name=>'ZK154',-type=>'clone');
12my $zk154_1 = $ftr->new(-start=>-50,-end=>800,-name=>'ZK154.1',-type=>'gene');
13my $zk154_2 = $ftr->new(-start=>380,-end=>500,-name=>'ZK154.2',-type=>'gene');
14my $zk154_3 = $ftr->new(-start=>900,-end=>1200,-name=>'ZK154.3',-type=>'gene');
15
16my $zed_27 = $ftr->new(-segments=>[[400,500],[550,600],[800,950]],
17		   -name=>'zed-27',
18		   -subtype=>'exon',-type=>'transcript');
19my $abc3 = $ftr->new(-segments=>[[100,200],[350,400],[500,550]],
20		    -name=>'abc53',
21		     -strand => -1,
22		    -subtype=>'exon',-type=>'transcript');
23my $xyz4 = $ftr->new(-segments=>[[40,80],[100,120],[200,280],[300,320]],
24		     -name=>'xyz4',
25		     -subtype=>'predicted',-type=>'alignment');
26
27my $m3 = $ftr->new(-segments=>[[20,40],[30,60],[90,270],[290,300]],
28		   -name=>'M3',
29		   -subtype=>'predicted',-type=>'alignment');
30
31my $bigone = $ftr->new(-segments=>[[-200,-120],[90,270],[290,300]],
32		   -name=>'big one',
33		   -subtype=>'predicted',-type=>'alignment');
34
35my $fred_12 = $ftr->new(-segments=>[$xyz4,$zed_27],
36			-type => 'group',
37			-name =>'fred-12');
38
39my $confirmed_exon1 = $ftr->new(-start=>1,-stop=>20,
40				-type=>'exon',
41				-source=>'confirmed',
42				-name => 'confirmed1',
43			       );
44my $predicted_exon1 = $ftr->new(-start=>30,-stop=>50,
45				-type=>'exon',
46				-name=>'predicted1',
47				-source=>'predicted');
48my $predicted_exon2 = $ftr->new(-start=>60,-stop=>100,
49				-name=>'predicted2',
50				-type=>'exon',-source=>'predicted');
51
52my $confirmed_exon3 = $ftr->new(-start=>150,-stop=>190,
53				-type=>'exon',-source=>'confirmed',
54			       -name=>'abc123');
55my $partial_gene = $ftr->new(-segments=>[$confirmed_exon1,$predicted_exon1,$predicted_exon2,$confirmed_exon3],
56			     -name => 'partial gene',
57			     -type => 'transcript',
58			     -source => '(from a big annotation pipeline)'
59			    );
60my @segments = $partial_gene->segments;
61my $score = 10;
62foreach (@segments) {
63  $_->score($score);
64  $score += 10;
65}
66
67my $panel = Bio::Graphics::Panel->new(
68#				      -grid => [50,100,150,200,250,300,310,320,330],
69				      -gridcolor => 'lightcyan',
70				      -grid => 1,
71				      -segment => $segment,
72#				      -offset => 300,
73#				      -length  => 1000,
74				      -spacing => 15,
75				      -width   => 600,
76				      -pad_top  => 20,
77				      -pad_bottom  => 20,
78				      -pad_left => 20,
79				      -pad_right=> 20,
80#				      -bgcolor => 'teal',
81#				      -key_style => 'between',
82				      -key_style => 'bottom',
83				     );
84my @colors = $panel->color_names();
85
86my $t = $panel->add_track(
87			  #		  generic => [$abc3,$zed_27],
88			  transcript2 => [$abc3,$zed_27],
89			  -label => 1,
90			  -bump => 1,
91			  -key => 'Prophecies',
92			  #		  -tkcolor => $colors[rand @colors],
93			 );
94$t->configure(-bump=>1);
95$panel->add_track($segment,
96		  -glyph => 'arrow',
97		  -label => 'base pairs',
98		  -double => 1,
99		  -bump => 0,
100		  -height => 10,
101		  -arrowstyle=>'regular',
102		  -linewidth=>1,
103#		  -tkcolor => $colors[rand @colors],
104		  -tick => 2,
105		 );
106$panel->unshift_track(generic => [$segment,$zk154_1,$zk154_2,$zk154_3,[$xyz4,$zed_27]],
107		      -label     => sub { my $feature = shift; $feature->sub_SeqFeature>0},
108		      -bgcolor   => sub { shift->primary_tag eq 'predicted' ? 'olive' : 'red'},
109		      -connector => sub { my $feature = shift;
110					  my $type = $feature->primary_tag;
111					  $type eq 'group'      ? 'dashed'
112					    : $type eq 'transcript' ? 'hat'
113					      : $type eq 'alignment'  ? 'solid'
114						: undef},
115		      -all_callbacks => 1,
116		      -connector_color => 'black',
117		      -height => 10,
118		      -bump => 1,
119		      -linewidth=>2,
120		      #		  -tkcolor => $colors[rand @colors],
121		      -key => 'Signs',
122		 );
123
124my $track = $panel->add_track('transcript2',
125			      -label   => sub { $_[-1]->level == 0 } ,
126			      -connector => sub { return shift->type eq 'group' ? 'dashed' : ''},
127			      -point  => 0,
128			      -orient => 'N',
129			      -height => 8,
130			      -base => 1,
131			      -relative_coords => 1,
132			      -tick  => 2,
133			      -all_callbacks => 1,
134			      -bgcolor => 'red',
135			      -key     => 'Dynamically Added');
136$track->add_feature($bigone,$zed_27,$abc3);
137$track->add_group($predicted_exon1,$predicted_exon2,$confirmed_exon3);
138
139$panel->add_track(
140		  [$abc3,$zed_27,$partial_gene],
141		  -bgcolor   => sub { shift->source_tag eq 'predicted' ? 'green' : 'blue'},
142		  -glyph   => 'transcript',
143#		  -glyph   => sub { my $feature = shift;
144#				    return $feature->source_tag eq 'predicted'
145#				      ? 'ellipse' : 'transcript'},
146		  -label       => sub { shift->sub_SeqFeature > 0 },
147#		  -label       => 1,
148#		  -description => sub { shift->sub_SeqFeature > 0 },
149		  -description => sub {
150		    my $feature = shift;
151		    return 1   if $feature->primary_tag eq 'transcript';
152		    return '*' if $feature->source_tag eq 'predicted';
153		    return;
154		  },
155		  -font2color  => 'red',
156		  -bump => +1,
157#		  -tkcolor => $colors[rand @colors],
158		  -key => 'Portents',
159		 );
160$panel->add_track(segments => [$segment,$zk154_1,[$zk154_2,$xyz4]],
161		  -label     => 1,
162		  -bgcolor   => sub { shift->primary_tag eq 'predicted' ? 'green' : 'blue'},
163		  -connector => sub { my $primary_tag = shift->primary_tag;
164				      $primary_tag eq 'transcript' ? 'hat'
165				    : $primary_tag eq 'alignment'  ? 'solid'
166				    : undef},
167		  -connector_color => 'black',
168		  -height => 10,
169		  -bump => 1,
170#		  -tkcolor => $colors[rand @colors],
171		  -key => 'Signals',
172		 );
173$panel->add_track(generic => [],
174		  -key => 'Foobar');
175
176$panel->add_track(graded_segments => $partial_gene,
177		  -bgcolor =>'blue',
178		  -label   => 1,
179		  -key     => 'Scored thing');
180
181$panel->add_track(diamond => [$segment,$zk154_1,$zk154_2,$zk154_3,$xyz4,$zed_27],
182		  -bgcolor =>'blue',
183		  -label   => 1,
184		  -key     => 'pointy thing');
185
186#print $panel->png;
187
188my $gd    = $panel->gd;
189my @boxes = $panel->boxes;
190my $red   = $panel->translate_color('red');
191for my $box (@boxes) {
192  my ($feature,@points) = @$box;
193#  $gd->rectangle(@points,$red);
194}
195#$gd->filledRectangle(0,0,20,200,1);
196#$gd->filledRectangle(600-20,0,600,200,1);
197print $gd->png;
198
199