Anonymous user
Window management: Difference between revisions
Added Perl translation of Tcl implementation.
m (Omit from Logtalk) |
(Added Perl translation of Tcl implementation.) |
||
Line 330:
in
{Record.forAll Windows CreateWindow}</lang>
=={{header|Perl}}==
This is a translation of the Tcl solution for this task.
The preferred way of using Tk with perl is through the (relatively modern) Tkx module, not the (quite old) Tk module (also known as perl/tk), which my code uses.
I wrote the code using the Tk module, as that's what I had on my computer, and I was too lazy to install Tkx. Translating from perl/tk to Tkx should be fairly trivial.
<lang Perl>#!perl
use strict;
use warnings;
use Tk;
my $mw;
my $win;
my $lab;
# How to open a window.
sub openWin {
if( $win ) {
$win->deiconify;
$win->wm('state', 'normal');
} else {
eval { $win->destroy } if $win;
$win = $mw->Toplevel;
$win->Label(-text => "This is the window being manipulated")
->pack(-fill => 'both', -expand => 1);
$lab->configure(-text => "The window object is:\n$win");
}
}
# How to close a window
sub closeWin {
return unless $win;
$win->destroy;
$lab->configure(-text => '');
undef $win;
}
# How to minimize a window
sub minimizeWin {
return unless $win;
$win->iconify;
}
# How to maximize a window
sub maximizeWin {
return unless $win;
$win->wm('state', 'zoomed');
eval { $win->wmAttribute(-zoomed => 1) }; # Hack for X11
}
# How to move a window
sub moveWin {
return unless $win;
my ($x, $y) = $win->geometry() =~ /\+(\d+)\+(\d+)\z/ or die;
$_ += 10 for $x, $y;
$win->geometry("+$x+$y");
}
# How to resize a window
sub resizeWin {
return unless $win;
my ($w, $h) = $win->geometry() =~ /^(\d+)x(\d+)/ or die;
$_ += 10 for $w, $h;
$win->geometry($w . "x" . $h);
}
$mw = MainWindow->new;
for my $label0 ($mw->Label(-text => 'Window handle:')) {
$lab = $mw->Label(-text => '');
$label0->grid($lab);
}
my @binit = ('Open/Restore' => \&openWin, Close => \&closeWin,
Minimize => \&minimizeWin, Maximize => \&maximizeWin,
Move => \&moveWin, Resize => \&resizeWin);
while( my ($text, $callback) = splice @binit, 0, 2 ) {
$mw->Button(-text => $text, -command => $callback)->grid('-');
}
MainLoop();
__END__
</lang>
In the Tcl code I translated from, the second label of the main window had a textvariable attribute. For some reason, this didn't work correctly for me, either due to a bug in Tk.pm, or some other reason. Because of that, I kept around a handle to that second label ($lab), and called configure on it when I needed it's text to change.
Doubtless some more modern Tk binding (such as Tkx, or perhaps Tcl::Tk) would handle that better.
=={{header|PicoLisp}}==
| |||