diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/Tiler.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Tk/Tiler.pm | 203 |
1 files changed, 203 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/Tiler.pm b/Master/tlpkg/tlperl/lib/Tk/Tiler.pm new file mode 100755 index 00000000000..1256612f801 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Tk/Tiler.pm @@ -0,0 +1,203 @@ +# Copyright (c) 1995-2004 Nick Ing-Simmons. All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# An example of a geometry manager "widget" in perl +package Tk::Tiler; +require Tk; +require Tk::Frame; + +use vars qw($VERSION); +$VERSION = sprintf '4.%03d', q$Revision: #12 $ =~ /\D(\d+)\s*$/; + +use base qw(Tk::Frame); + +Construct Tk::Widget 'Tiler'; +sub Tk::Widget::ScrlTiler { shift->Scrolled('Tiler' => @_) } + +use Tk::Pretty; + +sub FocusChildren +{ + return (wantarray) ? () : 0; +} + +sub Populate +{ + my ($obj,$args) = @_; + $obj->SUPER::Populate($args); + $obj->{Slaves} = []; + $obj->{LayoutPending} = 0; + $obj->{Start} = 0; + $obj->{Sw} = 0; + $obj->{Sh} = 0; + $obj->ConfigSpecs('-takefocus' => ['SELF', 'takeFocus','TakeFocus',1], + '-highlightthickness' => ['SELF', 'highlightThickness','HighlightThickness',2], + '-yscrollcommand' => ['CALLBACK',undef,undef,undef], + '-columns' => ['PASSIVE','columns','Columns',5], + '-rows' => ['PASSIVE','rows','Rows',10] + ); + return $obj; +} + +sub change_size +{ + my ($w) = shift; + my $r = $w->cget('-rows'); + my $c = $w->cget('-columns'); + my $bw = $w->cget(-highlightthickness); + if (defined $r && defined $c) + { + $w->GeometryRequest($c*$w->{Sw}+2*$bw,$r*$w->{Sh}+2*$bw); + } +} + +sub Layout +{ + my $m = shift; + my $bw = $m->cget(-highlightthickness); + my $why = $m->{LayoutPending}; + $m->{LayoutPending} = 0; + my $W = $m->Width; + my $H = $m->Height; + my $w = $m->{Sw} || 1; # max width of slave + my $h = $m->{Sh} || 1; # max height of slave + my $x = $bw; + my $y = $bw; + my $start = 0; + # Set size and position of slaves + my $rows = $m->{Rows} = int(($H-2*$bw)/$h) || 1; + my $cols = $m->{Cols} = int(($W-2*$bw)/$w) || 1; + my $need = $m->{Need} = int( (@{$m->{Slaves}}+$cols-1)/$cols ); + $m->{Start} = ($need - $rows) if ($m->{Start} + $rows > $need); + + $m->{Start} = 0 if ($m->{Start} < 0); + my $row = 0; + my @posn = (); + my $s; + foreach $s (@{$m->{Slaves}}) + { + if ($row < $m->{Start}) + { + $s->UnmapWindow; + $x += $w; + if ($x+$w+$bw > $W) + { + $x = $bw; + $row++; + } + } + elsif ($y+$h+$bw > $H) + { + $s->UnmapWindow; + $s->ResizeWindow($w,$h) if ($why & 1); + } + else + { + push(@posn,[$s,$x,$y]); + $x += $w; + if ($x+$w+$bw > $W) + { + $x = $bw; + $y += $h; + $row++; + } + } + $s->ResizeWindow($w,$h) if ($why & 1); + } + $row++ if ($x > $bw); + if (defined $m->{Prev} && $m->{Prev} > $m->{Start}) + { + @posn = reverse(@posn); + } + while (@posn) + { + my $posn = shift(@posn); + my ($s,$x,$y) = (@$posn); + $s->MoveWindow($x,$y); + $s->MapWindow; + } + $m->{Prev} = $m->{Start}; + $m->Callback(-yscrollcommand => $m->{Start}/$need,$row/$need) if $need; +} + +sub QueueLayout +{ + my ($m,$why) = @_; + $m->afterIdle(['Layout',$m]) unless ($m->{LayoutPending}); + $m->{LayoutPending} |= $why; +} + +sub SlaveGeometryRequest +{ + my ($m,$s) = @_; + my $sw = $s->ReqWidth; + my $sh = $s->ReqHeight; + my $sz = 0; + if ($sw > $m->{Sw}) + { + $m->{Sw} = $sw; + $m->QueueLayout(1); + $sz++; + } + if ($sh > $m->{Sh}) + { + $m->{Sh} = $sh; + $m->QueueLayout(1); + $sz++; + } + $m->change_size if ($sz); +} + +sub LostSlave +{ + my ($m,$s) = @_; + @{$m->{Slaves}} = grep($_ != $s,@{$m->{Slaves}}); + $m->QueueLayout(2); +} + +sub Manage +{ + my $m = shift; + my $s; + foreach $s (@_) + { + $m->ManageGeometry($s); + push(@{$m->{Slaves}},$s); + $m->SlaveGeometryRequest($s); + } + $m->QueueLayout(2 | 1); +} + +sub moveto + { + my ($m,$frac) = (@_); + $m->{Start} = int($m->{Need} * $frac); + $m->QueueLayout(4); + } + +sub scroll + { + my ($m,$delta,$type) = @_; + $delta *= $m->{Rows}/2 if ($type eq 'pages'); + $m->{Start} += $delta; + $m->QueueLayout(4); + } + +sub yview { my $w = shift; my $c = shift; $w->$c(@_) } + +sub FocusIn +{ + my ($w) = @_; +# print 'Focus ',$w->PathName,"\n"; +} + +sub ClassInit +{ + my ($class,$mw) = @_; + $mw->bind($class,'<Configure>',['QueueLayout',8]); + $mw->bind($class,'<FocusIn>', 'NoOp'); + $mw->YscrollBind($class); + return $class; +} + +1; |