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

package PPresenter::Export::Handouts::IM_PostScript;

use strict;
use PPresenter::Export::Images::ImageMagick;
use PPresenter::Export::Handouts::PostScript;

use base qw(PPresenter::Export::Images::ImageMagick
            PPresenter::Export::Handouts::PostScript);

use Tk;
use Tk::Dialog;

use constant ObjDefaults =>
{ -name        => 'PostScript handouts with ImageMagick'
, -aliases     => [ 'IM Postscript', 'imps', 'im ps' ]

, -outputDir   => ($ENV{TMPDIR} || '/tmp')
, -imageFormat => 'eps'
, -outputFile  => 'show.ps'
, -orientation => 'Best fit'
, -paperUse    => '1'
};

my @paper_placers =
( [ '1'    , \&make1slide_pp,  'export_ps1.xbm'    ]
, [ '12'   , \&make2slides_pp, 'export_ps12.xbm'   ]
, [ '12 34', \&make4slides_pp, 'export_ps1234.xbm' ]
, [ '13 24', undef, 'export_ps1324.xbm' ]
);

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

    $popup->destroy;

    print PPresenter::TRACE
        "Exporting slides to PostScript via ImageMagick started.\n";

    my @outfiles = $export->mapExportedPhases
      ( $show
      , sub { my ($export, $show, $slide, $viewports) = @_;
              $export->makeSlide($show, $slide, $viewports);
            }
      );

    my $pages = $export->paperPlacer->($export, \@outfiles);
    $export->setColors($pages, $export->{-colorMode});
    $export->writePages($pages
      , $export->{-outputFile}
      , $export->{-density}
      );

    print PPresenter::TRACE "Exporting slides to PostScript ready.\n";

    $export;
}

sub setColors($$)
{   my ($export, $pages, $mode) = @_;
    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'
        )->grid(-columnspan => 2, -sticky => 'ew');
        $hint->Label(-text => <<HINT
Black on white is usually nicer, so you may consider
the use `-device=>printer' for all viewports.
HINT
        )->grid(-sticky=>'nwsw');
    }

    $popup->Popup(popover => 'cursor');
}

sub tkPostscript($$)
{   my ($export, $show, $popup) = @_;
    my $ps = $export->SUPER::tkPostscript($show, $popup);

    my $options = $ps->Frame;
    foreach (@paper_placers)
    {   my ($label, $function, $bitmap) = @$_;
        $options->Checkbutton
        ( -bitmap      => '@'. $show->findImageFile($bitmap)
        , -onvalue     => $label
        , -variable    => \$export->{-paperUse}
        , -indicatoron => 0
        )->pack(-side => 'left');
    }

    $ps->Label
    ( -text     => 'Packing'
    , -anchor   => 'w'
    )->grid($options, '-', -sticky => 'ew');

    $ps;
}

sub paperPlacer()
{   my $export = shift;
    my $name   = $export->{-paperUse};

    return $name if ref $name eq 'CODE';

    foreach (@paper_placers)
    {   my ($label, $function, $bitmap) = @$_;
        return $function if $label eq $name;
    }

    die "Unknown map function $name.\n";
}

1;