use strict;
use FindBin;
use lib "$FindBin::Bin";
use Tk;
use Tk::HList;
use Tk::JPEG;
use Tk::DragDrop;
use Tk::DropSite;
use Tk::Photo;
use Tk::ItemStyle;
############
# globals
my ($mw);
my $hlRes;
my $hlDocRout;
my $hlDocType;
my $dnd_token;
my @ImgArr;
my $TextOver;
DoMain();
=pod
layout
=cut
sub DoMain {
# main window
$mw = MainWindow->new;
$mw->title("Work Flow Routing");
#$mw->configure(-width => 1200, height => 600);
# toolbar TODO add frame and left justify
$mw->Button(-text => "info", -command => \&Info)->pack(-side => "top",
-anchor => "w");
# Doc type list
$hlDocType = $mw->Scrolled("HList",
-itemtype => 'text',
-selectmode => 'browse',
-height => 50,
-width => 20,
-scrollbars => 'osoe',
)->pack(-side => 'left', -expand => 1, -fill => 'both');
# load document types
my @DocTypes = qw(PurchaseOrder CustomerOrder);
for my $t (@DocTypes) {
my $e=$hlDocType->addchild("");
$hlDocType->itemCreate($e, 0,
-itemtype => "text",
-text => $t,
);
}
# picture routing and resource lists
$hlDocRout = $mw->Scrolled("HList",
-itemtype => 'image',
-selectmode => 'browse',
-browsecmd => \&OnClick,
-height => 50,
-width => 20,
-scrollbars => 'osoe',
)->pack(-side => 'left', -expand => 1, -fill => 'both');
$hlRes = $mw->Scrolled("HList",
-itemtype => 'image',
-selectmode => 'browse',
-browsecmd => \&OnClick,
-height => 50,
-width => 20,
-scrollbars => 'osoe',
)->pack(-side => 'right', -expand => 1, -fill => 'both');
$TextOver=$hlRes->ItemStyle("imagetext", -textanchor => "n");
# drag and drop stuff
$dnd_token = $hlRes->DragDrop
(-event => '<B1-Motion>',
-sitetypes => ['Local'],
-startcommand => sub { StartDrag($dnd_token) },
);
$hlDocRout->DropSite
(-droptypes => ['Local'],
-dropcommand => [ \&Drop, $hlDocRout, $dnd_token ],
);
$hlDocRout->bind("<Delete>", \&Delete);
# load data for resource list
my $i=0;
for my $fn (glob ("*.jpg")) {
my $SrcImg=$mw->Photo(-file => $fn);
my $DstImg=$mw->Photo();
my $w=$SrcImg->width();
my $h=$SrcImg->height();
my $f=int($h/75);
$DstImg->copy($SrcImg, -subsample => ($f, $f)); # rescales image to one size
$i++;
push @ImgArr, $DstImg;
print "$i:$fn:$w $h\n";
$SrcImg->delete();
my $e=$hlRes->addchild("", -data => $fn,);
$hlRes->itemCreate($e, 0,
-itemtype => "imagetext",
-image => $DstImg,
-text => $fn,
-style => $TextOver,
);
}
MainLoop;
}
sub StartDrag {
my($token) = @_;
my $w = $token->parent; # $w is the source listbox
my $e = $w->XEvent;
my $idx = $w->nearest($e->y); # get the listbox entry under cursor
#print "y:", $e->y, "\n";
if (defined $idx) {
# Configure the dnd token to show the listbox entry
my $opt=$token->configure();
$token->configure(-image => $ImgArr[$idx]);
$token->configure(-text => $w->info("data", $
idx));
# Show the token
my($X, $Y) = ($e->X, $e->Y);
$token->MoveToplevelWindow
($X, $Y);
$token->raise;
$token->deiconify;
$token->FindSite($X, $Y, $e);
#print "$token\n";
}
}
# Accept a drop and insert a new item in the destination listbox.
sub Drop {
my($hlist, $dndtoken) = @_;
# token info
my $img = $dndtoken->cget(-image);
my $text = $dndtoken->cget(-text);
#print "image:$img\n";
#my @list=$hlist->info("children");
# get position to insert or append at
my $end = ($hlist->info("children"))[-1];
my @pos = (-after => $end) if defined $end;
my $y = $hlist->pointery - $hlist->rooty;
my $nearest = $hlist->nearest($y);
if (defined $nearest) {
my(@bbox) = $hlist->infoBbox($nearest);
if ($y > ($bbox[3]-$bbox[1])/2+$bbox[1]) {
@pos = (-after => $nearest);
} else {
@pos = (-before => $nearest);
}
}
# add the line
my $fn="";
my $e=$hlist->addchild("", @pos, -data => $fn);
$hlist->itemCreate($e, 0,
-itemtype => "imagetext",
-image => $img,
-text => $text,
-style => $TextOver,
);
$hlist->see($e);
}
sub Delete {
my ($w) = @_;
my @sl=$hlDocRout->info("selection");
print "got delete: $w, selected: @sl\n";
$hlDocRout->delete("entry", @sl) if ($#sl >= 0);
}
sub OnClick {
my $entry=shift;
my $data=$hlRes->info("data", $entry);
my $val=$hlRes->entrycget($entry, "-image");
my $d=$hlRes->entrycget($entry, "-data");
my @l=$hlRes->info("children");
my $i=$entry-1;
my $h=$ImgArr[$i]->height();
my $t=$ImgArr[$i]->type();
my $f=$ImgArr[$i]->cget("-file");
#my $d=$ImgArr[$i]->cget("-data");
=pod
print "$entry:$data\n";
print "image:$val\n";
print "height:$h\n";
print "type:$t\n";
#print "size:$#l\n";
#print "filename:$f\n";
print "data:$d\n";
my @opt=$hlRes->entryconfigure($entry);
$#opt;
=cut
=pod
for my $a (@opt) {
print "$a\n";
print "@$a\n";
#for $b (@$a) {
# my $val=$hlRes->entryconfigure($entry, $b);
# print "$b:$val\n";
#}
}
=cut
}
sub Info {
my @il=$mw->imageNames;
for my $a (@il) {
my $h=$a->height;
my $type=$a->type;
print "$a:$h:$type\n";
}