view release on metacpan or  search on metacpan

lib/Tempest/Gd.pm  view on Meta::CPAN

        }
    }
    $coordinates = [ values(%normal) ];
    undef %normal;
    
    
    # load plot image (presumably greyscale)
    my $plot_file = GD::Image->new($parent->get_plot_file());
    
    # calculate coord correction based on plot image size
    my @plot_correct = ( ($plot_file->width / 2), ($plot_file->height / 2) );
    
    # colorize opacity for how many times at most a point will be repeated
    my $colorize_percent = 99 / $max_rep;
    if($colorize_percent < 1) { $colorize_percent = 1; }
    colorize($plot_file, $colorize_percent);
    
    # paste one plot for each coordinate pair
    for my $pair (@{$coordinates}) {
        my $x = ($pair->[0] - $plot_correct[0]);
        my $y = ($pair->[1] - $plot_correct[1]);
        
        # for how many times coord pair was repeated
        for (1..$pair->[2]) {
            # paste plot, centered on given coords
            composite($output_file, $plot_file, $x, $y);
        }
    }
    
    # destroy plot file, as we don't need it anymore
    undef $plot_file;
    
    # open color lookup table
    my $color_file = GD::Image->new($parent->get_color_file());
    
    # apply color lookup table
    my %cached_colors;
    for my $x (0..$output_file->width) {
        for my $y (0..$output_file->height) {
            # calculate color lookup location
            my $pixel_red = ($output_file->rgb( $output_file->getPixel($x, $y) ))[0];
            
            # cache colors as we look them up
            my @lookup_color;
            if(exists($cached_colors{$pixel_red})) {
                @lookup_color = @{ $cached_colors{$pixel_red} };
            }
            else {
                my $color_offset = ($pixel_red / 255) * ($color_file->height - 1);
                @lookup_color = $color_file->rgb( $color_file->getPixel(0, $color_offset) );
                $cached_colors{$pixel_red} = \@lookup_color;
            }
            
            # allocate and set new color from lookup table
            my $new_color = $output_file->colorAllocate(@lookup_color);
            $output_file->setPixel($x, $y, $new_color);
            $output_file->colorDeallocate($new_color);
        }
    }
    
    # overlay heatmap over source image
    if($parent->get_overlay()) {
        $input_file->copyMerge($output_file, 0, 0, 0, 0, $output_file->width, $output_file->height, $parent->get_opacity());
        undef $output_file;
        $output_file = $input_file;
    }
    
    # write to output file
    write_image($output_file, $parent->get_output_file());
    
    return 1;
}

sub write_image {
    my $image_file = shift;
    my $filename = shift;
    
    my $filetype;
    
    if(($filetype) = $filename =~ m/\.(png|gif|jpe?g|gd2?|wbmp)$/i) {
        $filetype = lc($filetype);
        if($filetype eq 'jpe' || $filetype eq 'jpeg') {
            $filetype = 'jpg';
        }
        
        my $image_data = $image_file->$filetype;
        open(PNGFILE, '>', $filename) or croak("Failed to write output image: $!");
        binmode PNGFILE;
        print PNGFILE $image_data;
        close(PNGFILE);
        return;
    }
    croak("Failed to detect a supported file extension in file '$filename'");
}

sub composite {
    my($source_image, $composite_image, $x, $y) = @_;
    
    # set aside space to cache colors
    my %cached_colors;
    
    # for each pixel from x to x+composite_width
    my $composite_x = $composite_image->width - 1;
    my $composite_y = $composite_image->height - 1;
    foreach my $x_offset (0..$composite_x) {
        foreach my $y_offset (0..$composite_y) {
            my $source_x = ($x + $x_offset);
            my $source_y = ($y + $y_offset);
            
            # skip negative coordinates
            if($source_x < 0 || $source_y < 0) { next; }
            
            # get colors to composite together
            my @source_color = $source_image->rgb( $source_image->getPixel($source_x, $source_y) );
            my @composite_color = $composite_image->rgb( $composite_image->getPixel($x_offset, $y_offset) );
            
            # multiply colors together, caching them within the same composite call
            my $cache_key = join(',', @source_color) . 'x' . join(',', @composite_color);
            my @multiplied;
            if(exists($cached_colors{$cache_key})) {
                @multiplied = @{ $cached_colors{$cache_key} };
            }