[Bioperl-l] Bio::Graphics - Here is the program in a better format

Allen Liu axl163 at yahoo.com
Fri Jun 18 09:51:29 EDT 2004


#!/usr/bin/perl -w

use strict;
use Bio::Graphics;
use Bio::SeqFeature::Generic;

chomp (my $file = shift(@ARGV));
open(INPUT, "<$file") or die "Cannot open \"$file\": $!\n";
my @data = <INPUT>;
close INPUT;
my $panel;
                  
my $flag = 1;

my ($feature, $track);

foreach(@data) {
    chomp;
    next if /^\#/; # ignore comments
    my ($name, $length, $domain, $score, $start, $end) = split /\t+/;
    
    if($flag == 1) {
        
        # draw panel
        $panel = Bio::Graphics::Panel->new(-length => $length,
                                      -width => 800,
                                      -pad_left => 10,
                                      -pad_right => 10,
                                      );
        
        # draw reference ruler of size sequence
        my $full_length = Bio::SeqFeature::Generic->new(-start=>1,
-end=>$length);
        $panel->add_track($full_length,
                          -glyph => 'arrow',
                          -tick => 2,
                          -fgcolor => 'black',
                          -double => 1,
                          -label => "$name",
                          );
        $flag = 0;
        
        $track = $panel -> add_track(-glyph => 'rndrect',
                                -label => 1,
                                -bgcolor => 'blue',
                                -min_score => 0,
                                -max_score => 1000,
                                -font2color => 'red',
                                -sort_order => 'high_score',
                                -description => sub {
                                    my $feature = shift;
                                    my $score = $feature->score;
                                    if ($score =~ /E/) {
                                        return "e-value=$score";
                                    }
                                    else {
                                        return "score=$score";
                                    }
                                    });

        $feature = Bio::SeqFeature::Generic->new(-display_name=>$domain,
-score=>$score, -start=>$start, -end=>$end);
        
    
    }              

    
    my $subfeature = Bio::SeqFeature::Generic->new(-label =>$domain,
-display_name=>$domain, -score=>$score, -start=>$start, -end=>$end);
    $feature->add_SeqFeature($subfeature, 'EXPAND');

}
$track -> add_feature($feature);

print $panel -> png;

exit;



More information about the Bioperl-l mailing list