#!/usr/bin/perl use strict; use warnings; use Tk; use Tk::PNG; use Tk::JPEG; use Tk::Text; use Tk::NoteBook; use Tk::Pane; use Image::Size; use Data::Dumper; my $mw = MainWindow->new(); my $menu = $mw->Menu(-type => 'menubar'); createMenu($menu); $mw->configure(-menu => $menu); $mw->bind('', sub{openFile()}); $mw->bind('', sub{saveDumpe()}); $mw->bind('', sub{exit}); my $nb = $mw->NoteBook()->pack(); my $nb_image = $nb->add('img', -label => 'Image'); my $nb_text = $nb->add('dmp', -label => 'Dump'); my $txt_field = $nb_text->Scrolled('Text', -scrollbars => 'se')->pack(-expand => 1, -fill => 'both'); my $pane = $nb_image->Scrolled('Pane', -scrollbars => 'se')->pack(-expand => 1, -fill => 'both'); my $label = $pane->Label()->pack(-expand => 1, -fill => 'both'); #my $label = $nb_image->Scrolled('Canvas',-scrollregion => [0,0,0,0], -scrollbars => 'se')->pack(-expand => 1, -fill => 'both'); MainLoop; #------------------------------------------------------------------------------# # Subroutines # #------------------------------------------------------------------------------# sub createMenu{ my $menufont = '{Arial} 8 {normal}'; $menu->cascade(-label => 'File', -underline => 0, -font => $menufont, ); my $menu_app = $menu->Menu(-tearoff => 0); $menu_app->command(-label => "open...", -command => [\&openFile], -accelerator => 'Ctrl-O', ); $menu_app->command(-label => 'save dump...', -command => [\&saveDump], -accelerator => 'Ctrl-S', ); $menu_app->command(-label => 'close', -command => sub{exit;}, -accelerator => 'Ctrl-Q', ); $menu->entryconfigure('File', -menu => $menu_app); }# createMenu sub openFile{ my @filetypes = (['All Images', ['.GIF','.XBM','.XPM','.BMP','.JPEG','.JPG','.PNG','.PPM','.PGM']], ['GIF Images', '.GIF'], ['XBM Images', '.XBM'], ['XPM Images', '.XPM'], ['BMP Images', '.BMP'], ['JPG Images', ['.JPEG','.JPG']], ['PNG Images', '.PNG'], ['PPM/PGM Images', ['.PPM','.PGM']],); my $file = $mw->getOpenFile(-filetypes => \@filetypes); return unless $file; my $photo = $mw->Photo(-file => $file); =pod my ($x_size, $y_size) = imgsize($file); $label->configure(-scrollregion => [0,0,$x_size,$y_size]); my $test = $label->cget(-scrollregion); print Dumper($test); $label->delete('all'); $label->createImage($x_size,-$y_size,-image => $photo); =cut $label->configure(-image => $photo); my ($suffix) = $file =~ /\.(.*?)$/; $suffix = 'JPEG' if($suffix eq 'jpg' or $suffix eq 'JPG'); my $string = $photo->data(-format => $suffix); $txt_field->delete('0.0','end'); $txt_field->Insert($string); }# openFile sub saveDump{ my $file = $mw->getSaveFile(); return unless $file; if(open(my $fh,">$file")){ print $fh $txt_field->get('0.0','end'); close $fh; } }# saveDump