package ZooZ::Generic;
$ZooZ::Generic::VERSION = '1.9.1';
# this defines some generic functions that can be used by anyone.
use strict;
sub BindMouseWheel {
my ($top, $w) = @_;
if ($^O eq 'MSWin32') {
# not tested!!!
$top->bind('<MouseWheel>' =>
[ sub {
my $w2 = ref $w eq 'CODE' ? $w->() : $w;
$w2->yview('scroll', -($_[1] / 120) * 3, 'units') },
Tk::Ev('D') ]
);
} else {
$top->bind('<4>' => sub {
my $w2 = ref $w eq 'CODE' ? $w->() : $w;
$w2->yview('scroll', -3, 'units') unless $Tk::strictMotif;
});
$top->bind('<5>' => sub {
my $w2 = ref $w eq 'CODE' ? $w->() : $w;
$w2->yview('scroll', +3, 'units') unless $Tk::strictMotif;
});
}
}
########
#
# This method pops up a message for the user.
# The message is contained in a frame that drops down from the middle
# of the top border of the given window, stays there for a few secs, then
# goes back up .. animated .. sort of like the auto-hidden taskbar.
#
########
my @msgFrames;
my @msgLabels;
my (@msgX, @msgY, @stopY);
sub popMessage {
my %hash = @_;
my $over = delete $hash{-over} or return undef;
my $msg = delete $hash{-msg} or return undef;
my $msgDelay = delete $hash{-delay} || 3000; # 3 secs
# find first id.
my $id = 0;
$id++ while defined $msgX[$id];
unless ($msgFrames[$id]) {
my $top = $over->toplevel;
my $msgFrame = $top->Frame(qw/-bd 1 -relief solid/);
my $msgLabel = $msgFrame->Label(qw/-padx 20 -pady 20/,
%hash,
)->pack(qw/-fill both/);
$msgFrames[$id] = $msgFrame;
$msgLabels[$id] = $msgLabel;
}
$msgLabels[$id]->configure(%hash, -text => $msg);
$msgFrames[$id]->idletasks;
$msgFrames[$id]->raise;
_animateMsgDown($over, $id, $msgDelay);
}
sub _animateMsgDown {
my ($top, $id, $msgDelay) = @_;
unless (defined $msgX[$id]) {
$msgY [$id] = $msgFrames[$id]->reqheight * ($id-1);
$msgX [$id] = int 0.5 * ($top->width - $msgFrames[$id]->reqwidth);
$stopY[$id] = $msgY[$id] + $msgFrames[$id]->reqheight;
} else {
$msgY[$id]++;
}
$msgFrames[$id]->place(-x => $msgX[$id],
-y => $msgY[$id]);
if ($msgY[$id] == $stopY[$id]) {
$top->after($msgDelay => [\&_animateMsgUp, $top, $id]);
return;
}
$top->after(5 => [\&_animateMsgDown, $top, $id, $msgDelay]);
}
sub _animateMsgUp {
my ($top, $id) = @_;
$msgY[$id]--;
$msgFrames[$id]->place(-x => $msgX[$id],
-y => $msgY[$id]);
if ($msgY[$id] == -$msgFrames[$id]->height) {
$msgX[$id] = $msgY[$id] = undef;
$msgFrames[$id]->placeForget;
return;
}
$top->after(5 => [\&_animateMsgUp, $top, $id]);
}
#my $msgFrame;
#my $msgLabel;
#my ($msgX, $msgY, $msgDelay);
#my $msgMoving = 0;
#sub popMessage {
# return if $msgMoving;
# my ($over, $msg) = @_;
# $msgDelay = $_[2] || 3000; # 3 secs
# unless ($msgFrame) {
# $msgFrame = $::MW->Frame(qw/-bd 1 -relief solid/);
# $msgLabel = $msgFrame->Label(qw/-padx 20 -pady 20/,
# -bg => 'white',
# -font => 'Level',
# )->pack(qw/-fill both/);
# }
# $msgLabel->configure(-text => $msg);
# $msgFrame->update;
# $msgFrame->raise;
# $msgMoving = 1;
# animateMsgDown($over);
#}
#sub animateMsgDown {
# my $top = shift;
# unless (defined $msgX) {
# $msgY = -$msgFrame->reqheight;
# $msgX = int 0.5 * ($top->width - $msgFrame->reqwidth);
# } else {
# $msgY++;
# }
# $msgFrame->place(-x => $msgX,
# -y => $msgY);
# if ($msgY == 0) {
# $top->after($msgDelay => [\&animateMsgUp, $top]);
# return;
# }
# $top->after(5 => [\&animateMsgDown, $top]);
#}
#sub animateMsgUp {
# my $top = shift;
# $msgY--;
# $msgFrame->place(-x => $msgX,
# -y => $msgY);
# if ($msgY == -$msgFrame->height) {
# $msgX = $msgY = undef;
# $msgFrame->placeForget;
# $msgMoving = 0;
# return;
# }
# $top->after(5 => [\&animateMsgUp, $top]);
#}
##########################
#
# This method is used to animate the opening/closing
# of the different hierarchy views.
#
##########################
my $fadeFrame;
my $stepSize = 10;
sub animateOpen_old {
my ($top, $fx, $fy, $fw, $fh) = @_;
return unless $top->viewable;
unless ($fadeFrame) {
$fadeFrame = $top->Frame(qw/-bg white -relief solid -bd 1/);
print "Fade Frame is $fadeFrame.\n";
}
my $tw = $top->reqwidth;
my $th = $top->reqheight;
my $w = my $h = 0;
my $x = $fx;
my $y = $fy;
#$fadeFrame->raise;
while ($w < $tw || $h < $th) {
$fadeFrame->place(-x => $x,
-y => $y,
-width => $w,
-height => $h);
$_ += $stepSize for $w, $h;
$_ -= $stepSize / 2 for $x, $y;
$fadeFrame->raise;
$fadeFrame->update;
$top->after(1);
}
$fadeFrame->placeForget;
}
sub animateClose_old {
my ($top, $x, $y) = @_;
unless ($fadeFrame) {
$fadeFrame = $top->Frame(qw/-bg white/);
}
}
my $steps = 10;
sub animateOpen {
print "Got >>@_<<\n";
my ($c, $id) = @_;
my ($midX, $midY) = ($c->width / 2, $c->height / 2);
$id = 'ANIMATE';
unless ($c->find(withtag => $id)) {
$c->createWindow($midX, $midY,
-window => $c->Frame,
-width => 0,
-height => 0,
-tags => ['ANIMATE'],
);
}
$c->itemconfigure($id, -width => 10, -height => 10);
my @oldC = $c->coords($id);
my $dx = ($midX - $oldC[0]) / $steps;
my $dy = ($midY - $oldC[1]) / $steps;
my @cur = @oldC;
$c->itemconfigure($id, -state => 'normal');
# for my $i (1 .. $steps) {
# $cur[0] += $dx;
# $cur[1] += $dy;
# $c->coords($id, @cur);
# $c->update;
# $c->after(10);
# }
my @box = $c->bbox($id);
my $w = $box[2] - $box[0];
my $h = $box[3] - $box[1];
$dx = ($c->width - $w) / $steps;
$dy = ($c->height - $h) / $steps;
for my $i (1 .. $steps) {
$w += $dx;
$h += $dy;
$c->itemconfigure($id, -width => $w, -height => $h);
$c->update;
$c->after(80);
}
#$c->coords($id, @oldC);
#$c->itemconfigure($id, -width => 0, -height => 0);
$c->itemconfigure($id, -state => 'hidden');
}
sub lineUpCommas {
my $len = (sort {$b <=> $a} map length $_->[0] => @_)[0];
return join "\n" => map {sprintf " %-$ {len}s => %s," => @$_} @_;
}
'the truth';
__END__
=pod
=encoding UTF-8
=head1 NAME
ZooZ::Generic
=head1 VERSION
version 1.9.1
=head1 AUTHOR
Ala Qumsieh, faraco <skelic3@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2004-2005, 2018 by Ala Qumsieh, faraco.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut