NAME

Tk::AppWindow::CookBook - Some recipies

OTHER RECIPIES

Tk::AppWindow::CookBook::Extension

Tk::AppWindow::CookBook::Plugin

Tk::AppWindow::CookBook::ContentManager

A SIMPLE IMAGE VIEWER

#!/usr/bin/perl

use strict;
use warnings;


################################################################
# First define the content manager. a content manager handles  #
# the basic tasks like loading, saving, displaying and         #
# modifying files. The content manager does the actual work.   #
################################################################
package ImageManager;

use base qw(Tk::Derived Tk::AppWindow::BaseClasses::ContentManager);
Construct Tk::Widget 'ImageManager';
require Tk::Pane;
require Tk::Photo;
use Tk::PNG;
use File::Basename;
use MIME::Base64;
use Imager;

#Determining which image types we can use;
my %photoext = ();
my @types = keys %Imager::formats;
for (@types) {
   $photoext{'.jpg'} = 1 if $_ eq 'jpeg';
   $photoext{".$_"} = 1;
}

sub Populate {
   my ($self, $args) = @_;
   
   $self->SUPER::Populate($args);
   #We create a scrolled pane as main viewer. 
   #In it we pack a label with the image.
   my $pn = $self->Scrolled('Pane',
      -scrollbars => 'osoe',
   )->pack(-expand => 1, -fill => 'both');
   $self->CWidg($pn);
   $self->{FILE} = '';
   $self->{IMAGE} = undef;
   $self->ConfigSpecs(
      -zoomto => ['PASSIVE', undef, undef, 'fit'],
      DEFAULT => [$pn],
   );
}

#overwritten method
sub doClear {
   my $self = shift;
   $self->{FILE} = '';
   $self->ViewerClear;
   $self->{IMAGE} = undef;
}

#overwritten method
sub doLoad {
   my ($self, $file) = @_;
   $self->{FILE} = $file;
   if (-e $file) {
      my ($name,$path,$suffix) = fileparse(lc($file), keys %photoext);
      if (exists $photoext{lc($suffix)}) {
         my $img = Imager->new;
         $img->read(file=>$file) or warn "Cannot read: ", $img->errstr;
         $self->{IMAGE} = $img if defined $img;
      } else {
         warn "Not an image $file"
      }
   } else {
      warn "$file does not exist";
   }
   $self->after(100, ['ZoomDefault', $self]);
   return 1
}

sub ZoomDefault {
   my $self = shift;
   my $scale = $self->cget('-zoomto');
   if ($scale eq 'fit') {
      $self->ZoomToFit
   } else {
      $self->Zoom($scale)
   }
}

sub Zoom {
   my ($self, $perc) = @_;
   return $self->ZoomToFit if $perc eq 'fit';
   my $scale = $perc / 100;
   my $img = $self->{IMAGE};
   if (defined $img) {
      my $width = int($img->getwidth * $scale);
      my $height = int($img->getheight * $scale);
      my $new = $img->scale(xpixels => $width, ypixels => $height);
      $self->ViewerClear;
      my $data;
      $new->write(data => \$data, type => 'png');
      my $l = $self->CWidg->Label(
         -image => $self->Photo(
            -data => encode_base64($data), 
            -format => 'png',
         ),
      )->pack;
      $self->{LABEL} = $l;
   }
}

sub ZoomToFit {
   my $self = shift;
   my $img = $self->{IMAGE};
   if (defined $img) {
      my $pane = $self->CWidg;
      my $x = $pane->width - 4;
      my $y = $pane->height - 4;
      my $width = $img->getwidth;
      my $height = $img->getheight;
      my $scale;
      my $xs = $x / $width;
      my $ys = $y / $height;
      if ($xs > $ys) {
         $scale = $ys
      } else {
         $scale = $xs
      }
      $self->Zoom($scale * 100);
   }
}

sub ViewerClear {
   my $self = shift;
   my $i = $self->{LABEL};
   $i->destroy if defined $i;
   $self->{LABEL} = undef;
   $self->update;
}

################################################################
# Now that we have a content manager ...                       #
# We can define the main package                               #
################################################################

package main;

require Tk::AppWindow;

my @scales = (400, 200, 100, 50, 25, 10);

my $iv;
$iv = Tk::AppWindow->new(
   -appname => 'Siv',
   -contentmanagerclass => 'ImageManager',
   -contentmanageroptions => ['-scaleto'],
   -extensions => [qw[Art Balloon MDI ToolBar StatusBar MenuBar Navigator Settings]],
   -readonly => 1,
   -mainmenuitems => [
      [   'menu',             'View',         "~Zoom"    ], 
      [   'menu_normal',      'Zoom::',      "~Fit",         'scaletofit',            'transform-scale' ], 
      [   'menu_normal',      'Zoom::',      "400",         'scaleto400',            'transform-scale' ], 
      [   'menu_normal',      'Zoom::',      "200",         'scaleto200',            'transform-scale' ], 
      [   'menu_normal',      'Zoom::',      "100",         'scaleto100',            'transform-scale' ], 
      [   'menu_normal',      'Zoom::',      "50",         'scaleto50',            'transform-scale' ], 
      [   'menu_normal',      'Zoom::',      "25",         'scaleto25',            'transform-scale' ], 
      [   'menu_normal',      'Zoom::',      "10",         'scaleto10',            'transform-scale' ], 
   ],
   -useroptions => [
      '*page' => 'Bars',
       '*section' => 'Menubar',
       -menuiconsize => ['list', 'Icon size', -values => sub { return $iv->cmdExecute('available_icon_sizes') }],
       '*end',
      '*section' => 'Toolbar',
      -toolbarvisible => ['boolean', 'Visible at launch'],
       -tooliconsize => ['list', 'Icon size', -values => sub { return $iv->cmdExecute('available_icon_sizes') }],
      -tooltextposition => ['radio', 'Text position', -values => [qw[none left right top bottom]]],
      '*end',
      '*section' => 'Statusbar',
      -statusbarvisible => ['boolean', 'Visible at launch'],
      '*end',
   ],
);

$iv->cmdConfig('scaletofit' => [\&Zoom, 'fit']);
for (@scales) {
   my $scale = $_;
   $iv->cmdConfig("scaleto$scale" => [\&Zoom, $scale])
}

$iv->MainLoop;

sub Zoom {
   my $perc = shift;
   my $mdi = $iv->extGet('MDI');
   my $sel = $mdi->docSelected;
   if (defined $sel) {
      my $doc = $mdi->docGet($sel);
      $doc->Zoom($perc);
   }
}

AUTHOR

Hans Jeuken (hanje at cpan dot org)

SEE ALSO

Tk::AppWindow

Tk::AppWindow::BaseClasses::Extension

Tk::AppWindow::BaseClasses::SidePanel

Tk::AppWindow::Ext::Panels