Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved. |
2 | # This program is free software; you can redistribute it and/or | |
3 | # modify it under the same terms as Perl itself. | |
4 | # An example of a geometry manager "widget" in perl | |
5 | package Tk::Tiler; | |
6 | require Tk; | |
7 | require Tk::Frame; | |
8 | ||
9 | use vars qw($VERSION); | |
10 | $VERSION = '3.016'; # $Id: //depot/Tk8/Tk/Tiler.pm#16 $ | |
11 | ||
12 | use base qw(Tk::Frame); | |
13 | ||
14 | Construct Tk::Widget 'Tiler'; | |
15 | sub Tk::Widget::ScrlTiler { shift->Scrolled('Tiler' => @_) } | |
16 | ||
17 | use Tk::Pretty; | |
18 | ||
19 | sub FocusChildren | |
20 | { | |
21 | return (wantarray) ? () : 0; | |
22 | } | |
23 | ||
24 | sub Populate | |
25 | { | |
26 | my ($obj,$args) = @_; | |
27 | $obj->SUPER::Populate($args); | |
28 | $obj->{Slaves} = []; | |
29 | $obj->{LayoutPending} = 0; | |
30 | $obj->{Start} = 0; | |
31 | $obj->{Sw} = 0; | |
32 | $obj->{Sh} = 0; | |
33 | $obj->ConfigSpecs('-takefocus' => ['SELF', 'takeFocus','TakeFocus',1], | |
34 | '-highlightthickness' => ['SELF', 'highlightThickness','HighlightThickness',2], | |
35 | '-yscrollcommand' => ['CALLBACK',undef,undef,undef], | |
36 | '-columns' => ['PASSIVE','columns','Columns',5], | |
37 | '-rows' => ['PASSIVE','rows','Rows',10] | |
38 | ); | |
39 | return $obj; | |
40 | } | |
41 | ||
42 | sub change_size | |
43 | { | |
44 | my ($w) = shift; | |
45 | my $r = $w->cget('-rows'); | |
46 | my $c = $w->cget('-columns'); | |
47 | my $bw = $w->cget(-highlightthickness); | |
48 | if (defined $r && defined $c) | |
49 | { | |
50 | $w->GeometryRequest($c*$w->{Sw}+2*$bw,$r*$w->{Sh}+2*$bw); | |
51 | } | |
52 | } | |
53 | ||
54 | sub Layout | |
55 | { | |
56 | my $m = shift; | |
57 | my $bw = $m->cget(-highlightthickness); | |
58 | my $why = $m->{LayoutPending}; | |
59 | $m->{LayoutPending} = 0; | |
60 | my $W = $m->Width; | |
61 | my $H = $m->Height; | |
62 | my $w = $m->{Sw} || 1; # max width of slave | |
63 | my $h = $m->{Sh} || 1; # max height of slave | |
64 | my $x = $bw; | |
65 | my $y = $bw; | |
66 | my $start = 0; | |
67 | # Set size and position of slaves | |
68 | my $rows = $m->{Rows} = int(($H-2*$bw)/$h) || 1; | |
69 | my $cols = $m->{Cols} = int(($W-2*$bw)/$w) || 1; | |
70 | my $need = $m->{Need} = int( (@{$m->{Slaves}}+$cols-1)/$cols ); | |
71 | $m->{Start} = ($need - $rows) if ($m->{Start} + $rows > $need); | |
72 | ||
73 | $m->{Start} = 0 if ($m->{Start} < 0); | |
74 | my $row = 0; | |
75 | my @posn = (); | |
76 | my $s; | |
77 | foreach $s (@{$m->{Slaves}}) | |
78 | { | |
79 | if ($row < $m->{Start}) | |
80 | { | |
81 | $s->UnmapWindow; | |
82 | $x += $w; | |
83 | if ($x+$w+$bw > $W) | |
84 | { | |
85 | $x = $bw; | |
86 | $row++; | |
87 | } | |
88 | } | |
89 | elsif ($y+$h+$bw > $H) | |
90 | { | |
91 | $s->UnmapWindow; | |
92 | $s->ResizeWindow($w,$h) if ($why & 1); | |
93 | } | |
94 | else | |
95 | { | |
96 | push(@posn,[$s,$x,$y]); | |
97 | $x += $w; | |
98 | if ($x+$w+$bw > $W) | |
99 | { | |
100 | $x = $bw; | |
101 | $y += $h; | |
102 | $row++; | |
103 | } | |
104 | } | |
105 | $s->ResizeWindow($w,$h) if ($why & 1); | |
106 | } | |
107 | $row++ if ($x > $bw); | |
108 | if (defined $m->{Prev} && $m->{Prev} > $m->{Start}) | |
109 | { | |
110 | @posn = reverse(@posn); | |
111 | } | |
112 | while (@posn) | |
113 | { | |
114 | my $posn = shift(@posn); | |
115 | my ($s,$x,$y) = (@$posn); | |
116 | $s->MoveWindow($x,$y); | |
117 | $s->MapWindow; | |
118 | } | |
119 | $m->{Prev} = $m->{Start}; | |
120 | $m->Callback(-yscrollcommand => $m->{Start}/$need,$row/$need) if $need; | |
121 | } | |
122 | ||
123 | sub QueueLayout | |
124 | { | |
125 | my ($m,$why) = @_; | |
126 | $m->afterIdle(['Layout',$m]) unless ($m->{LayoutPending}); | |
127 | $m->{LayoutPending} |= $why; | |
128 | } | |
129 | ||
130 | sub SlaveGeometryRequest | |
131 | { | |
132 | my ($m,$s) = @_; | |
133 | my $sw = $s->ReqWidth; | |
134 | my $sh = $s->ReqHeight; | |
135 | my $sz = 0; | |
136 | if ($sw > $m->{Sw}) | |
137 | { | |
138 | $m->{Sw} = $sw; | |
139 | $m->QueueLayout(1); | |
140 | $sz++; | |
141 | } | |
142 | if ($sh > $m->{Sh}) | |
143 | { | |
144 | $m->{Sh} = $sh; | |
145 | $m->QueueLayout(1); | |
146 | $sz++; | |
147 | } | |
148 | $m->change_size if ($sz); | |
149 | } | |
150 | ||
151 | sub LostSlave | |
152 | { | |
153 | my ($m,$s) = @_; | |
154 | @{$m->{Slaves}} = grep($_ != $s,@{$m->{Slaves}}); | |
155 | $m->QueueLayout(2); | |
156 | } | |
157 | ||
158 | sub Manage | |
159 | { | |
160 | my $m = shift; | |
161 | my $s; | |
162 | foreach $s (@_) | |
163 | { | |
164 | $m->ManageGeometry($s); | |
165 | push(@{$m->{Slaves}},$s); | |
166 | $m->SlaveGeometryRequest($s); | |
167 | } | |
168 | $m->QueueLayout(2); | |
169 | } | |
170 | ||
171 | sub moveto | |
172 | { | |
173 | my ($m,$frac) = (@_); | |
174 | $m->{Start} = int($m->{Need} * $frac); | |
175 | $m->QueueLayout(4); | |
176 | } | |
177 | ||
178 | sub scroll | |
179 | { | |
180 | my ($m,$delta,$type) = @_; | |
181 | $delta *= $m->{Rows}/2 if ($type eq 'pages'); | |
182 | $m->{Start} += $delta; | |
183 | $m->QueueLayout(4); | |
184 | } | |
185 | ||
186 | sub yview { my $w = shift; my $c = shift; $w->$c(@_) } | |
187 | ||
188 | sub FocusIn | |
189 | { | |
190 | my ($w) = @_; | |
191 | print 'Focus ',$w->PathName,"\n"; | |
192 | } | |
193 | ||
194 | sub ClassInit | |
195 | { | |
196 | my ($class,$mw) = @_; | |
197 | $mw->bind($class,'<Configure>',['QueueLayout',8]); | |
198 | $mw->bind($class,'<FocusIn>', 'NoOp'); | |
199 | $mw->YscrollBind($class); | |
200 | return $class; | |
201 | } | |
202 | ||
203 | 1; |