[Bioperl-l] background layer is not supported in Bioperl 1.6 for Bio::Graphics::Glyph
Scott Cain
scott at scottcain.net
Fri Jun 19 03:25:35 UTC 2009
Hi Xianjun,
The attached script (which is not too different from yours--I only did
a little clean up and made the padding consistent) makes the attached
image, which is what I think you want. I'm using bioperl-live.
Scott
On Thu, Jun 18, 2009 at 6:15 AM, Xianjun Dong<Xianjun.Dong at bccs.uib.no> wrote:
> Hi, Scott,
>
> Do you mind to have a look of the code (below my signature) if I use the
> -postgrid callback correctly?
> I still cannnot get the background for the whole panel.
>
> Thanks
>
> Xianjun
>
>
> Xianjun Dong wrote:
>>
>> Hi, Scott
>>
>> Before I gave up my own whole solution to use GBrowse, I still want to
>> bother you once:
>>
>> As you suggested, I put -postgrid option when the panel, which will call a
>> function to draw the background. The code below is almost copied from the
>> online POD of Bio::Graphics::Panel (see
>> http://doc.bioperl.org/releases/bioperl-current/bioperl-live/Bio/Graphics/Panel.html
>> )
>>
>> But it still does not work. Could you help to have a look? I paste it
>> below. (BTW, the above page of POD, the -postgrid=>\&draw_gap, while the gap
>> drawing function is gap_it, not draw_gap. I guess it's a typo. or not?)
>>
>> THanks
>>
>> Xianjun
>>
>> ----------------------------------------------- mytestcode.pl
>> --------------------------
>>
>> #!/usr/bin/perl
>>
>> use strict;
>> use lib "$ENV{HOME}/lib";
>>
>> use Bio::Graphics;
>> use Bio::Graphics::Feature;
>> my $ftr= 'Bio::Graphics::Feature';
>>
>> # processed_transcript
>> my $trans1 =
>> $ftr->new(-start=>50,-end=>10,-name=>'ZK154.1',-type=>"3'-UTR");
>> my $trans2 =
>> $ftr->new(-start=>100,-end=>50,-name=>'ZK154.2',-type=>'CDS');
>> my $trans3 =
>> $ftr->new(-start=>350,-end=>225,-name=>'ZK154.3',-type=>'CDS',
>> -source=>'a');
>> my $trans4 =
>> $ftr->new(-start=>650,-end=>500,-name=>'ZK154.3',-type=>'CDS',
>> -source=>'a');
>> my $trans5 =
>> $ftr->new(-start=>700,-end=>650,-name=>'ZK154.3',-type=>"5'-UTR");
>> my $trans =
>> $ftr->new(-segments=>[$trans1,$trans2,$trans3,$trans4,$trans5]);
>>
>> # hightlight
>> my $trans31 =
>> $ftr->new(-start=>240,-end=>450,-name=>'hightlight1',-type=>'background',
>> -source=>'a');
>> my $trans41 =
>> $ftr->new(-start=>650,-end=>600,-name=>'hightlight2',-type=>'multihourglass',
>> -source=>'b');
>>
>> my $panel= Bio::Graphics::Panel->new(-width=>1200,
>> -length=>1050,
>> -start =>0,
>> -pad_left=>12,
>> -pad_right=>12
>> -postgrid=>\&gap_it);
>>
>> sub gap_it {
>> my $gd = shift;
>> my $panel = shift;
>> my ($gap_start,$gap_end) = $panel->location2pixel(500,600);
>> my $top = $panel->top;
>> my $bottom = $gd->height, #panel->bottom;
>> my $gray = $panel->translate_color('red');
>> $gd->filledRectangle($gap_start,$top,$gap_end,$bottom,$gray);
>> }
>> # the following track works as I expected in bioperl 1.2.3, but not in 1.5
>> and 1.6
>> #$panel->add_track([$trans41,$trans31],
>> # -glyph => 'background',
>> # -block_bgcolor => sub{return (shift->source eq
>> 'a')?'#cccccc':'#fffc22'},
>> # );
>>
>> $panel->add_track($ftr->new(-start=>100,-end=>1000),
>> -glyph=>'arrow',
>> -double=>1,
>> -tick=>2);
>>
>> $panel->add_track($trans,
>> -glyph => 'transcript2', # 'transcript2', #process_5utr',
>> -fgcolor => 'darkred',
>> -bgcolor => 'darkred',
>> -title => '$source',
>> -link =>
>> 'http://www.ensembl.org/Homo_sapiens/transview?transcript=$name', #EnsEMBL
>> );
>> print $panel->png;
>>
>> # the following part works in bioperl 1.5 and 1.6, but not work in Bioperl
>> 1.2.3
>> my $map = $panel->create_web_map("image");
>> $panel->finished();
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>> Scott Cain wrote:
>>>
>>> Hi Xianjun,
>>>
>>> I understand what you want to do, as the current version of gbrowse
>>> does this, which uses bioperl 1.6. Without digging through the code,
>>> I can't tell you exactly how this works and you didn't send your code
>>> that uses this callback, so I can't try it either.
>>>
>>> One thing that is different between your code and gbrowse is that each
>>> of the tracks is actually a seperate panel (to allow track dragging),
>>> so it possible that this sort of callback doesn't work for
>>> Bio::Graphics any more.
>>>
>>> Scott
>>>
>>> On Saturday, June 13, 2009, Xianjun Dong <Xianjun.Dong at bccs.uib.no>
>>> wrote:
>>>
>>>>
>>>> Hi, Scott
>>>>
>>>> Thanks for your reply first.
>>>>
>>>> I still have question: I dig out the code from GBrowse (which I paste
>>>> below). Method make_postgrid_callback gets all highlight region and then use
>>>> hilite_regions_closure function to draw them out, using the following GD
>>>> function:
>>>>
>>>> $gd->filledRectangle($left+$start,0,$left+$end,$bottom,
>>>> $panel->translate_color($h_color));
>>>>
>>>> where the $bottom=$panel->bottom. This is the only difference from my
>>>> code, where I use $gd->height. I guess they are almost same (except the
>>>> pad_bottom), we can see this in the code of
>>>> http://doc.bioperl.org/releases/bioperl-current/bioperl-live/Bio/Graphics/Panel.html#CODE22
>>>>
>>>> OK. Anyway, I change to use $panel->bottom, instead of $gd->height, for
>>>> my highlight regions. The output is same, when using the library of Bioperl
>>>> 1.6 (or 1.5). You can see the attached image ("test.bioperl1.6.png")
>>>>
>>>> OK. I might have not explained my question explicitly. My question is:
>>>> if using bioperl 1.2.3 (actually the Bio::Graphics in bioperl 1.2.3), I can
>>>> get the right image I want (see the attached file "test.bioperl1.2.3.png"),
>>>> where the highlight range will go from the roof to the floor. While in
>>>> bioperl 1.5 (or 1.6), I only can see the highlight region in its own track,
>>>> not the whole panel. OK, did I explain clearly now? you can see the
>>>> difference of the two images.
>>>>
>>>> [I am not sure the mailist allow to attach image, otherwise, I put them
>>>> in the following links:
>>>> test.bioperl1.6.png: http://translog.genereg.net/test.bioperl1.6.png
>>>> test.bioperl1.2.3.png:
>>>> http://translog.genereg.net/test.bioperl1.2.3.png ]
>>>>
>>>> You can test it and see the difference if you have both 1.2.3 and 1.6 on
>>>> your computer?
>>>>
>>>> Really want to know how this works in bioperl 1.2.3 (Even though this
>>>> might be a bug at that version, or whatever)
>>>>
>>>> Thanks
>>>>
>>>> Xianjun
>>>> =============================================
>>>>
>>>> # this generates the callback for highlighting a region
>>>> sub make_postgrid_callback {
>>>> my $settings = shift;
>>>> return unless ref $settings->{h_region};
>>>>
>>>> my @h_regions = map {
>>>> my ($h_ref,$h_start,$h_end,$h_color) =
>>>> /^(.+):(\d+)\.\.(\d+)(?:@(\S+))?/;
>>>> defined($h_ref) && $h_ref eq $settings->{ref}
>>>> ? [$h_start,$h_end,$h_color||'lightgrey']
>>>> : ()
>>>> }
>>>> @{$settings->{h_region}};
>>>>
>>>> return unless @h_regions;
>>>> return hilite_regions_closure(@h_regions);
>>>> }
>>>>
>>>> # this subroutine generates a Bio::Graphics::Panel callback closure
>>>> # suitable for hilighting a region of a panel.
>>>> # The args are a list of [start,end,color]
>>>> sub hilite_regions_closure {
>>>> my @h_regions = @_;
>>>>
>>>> return sub {
>>>> my $gd = shift;
>>>> my $panel = shift;
>>>> my $left = $panel->pad_left;
>>>> my $top = $panel->top;
>>>> my $bottom = $panel->bottom;
>>>> for my $r (@h_regions) {
>>>> my ($h_start,$h_end,$h_color) = @$r;
>>>> my ($start,$end) = $panel->location2pixel($h_start,$h_end);
>>>> if ($end-$start <= 1) { $end++; $start-- } # so that we always see
>>>> something
>>>> # assuming top is 0 so as to ignore top padding
>>>> $gd->filledRectangle($left+$start,0,$left+$end,$bottom,
>>>> $panel->translate_color($h_color));
>>>> }
>>>> };
>>>> }
>>>>
>>>>
>>>> Scott Cain wrote:
>>>>
>>>> Hello Xianjun,
>>>>
>>>> I don't think that approach will work. What you almost certainly need
>>>> to do is a postgrid callback that does the drawing of the highlighted
>>>> region. For example code of how to do this, take a look at the
>>>> make_postgrid_callback subroutine in GBrowse 1.69. The option
>>>> -postgrid is a method of Bio::Graphics::Panel.
>>>>
>>>> Scott
>>>>
>>>>
>>>>
>>>>
>>>> On Fri, Jun 12, 2009 at 4:38 PM, Xianjun Dong<Xianjun.Dong at bccs.uib.no>
>>>> wrote:
>>>>
>>>>
>>>> HI,
>>>>
>>>> I am not sure this is the right place I can get help.
>>>>
>>>> I've suffered by a problem for several days: I want to highlight parts
>>>> of
>>>> regions in my track, using a different background color. To do that, I
>>>> defined a glyph named "background", based on the
>>>> 'Bio::Graphics::Glyph::generic' module. I override the draw_component()
>>>> method, by adding code like below:
>>>>
>>>> $gd->filledRectangle($left,0,$right,$gd->height,
>>>> $self->factory->translate_color($color));
>>>>
>>>> # the script is pasted at the end
>>>>
>>>> This will draw a rectangle with top=0, bottom=$gd->height. I made the
>>>> highlight regions into a list of features, and add_track with
>>>> -glyph=>'background'. (see the following script, test.pl) This really
>>>> works
>>>> as I expect, which will add a colored block at background of all tracks
>>>> in a
>>>> panel (including the ruler arrow). You can see the output image in
>>>> attached
>>>> file "test.bioperl1.2.3.png"
>>>>
>>>> Now, the problem comes: when I switch to Bioperl 1.5 (or 1.6), it does
>>>> not
>>>> work. Well, it works, but the highlight part only shrink to a low
>>>> height,
>>>> instead of covering all tracks in the panel. I also attached the output
>>>> here, see the file "test.bioperl1.6.png".
>>>>
>>>> I tried to think about the reason, the 'background' module is based on
>>>> the
>>>> generic module. What can cause the difference? Is it because $gd->height
>>>> is
>>>> different, or the tracks followed with 'background' track can not draw
>>>> from
>>>> the first position?
>>>>
>>>> Well. I can stick to use Bioperl 1.2.3 to avoid the problem. ("Smart
>>>> person
>>>> solve problem, wise person avoid problem"...) But another problem is
>>>> coming:
>>>> Bio::Graphics in Bioperl 1.2.3 does not support $panel->create_web_map()
>>>> function, which means I have to use some higher version if I want to
>>>> create
>>>> web map for my graphics, but then I have to give up using highlight
>>>> background.
>>>>
>>>> OK. It's long enough for my first-time submission here. Hope someone can
>>>> throw me some clue.
>>>>
>>>> Thanks ahead!!
>>>>
>>>> Xianjun
>>>>
>>>>
>>>> ==================== test.pl =======================
>>>> #!/usr/bin/perl
>>>>
>>>> use strict;
>>>> use lib "$ENV{HOME}/lib";
>>>>
>>>> use Bio::Graphics;
>>>> use Bio::Graphics::Feature;
>>>> my $ftr= 'Bio::Graphics::Feature';
>>>>
>>>> # processed_transcript
>>>> my $trans1 =
>>>> $ftr->new(-start=>50,-end=>10,-name=>'ZK154.1',-type=>"3'-UTR");
>>>> my $trans2 =
>>>> $ftr->new(-start=>100,-end=>50,-name=>'ZK154.2',-type=>'CDS');
>>>> my $trans3 =
>>>> $ftr->new(-start=>350,-end=>225,-name=>'ZK154.3',-type=>'CDS',
>>>> -source=>'a');
>>>> my $trans4 =
>>>> $ftr->new(-start=>650,-end=>500,-name=>'ZK154.3',-type=>'CDS',
>>>> -source=>'a');
>>>> my $trans5 =
>>>> $ftr->new(-start=>700,-end=>650,-name=>'ZK154.3',-type=>"5'-UTR");
>>>> my $trans =
>>>> $ftr->new(-segments=>[$trans1,$trans2,$trans3,$trans4,$trans5]);
>>>>
>>>> # hightlight
>>>> my $trans31 =
>>>>
>>>> $ftr->new(-start=>240,-end=>450,-name=>'hightlight1',-type=>'background',
>>>> -source=>'a');
>>>> my $trans41 =
>>>>
>>>> $ftr->new(-start=>650,-end=>600,-name=>'hightlight2',-type=>'multihourglass',
>>>> -source=>'b');
>>>>
>>>> my $panel= Bio::Graphics::Panel->new(-width=>1200,
>>>> -length=>1050,
>>>> -start =>0,
>>>> -pad_left=>12,
>>>> -pad_right=>12);
>>>>
>>>> # the following track works as I expected in bioperl 1.2.3, but not in
>>>> 1.5
>>>> and 1.6
>>>> $panel->add_track([$trans41,$trans31],
>>>> -glyph => 'background',
>>>> -block_bgcolor => sub{return (shift->source eq
>>>> 'a')?'#cccccc':'#fffc22'},
>>>> );
>>>>
>>>> $panel->add_track($ftr->new(-start=>100,-end=>1000),
>>>> -glyph=>'arrow',
>>>> -double=>1,
>>>> -tick=>2);
>>>>
>>>> $panel->add_track($trans,
>>>> -glyph => 'transcript2', # 'transcript2', #process_5utr',
>>>> -fgcolor => 'darkred',
>>>> -bgcolor => 'darkred',
>>>> -title => '$source',
>>>> -link =>
>>>> 'http://www.ensembl.org/Homo_sapiens/transview?transcript=$name',
>>>> #EnsEMBL
>>>> );
>>>> print $panel->png;
>>>>
>>>> # the following part works in bioperl 1.5 and 1.6, but not work in
>>>> Bioperl
>>>> 1.2.3
>>>> my $map = $panel->create_web_map("image");
>>>> $panel->finished();
>>>>
>>>> 1;
>>>>
>>>> ==================== background.pm =======================
>>>> package Bio::Graphics::Glyph::background;
>>>>
>>>> use strict;
>>>> use base 'Bio::Graphics::Glyph::generic';
>>>> sub pad_top{
>>>> return 0;
>>>> }
>>>>
>>>> sub draw_component {
>>>> my $self = shift;
>>>> #$self->SUPER::draw_component(@_);
>>>> my ($gd,$dx,$dy) = @_;
>>>> my ($left,$top,$right,$bottom) = $self->bounds($dx,$dy);
>>>>
>>>> # draw an arrow to indicate the direction of transcript
>>>> my $color = $self->option('block_bgcolor') || '#cccccc';
>>>> $gd->filledRectangle($left,0,$right,$gd->height,
>>>> $self->factory->translate_color($color));
>>>> }
>>>>
>>>> 1;
>>>>
>>>> --
>>>> ==========================================
>>>> Xianjun Dong
>>>> PhD student, Lenhard group
>>>> Computational Biology Unit
>>>> Bergen Center for Computational Science
>>>> University of Bergen
>>>> Hoyteknologisenteret, Thormohlensgate 55
>>>> N-5008 Bergen, Norway
>>>> E-mail: xianjun.dong at bccs.uib.no
>>>> Tel.: +47 555 84022
>>>> Fax : +47 555 84295
>>>> ==========================================
>>>>
>>>>
>>>> _______________________________________________
>>>> Bioperl-l mailing list
>>>> Bioperl-l at lists.open-bio.org
>>>> http://lists.open-bio.org/mailman/listinfo/bioperl-l
>>>>
>>>>
>>>>
>>>>
>>>>
>>>>
>>>>
>>>>
>>>>
>>>> --
>>>> ==========================================
>>>> Xianjun Dong
>>>> PhD student, Lenhard group
>>>> Computational Biology Unit
>>>> Bergen Center for Computational Science
>>>> University of Bergen
>>>> Hoyteknologisenteret, Thormohlensgate 55
>>>> N-5008 Bergen, Norway
>>>> E-mail: xianjun.dong at bccs.uib.no
>>>> Tel.: +47 555 84022
>>>> Fax : +47 555 84295
>>>> ==========================================
>>>>
>>>>
>>>>
>>>
>>>
>>
>
> --
> ==========================================
> Xianjun Dong
> PhD student, Lenhard group
> Computational Biology Unit
> Bergen Center for Computational Science
> University of Bergen
> Hoyteknologisenteret, Thormohlensgate 55
> N-5008 Bergen, Norway
> E-mail: xianjun.dong at bccs.uib.no
> Tel.: +47 555 84022
> Fax : +47 555 84295
> ==========================================
>
>
--
------------------------------------------------------------------------
Scott Cain, Ph. D. scott at scottcain dot net
GMOD Coordinator (http://gmod.org/) 216-392-3087
Ontario Institute for Cancer Research
-------------- next part --------------
A non-text attachment was scrubbed...
Name: postgrid.pl
Type: application/x-perl
Size: 2140 bytes
Desc: not available
URL: <http://lists.open-bio.org/pipermail/bioperl-l/attachments/20090618/0bee0f33/attachment.pl>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: postgrid_highlight.png
Type: image/png
Size: 7195 bytes
Desc: not available
URL: <http://lists.open-bio.org/pipermail/bioperl-l/attachments/20090618/0bee0f33/attachment-0004.png>
More information about the Bioperl-l
mailing list