view release on metacpan or  search on metacpan

bin/draw_bgc_maps.pl  view on Meta::CPAN

                    begin     => $domain_begin, 
                    end       => $domain_end, 
                    class     => $domain->class,
                    y_cluster => $y_cluster,
                    y_overlap => $y_overlap,
                };

            }
        }
        
        # try next cluster mode if no @genes or no @domains 
        unless (@genes && @domains) {
            next CLUSTER;
        }

        # handle creation of module objects
        my $nomodule = 0;
        if ($cluster->meta->name eq 'Bio::Palantir::Refiner::ClusterPlus') {
            $nomodule = 1 if $cluster->from_seq == 1;
        }

        # Module objects
        if (scalar $cluster->all_modules > 0 && $nomodule == 0) {

            for my $module (sort { $a->rank <=> $b->rank } 
                $cluster->all_modules) {
            
                my @gene_uuis = @{ $module->gene_uuis };

                my @mgenes;
                for my $pattern (@gene_uuis) {
                    push @mgenes, grep { $_->{uui} eq $pattern } @genes;  #duplicated genes if 'all' mode
                }

                my @mdomains = sort { $a->rank <=> $b->rank } $module->all_domains;

                my $module_begin = $mgenes[0]->{begin}  + $mdomains[0]->begin;
                my $module_end   = $mgenes[-1]->{begin} + $mdomains[-1]->end;

                # NB: it's normal there is a difference between modules sizes calculated here and those from $module->coordinates
                # The modules calculated here are smaller because there are Nts between Palantir genes (from the genome), as gene coordinates are computed differently here, it's not the case.

                push @modules, {
                    name      => 'M' . $module->rank, 
                    begin     => $module_begin, 
                    end       => $module_end,
                    y_cluster => $y_cluster,
                };
            }
        }

        $y_cluster += $max_y_overlap + 625;
        $cluster_i++;
    }

    # do not draw if no @genes or @domains
    unless (@genes && @domains) {
        return;
    }
        
    # make the background transparent and interlaced
    my @sorted_ends = sort { $b <=> $a } map{ $_->{end} } @genes;
    my $width = $sorted_ends[0];
    my $height = $y_cluster + 600;

    my $left_margin = 50;
    my $right_margin = 50;
    
    my $img = GD::Simple->new($width + $left_margin + $right_margin, $height);

    # draw tickles
    $img->penSize(5,5);
    $img->line($left_margin, 75, $width, 75);    # $img->line($x1,$y1,$x2,$y2 [,$color])

    my $font = 'Arial';
    my $tickles_space = 1000;
    my $tickles_n = floor($width / $tickles_space);

    for my $i (0..$tickles_n) {
    
        my $tickle_pos = $i * $tickles_space;

        # line
        my $x1 = $left_margin + $tickle_pos;
        my $y1 = 75;
        my $x2 = $x1;
        my $y2 = 65;
        
        $img->line($x1, $y1, $x2, $y2);

        # text
        $img->moveTo($x1 - 100, 60);     # -100 to centerize the string
        $img->font($font);
        $img->fontsize(50);
        $img->string($tickle_pos);
    }
    
    # draw genes
    $img->moveTo($left_margin, $y_cluster + 100);
    $img->font($font);
    $img->fontsize(50);
    $img->string('Legend:');

    for my $gene (@genes) {
       
        # rectangle
        $img->penSize(5,5);

        $img->bgcolor($gene->{color});
        $img->fgcolor('black');

        my $x1 = $gene->{begin} + $left_margin;
        my $y1 = 100 + $gene->{y_cluster};
        my $x2 = $gene->{end} + $left_margin;
        my $y2 = 200 + $gene->{y_cluster};

        $img->rectangle($x1, $y1, $x2, $y2); # (top_left_x, top_left_y, bottom_right_x, bottom_right_y)
        $img->moveTo( ($x1 + $x2)/2 - (15 * length $gene->{name}), 
            (100 + 200)/2 + 12.5 + $gene->{y_cluster} );
        $img->font($font);
        $img->fontsize(40);