If you want to roll your own, you can use this, which simulates
a browser.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Pane;
use Tk::JPEG;
use Tk::PNG;
use Tk::HList;
use Tk::ItemStyle;
use Imager;
use File::Basename;
use MIME::Base64;
my $photo;#my $photo;
my $image;
my $h; #my HList;
my %info;
my $key_sel;
my $mw = MainWindow->new(-bg=>'black');
$mw->geometry('800x700+100+15');
$mw->bind('<Control-c>', [sub{&save_it(); Tk::exit;}] );
my $topframe = $mw->Frame(-height =>30, -background=>'black')
->pack(-fill=>'both', -expand=>1);
$topframe->Button(-text => "Exit",
-activebackground =>'snow',
-padx=>40,
-relief=>'raised',
-command => sub { exit; })->pack();
my $leftframe = $mw->Frame( -width =>25,
-background=>'black',
)->pack(-side => "left", -anchor => "n",
-fill=>'both', -expand=>1);
my $mainframe = $mw->Frame(-background=>'black')
->pack(-side => "right", -anchor => "n",
-fill=>'both', -expand=>1);
#default empty image
$image = $mw->Photo(-file => '' ) or die $!;
#fill leftframe with thumbnails
HList2();
#fill mainframe with default screen
setup_pane();
$mw->waitVisibility;
load_thumbs();
MainLoop;
######################################################################
+###
sub HList2 {
$h = $leftframe->Scrolled( 'HList',
-header => 1,
-columns => 2,
-width => 20,
-height => 60,
-takefocus => 1,
-background => 'steelblue',
-foreground =>'snow',
-selectmode => 'single',
-selectforeground => 'pink',
-selectbackground => 'black',
-browsecmd => \&browseThis,
)->pack(-side => "left", -anchor => "n");
$h->header('create', 0, -text => ' THUMBNAIL ',
-borderwidth => 3,
-headerbackground => 'steelblue',
-relief => 'raised');
$h->header('create', 1, -text => ' ID ',
-borderwidth => 3,
-headerbackground => 'lightsteelblue',
-relief => 'raised');
my $font = '-Adobe-Courier-Bold-O-Normal--*-120-*-*-*-*-*-*';
}
#############################################################
sub setup_pane{
my $pane = $mainframe->Scrolled('Pane', Name => 'Main Display',
-width => 1000,
-height =>1000,
-background => 'black',
-scrollbars => 'osoe',
-sticky => 'n',
)->pack(-side => "left", -anchor => "n",
-fill=>'both',-expand=>1);
$photo = $pane->Label(-image => $image,
-background =>'black'
)->pack(-side => 'top',
-anchor => 'n',
-fill => 'both',
-expand => 1,
);
}
##############################################################
sub browseThis {
my $ent = shift;
$key_sel = $h->itemCget($ent, 1, '-text');
my $pic = $info{$key_sel}{'pic'} || '';
my $image = $mw->Photo(-file => "$pic");
$photo->configure(-image => $image );
$image->blank;
$image->read($pic);
}
############################################################
sub load_thumbs{
my @exts = qw(.jpg .png .gif); # list allowed extensions
my @pics = <*.jpg *.gif *.png>;
my $image = Imager->new();
foreach my $pic (@pics){
my ($basename,$path,$suffix) = fileparse($pic,@exts);
$info{$basename}{'name'} = $basename;
$info{$basename}{'pic'} = $basename.$suffix;
$info{$basename}{'comment'} = 'nice';
$image->open(file=>$pic) or die $image->errstr();
# Create smaller version
my $thumb = $image->scale(xpixels=>100);
$thumb->write( data => \$info{$basename}{'thumbnail'},
type => 'jpeg',
jpegquality => 30) or die $thumb->errstr;
&add_key( $basename );
$mw->update;
}
}
###################################################################
sub add_key{
my($key,$color) = @_;
#color is for the IDcolor, defaults to lightsteelblue
if(! defined $info{$key}{'color'}){ $info{$key}{'color'} = 'lightsteel
+blue'};
my $textstyle = $h->ItemStyle('text', -justify => 'center',
-bg => $info{$key}{'color'},
-selectforeground => 'green',
);
my $e = $h->addchild("", -data => $info{$key}{'pic'});
#Tk needs data images base64 encoded
my $content = encode_base64( $info{$key}{'thumbnail'} );
my $image = $mw->Photo(-data => $content );
$h->itemCreate ($e, 0,
-itemtype => 'imagetext',
-image => $image,
-text => $info{$key}{'comment'},
);
$h->itemCreate($e, 1,
-itemtype => 'text',
-style => $textstyle,
-text => $info{$key}{'name'},
);
if($e == 0){
#select first entry
$h->selectionSet(0);
browseThis(0);
}
}
#############################################################
I'm not really a human, but I play one on earth.
flash japh
|