view release on metacpan or  search on metacpan

PPresenter/Export/Handouts/IM_PostScript.pm  view on Meta::CPAN

    return $pages->Quantize(colorspace => 'Gray') if $mode eq 'gray';
    return $pages->Quantize(colors     => 2)      if $mode eq 'mono';
}

sub writePages($$$)
{   my ($export, $pages, $file, $density) = @_;

    $pages->Set(density => $density);
    my $error = $pages->Write($file);
    return unless $error;

    $export->{popup}->Dialog
    ( -text    => "Cannot write result to $file:\n$error"
    , -bitmap  => 'error'
    , -title   => 'Write error'
    , -buttons => [ 'Bummer!' ]
    )->Show;
}

sub fitToPaper($$$)
{   my ($export, $img, $pwidth, $pheight) = @_;
    my ($width, $height) = $img->Get('width', 'height');
    my $orientation = $export->{-orientation};

    $orientation = $export->bestOrientation($pwidth, $pheight, $width, $height)
        if $orientation eq 'Best fit';

    $img->Rotate(degrees => -90.0) if $orientation eq 'Landscape';
    $img->Set(quality => 100);
    $img->Zoom(geometry => "${pwidth}x${pheight}", blur => 0.5);
}

sub bestOrientation($$$$)
{   my ($export, $pw, $ph, $iw, $ih) = @_;

    $export->zoomToFit($pw,$ph, $iw,$ih) < $export->zoomToFit($pw,$ph, $ih,$iw)
    ? 'Landscape' : 'Portrait';
}

sub zoomToFit($$$$)
{   my ($export, $pw, $ph, $iw, $ih) = @_;
    my ($scale_x, $scale_y) = ($pw/$iw, $ph/$ih);
    $scale_x < $scale_y ? $scale_x : $scale_y;
}

sub read_image($$$$)
{   my ($export, $list, $file, $width, $height) = @_;
    return unless defined $file;

    my $error = $list->Read($file);
    die "Cannot read image from file $file: $error.\n" if $error;
    unlink $file;

    $export->fitToPaper($list->[-1], $width, $height);
}

sub make1slide_pp($$)
{   my ($export, $files) = @_;
    my ($width, $height) = $export->paperSizePixels;

    my $all_images = Image::Magick->new;

    foreach (@$files)
    {   $export->read_image($all_images, $_, $width, $height);
        $all_images->Set(page => "${width}x${height}");
    }

    $all_images;
}

sub make2slides_pp($$)
{   my ($export, $files) = @_;
    my ($width, $height) = $export->paperSizePixels;

    my $all_images = Image::Magick->new;

    while(@$files)
    {   my $part  = Image::Magick->new;
        $export->read_image($part, shift @$files, $width, $height/2);
        $export->read_image($part, shift @$files, $width, $height/2);
        push @$all_images, (@$part > 1 ? $part->Append : pop @$part);
    }

    $all_images;
}

sub make4slides_pp($$)
{   my ($export, $files) = @_;
    my ($width, $height) = $export->paperSizePixels;
    $width /= 2; $height /= 2;

    my $all_images = Image::Magick->new;

    while(@$files)
    {   my $page = Image::Magick->new;
        my $part1 = Image::Magick->new;
        $export->read_image($part1, shift @$files, $width, $height);
        $export->read_image($part1, shift @$files, $width, $height);
        push @$page, $part1->Append(-stack => 0);
        my $part2 = Image::Magick->new;
        $export->read_image($part2, shift @$files, $width, $height);
        $export->read_image($part2, shift @$files, $width, $height);
        push @$page, $part2->Append(-stack => 0);
        push @$all_images, $page->Append(-stack => 1);
    }

    $all_images;
}

#
# The user interface to this module.
#

sub popup($$)
{   my ($export, $show, $screen) = @_;

    my $popup = MainWindow->new(-screen => $screen
    , -title => 'Export slides with Postscript via ImageMagick'
    );
    $popup->withdraw;

    my $vp = $export->tkViewportSettings($show, $popup);
    my $ps = $export->tkPostscript($show, $popup);

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

    $options->Label
    ( -text     => 'output file'
    , -anchor   => 'e'
    )->grid($options->Entry(-textvariable => \$export->{-outputFile})
           , -sticky => 'ew');

    my $commands = $popup->Frame;
    $commands->Button
    ( -text      => 'Export'
    , -relief    => 'ridge'
    , -command   => sub {$export->exportPostscript($show, $popup)}
    )->grid($commands->Button
       ( -text      => 'Cancel'
       , -relief    => 'sunken'
       , -command   => sub {$popup->withdraw}
       )
    , -padx => 10, -pady => 10
    );

    if(defined $vp)
    {   $vp->grid($ps, -sticky => 'ewns');
        $options->grid('^', -sticky => 'ew');
    }
    else {$options->grid($ps, -sticky => 'ew')}
    $commands->grid(-columnspan => 2, -sticky => 'ew');

    if(grep {$_->device ne 'printer'} $show->viewports)
    {   my $hint = $popup->LabFrame
        ( -label     => 'Hint'
        , -labelside => 'acrosstop'