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