summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/Tiler.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/Tiler.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/Tiler.pm203
1 files changed, 0 insertions, 203 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/Tiler.pm b/Master/tlpkg/tlperl/lib/Tk/Tiler.pm
deleted file mode 100644
index 1256612f801..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/Tiler.pm
+++ /dev/null
@@ -1,203 +0,0 @@
-# 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;