view release on metacpan or  search on metacpan

PPresenter/Export.pm  view on Meta::CPAN

{   my ($export, $show, $slide, $view) = @_;
    my $tmp      = ($ENV{TMPDIR} || '/tmp')."/gpp$$-$imgs_read.xwd";

    my $borders  = $export->{-includeBorders};
    my $viewport = $view->viewport;
    my $display  = $viewport->display;
    my $window   = $borders ? $viewport->screenId : $viewport->canvasId;

    my $cmd   = "xwd >$tmp -display $display -id $window -silent";
    $cmd     .= " -nobdrs" unless $borders;

    system($cmd)==0 or die "Cannot start $cmd.\n";

    my $image = $export->readImage($tmp);
    unlink $tmp;
    $imgs_read++;
    $picture_taken = $image;
}

sub readImage($)             # You shall override this.
{   my ($export, $file) = @_;
    die "You shall implement readImage for file $file";
}

sub polishImage($)           # You may override this.
{   my ($export, $img) = @_;
    $img;
}

sub tkImageSettings($$)
{   my ($export, $show, $parent) = @_;

    my $im = $parent->LabFrame
    ( -label     => 'images'
    , -labelside => 'acrosstop'
    );

    $im->Label
    ( -text     => 'Format'
    , -anchor   => 'e'
    )->grid($im->Entry(-textvariable => \$export->{-imageFormat})
           , -sticky => 'ew');

    $im->Label
    ( -text     => 'Width'
    , -anchor   => 'e'
    )->grid($im->Entry(-textvariable => \$export->{-imageWidth})
           , -sticky => 'ew');

    $im->Label
    ( -text     => 'Quality'
    , -anchor   => 'e'
    )->grid($im->Entry(-textvariable => \$export->{-imageQuality})
           , -sticky => 'ew');

    $im->Checkbutton
    ( -text     => 'Show window borders'
    , -relief   => 'flat'
    , -anchor   => 'w'
    , -variable => \$export->{-includeBorders}
    )->grid(-columnspan => 2, -sticky => 'ew');

    $im;
}

sub tkViewportSettings($$)
{   my ($export, $show, $parent) = @_;
    my @viewports = $show->viewports;

    if(@viewports==1)
    {   $export->{vp}{"$viewports[0]"} = 1;
        return undef;
    }

    my $vp = $parent->LabFrame
    ( -label     => 'viewports'
    , -labelside => 'acrosstop'
    );

    foreach (@viewports)
    {   my ($notes, $name) = ($_->showSlideNotes, "$_");
        $export->{vp}{$name} =
              ref $export->{-viewports} eq 'ARRAY'
            ? grep {$name eq $_} @{$export->{-viewports}}
            : $export->{-viewports} eq 'ALL'    ? 1
            : $export->{-viewports} eq 'SLIDES' ? ! $_->showSlideNotes
            : $export->{-viewports} eq 'NOTES'  ? $_->showSlideNotes
            : $export->{-viewports} eq $name;     # single name specified.

        $vp->Checkbutton
        ( -text     => ($notes ? "$name (notes)" : $name)
        , -relief   => 'flat'
        , -anchor   => 'w'
        , -variable => \$export->{vp}{$name}
        )->grid(-sticky => 'nsew');
    }

    $vp;
}

sub selectedViewports()
{   my $export = shift;
    map {$export->{vp}{$_} ? ("$_") : ()}
        keys %{$export->{vp}};
}

sub tkSlideSelector($)
{   my ($export, $parent) = @_;

    $parent->Optionmenu
    ( -options  => [ 'selected slides', 'current slide', 'all slides' ]
    , -command  => sub { $export->setSelectedSlide(shift) }
    );
}

sub setSelectedSlide($)
{   my ($export, $option) = @_;
    $export->{-exportSlide} = $option eq 'current slide'   ? 'CURRENT'
                            : $option eq 'selected slides' ? 'ACTIVE'
                            : $option eq 'all slides'      ? 'ALL'
      : die "Unknown export option `$option'.\n";