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;