view release on metacpan or  search on metacpan

PPresenter/Export/Images/ImageMagick.pm  view on Meta::CPAN

# Copyright (C) 2000-2002, Free Software Foundation FSF.

package PPresenter::Export::Images::ImageMagick;

# This module has it's own Tk interface, but is also extended
# by more complex objects.

use strict;
use PPresenter::Export;
use base 'PPresenter::Export';

use Tk;
use Tk::Dialog;
use Image::Magick;

use constant ObjDefaults =>
{ -name        => 'Images with ImageMagick'
, -aliases     => [ 'images', 'im images', 'IM images', 'IM Images' ]

, -outputDir   => 'slideImages'
};

sub view2image($$$)
{   my ($export, $show, $slide, $view) = @_;

    print PPresenter::TRACE "Dumping image for $view.\n";

    my $image = $export->windowImage($show, $slide, $view);
    return unless defined $image;

    $export->polishImage($image);
    $image;
}

sub readImage($)
{   my ($export, $file) = @_;

    my $img   = Image::Magick->new;
    my $error = $img->Read($file);
    return $img unless $error;

    print "Magick error on reading image from $file: $error\n";
    undef;
}

sub polishImage($)
{   my ($export, $img) =@_;

    $img->Zoom(geometry => "$export->{-imageWidth}x10000")
        if defined $export->{-imageWidth} && $export->{-imageWidth} != 0;

    my $format = lc $export->{-imageFormat};

    $img->Set( magick    => $format
             , quality   => $export->{-imageQuality}
             , interlace => ($format eq 'png' ? 'Plane' : 'Line')
             );

    $export;
}

sub writeImage($$)
{   my ($export, $image, $file) = @_;

    $image->Set(filename => $file);
    my $error = $image->Write;
    warn "Couldn't write image: $error.\n" if $error;
    $export;
}

sub getDimensions($)
{   my ($export, $image) = @_;
    $image->Get('width', 'height');
}

#
# The user interface to this module.
#

sub popup($$)
{   my ($export, $show, $screen) = @_;
    return $export->{popup}
        if exists $export->{popup};

    $export->{popup} = my $popup = MainWindow->new(-screen => $screen
    , -title => 'Export images'
    );
    $popup->withdraw;

    my $vp = $export->tkViewportSettings($show, $popup);
    my $im = $export->tkImageSettings($show, $popup);

    my $options = $popup->Frame;
    $options->Label
    ( -text     => 'export'
    , -anchor   => 'e'
    )->grid($export->tkSlideSelector($popup), -sticky => 'ew');