1######################################################################
2# Modified on January  4, 1998 to correct order of insertion problem #
3# Modified on January  7, 1998 to add slider decoration              #
4# Modified on January  9, 1998 to correct color name problem         #
5# Modified on January 27, 1998 to correct inaccurate border layout   #
6# Modified on January 27, 1998 to use proper notify method overload  #
7# Modified on January 27, 1998 added -padafter and -padbefore params #
8#                              for controlling size of inner widget  #
9# Modified on April 6, 1998    Incorporated into release library     #
10######################################################################
11#                       THIS IS THE CORRECT ONE                      #
12######################################################################
13
14package Tk::SplitFrame;
15
16use Tk;
17use Tk::ChildNotification;
18use Tk::Derived;
19use Tk::Widget;
20use Tk::Frame;
21
22use base qw (Tk::Derived Tk::Widget Tk::Frame);
23use vars qw ($VERSION);
24use strict;
25use Carp;
26
27$VERSION = '0.02';
28
29Tk::Widget->Construct ('SplitFrame');
30
31sub Populate
32   {
33    my ($this) = (shift, @_);
34
35    $this->SUPER::Populate (@_);
36
37    my $l_LastBorder = $this->Component
38       (
39        'Frame' => 'LastBorder',
40        '-relief' => 'sunken',
41       );
42
43    my $l_FirstBorder = $this->Component
44       (
45        'Frame' => 'FirstBorder',
46        '-relief' => 'sunken',
47       );
48
49    my $l_Slider = $this->Component
50       (
51        'Frame' => 'Slider',
52        '-relief' => 'sunken',
53        '-borderwidth' => 0,
54        '-relief' => 'flat',
55       );
56
57    $l_Slider->bind ('<ButtonRelease-1>' => sub {$this->SliderReleased();});
58    $l_Slider->bind ('<ButtonPress-1>' => sub {$this->SliderClicked();});
59    $l_Slider->bind ('<B1-Motion>' => sub {$this->SliderMoved();});
60    $this->bind ('<Configure>' => sub {$this->Redraw();});
61    $this->bind ('<Map>' => sub {$this->Redraw();});
62
63    $this->Advertise (FirstBorder => $l_FirstBorder);
64    $this->Advertise (LastBorder => $l_LastBorder);
65    $this->Advertise (Slider => $l_Slider);
66
67    my $l_BaseColor = $this->cget ('-background');
68
69    $this->ConfigSpecs
70       (
71        '-orientation' => [['SELF', 'PASSIVE'], 'orientation', 'Orientation', 'vertical'],
72        '-trimcolor'   => [['SELF', 'PASSIVE'], 'trimcolor','trimcolor', $l_BaseColor],
73        '-background'  => ['SELF','background', 'Background', $l_BaseColor],
74        '-borderwidth' => ['METHOD', 'borderwidth', 'BorderWidth', 2],
75        '-sliderposition' => ['METHOD', 'sliderposition', 'SliderPosition', 60],
76        '-sliderwidth' => [['SELF', 'PASSIVE'], 'SliderWidth', 'SliderWidth', 7],
77        '-relief'      => [['SELF', 'PASSIVE'], 'relief', 'Relief', 'flat'],
78        '-height'      => [['SELF', 'PASSIVE'], 'height', 'Height', 100],
79        '-width'       => [['SELF', 'PASSIVE'], 'width', 'Width', 100],
80        '-opaque'      => [['SELF', 'PASSIVE'], 'opaque', 'Opaque', 1],
81        '-trimcount'   => [['SELF', 'PASSIVE'], 'trimCount', 'TrimCount', 5],
82        '-padbefore'   => [['SELF', 'PASSIVE'], 'padbefore', 'PadBefore', 0],
83        '-padafter'    => [['SELF', 'PASSIVE'], 'padafter', 'PadAfter', 0],
84       );
85
86    return $this;
87   }
88
89sub Redraw
90   {
91    my ($l_Cursor, $this) = (undef, shift, @_);
92
93    my ($l_FirstClient, $l_LastClient) = @{$this->{m_ClientList}};
94    my $l_FirstBorderWidth = $this->cget ('-borderwidth');
95    my $l_LastBorderWidth = $this->cget ('-borderwidth');
96    my $l_Foreground = $this->cget ('-trimcolor');
97    my $l_Background = $this->cget ('-background');
98    my $l_FirstBorder = $this->Subwidget ('FirstBorder');
99    my $l_LastBorder = $this->Subwidget ('LastBorder');
100    my $l_Slider = $this->Subwidget ('Slider');
101    my $l_Position = $this->cget ('-sliderposition');
102    my $l_SliderWidth = $this->cget ('-sliderwidth');
103    my @l_FirstDimensions = (0, 0, 0, 0);
104    my @l_LastDimensions = (0, 0, 0, 0);
105    my $l_Height = $this->height();
106    my $l_Width = $this->width();
107
108    $l_FirstBorder->configure
109       (
110        '-borderwidth' => $l_FirstBorderWidth,
111        '-background' => $l_Foreground,
112       );
113
114    $l_LastBorder->configure
115       (
116        '-borderwidth' => $l_LastBorderWidth,
117        '-background' => $l_Foreground,
118       );
119
120    if ($l_FirstClient->class() eq $this->class())
121       {
122        $l_FirstBorder->configure ('-borderwidth' => 0, '-relief' => 'flat');
123        $l_FirstBorderWidth = 0;
124       }
125
126    if ($l_LastClient->class() eq $this->class())
127       {
128        $l_LastBorder->configure ('-borderwidth' => 0, '-relief' => 'flat');
129        $l_LastBorderWidth = 0;
130       }
131
132    if ($this->cget ('-orientation') eq 'vertical')
133       {
134        $l_Slider->place
135           (
136            '-x' => $l_Position,
137            '-y' => 0,
138            '-width' => $l_SliderWidth,
139            '-height' => $l_Height,
140           );
141
142        $l_FirstBorder->place
143           (
144            '-x' => $l_FirstDimensions [0] = 0,
145            '-y' => $l_FirstDimensions [1] = 0,
146            '-width' => $l_FirstDimensions [2] = $l_Position,
147            '-height' => $l_FirstDimensions [3] = $l_Height,
148           );
149
150        $l_LastBorder->place
151           (
152            '-x' => $l_LastDimensions [0] = $l_Position + $l_SliderWidth,
153            '-y' => $l_LastDimensions [1] = 0,
154            '-width' => $l_LastDimensions [2] = $l_Width - ($l_Position + $l_SliderWidth),
155            '-height' => $l_LastDimensions [3] = $l_Height,
156           );
157
158        $l_Cursor = 'sb_h_double_arrow';
159       }
160    else
161       {
162        $l_Slider->place
163           (
164            '-x' => 0,
165            '-y' => $l_Position,
166            '-width' => $l_Width,
167            '-height' => $l_SliderWidth,
168           );
169
170        $l_FirstBorder->place
171           (
172            '-x' => $l_FirstDimensions [0] = 0,
173            '-y' => $l_FirstDimensions [1] = 0,
174            '-width' => $l_FirstDimensions [2] = $l_Width,
175            '-height' => $l_FirstDimensions [3] = $l_Position,
176           );
177
178        $l_LastBorder->place
179           (
180            '-x' => $l_LastDimensions [0] = 0,
181            '-y' => $l_LastDimensions [1] = $l_Position + $l_SliderWidth,
182            '-width' => $l_LastDimensions [2] = $l_Width,
183            '-height' => $l_LastDimensions [3] = $l_Height - ($l_Position + $l_SliderWidth),
184           );
185
186        $l_Cursor = 'sb_v_double_arrow';
187       }
188
189    if (Exists ($l_FirstClient))
190       {
191        $this->Advertise (FirstClient => $l_FirstClient);
192        $this->Advertise (LastClient => $l_FirstClient);
193        $l_FirstClient->packForget();
194
195        $l_FirstClient->place
196           (
197            '-x' => $l_FirstDimensions [0] + $l_FirstBorderWidth,
198            '-y' => $l_FirstDimensions [1] + $l_FirstBorderWidth,
199            '-width' => $l_FirstDimensions [2] - ($l_FirstBorderWidth * 2),
200            '-height' => $l_FirstDimensions [3] - ($l_FirstBorderWidth * 2),
201           );
202
203        $l_FirstClient->GeometryRequest
204           (
205            $l_FirstDimensions [2] - ($l_FirstBorderWidth * 2),
206            $l_FirstDimensions [3] - ($l_FirstBorderWidth * 2),
207           );
208       }
209
210    if (Exists ($l_LastClient))
211       {
212        $this->Advertise (LastClient => $l_LastClient);
213
214        $l_LastClient->packForget();
215
216        $l_LastClient->place
217           (
218            '-x' => $l_LastDimensions [0] + $l_LastBorderWidth,
219            '-y' => $l_LastDimensions [1] + $l_LastBorderWidth,
220            '-width' => $l_LastDimensions [2] - ($l_LastBorderWidth * 2),
221            '-height' => $l_LastDimensions [3] - ($l_LastBorderWidth * 2),
222           );
223
224        $l_LastClient->GeometryRequest
225           (
226            $l_LastDimensions [2] - ($l_LastBorderWidth * 2),
227            $l_LastDimensions [3] - ($l_LastBorderWidth * 2),
228           );
229       }
230
231    $l_Slider->configure
232       (
233        '-background' => $l_Foreground,
234        '-cursor' => $l_Cursor,
235       );
236
237    $this->RedrawTrim();
238   }
239
240sub SliderClicked
241   {
242    my ($this) = (shift, @_);
243
244    if ((my $l_Slider = $this->Subwidget ('Slider'))->IsMapped())
245       {
246        $l_Slider->{m_Offset} =
247           (
248            $this->cget ('-orientation') eq 'vertical' ?
249            $l_Slider->pointerx() - $l_Slider->rootx()  :
250            $l_Slider->pointery() - $l_Slider->rooty()
251           );
252       }
253   }
254
255sub SliderMoved
256   {
257    my ($this) = (shift, @_);
258
259    if ((my $l_Slider = $this->Subwidget ('Slider'))->IsMapped())
260       {
261        my $l_BorderWidth = ($this->cget ('-borderwidth') || 1) * 2;
262        my $l_Vertical = $this->cget ('-orientation') eq 'vertical';
263        my $l_PadBefore = $this->cget ('-padbefore');
264        my $l_PadAfter = $this->cget ('-padafter');
265
266        my $l_Limit =
267           (
268            $l_Vertical ?
269            $this->width() :
270            $this->height()
271           ) - ($l_PadAfter + $l_BorderWidth);
272
273        my $l_Position =
274           (
275            $l_Vertical ?
276            $this->pointerx() - $this->rootx() :
277            $this->pointery() - $this->rooty()
278           );
279
280        if ($l_Position > $l_Limit)
281           {
282            $l_Position = $l_Limit;
283           }
284        elsif ($l_Position < $l_BorderWidth + $l_PadBefore)
285           {
286            $l_Position = $l_BorderWidth + $l_PadBefore;
287           }
288
289        $this->configure
290            (
291             '-sliderposition' => $l_Position - $l_Slider->{m_Offset}
292            );
293
294        $this->Redraw() if ($this->cget ('-opaque'));
295       }
296   }
297
298sub SliderReleased()
299   {
300    $_[0]->Redraw() if (! $_[0]->cget ('-opaque'));
301   }
302
303sub RedrawTrim
304   {
305    my $this = shift;
306
307    if (Exists (my $l_Slider = $this->Subwidget ('Slider')))
308       {
309        my $l_Horizontal = $this->cget ('-orientation') eq 'vertical' ? 0 : 1;
310        my $l_Count = $this->cget ('-trimcount');
311
312        for (my $l_Index = 0; $l_Index < $l_Count && $l_Count >= 0; ++$l_Index)
313           {
314            my $l_Widget;
315
316            if (! Exists ($l_Widget = $l_Slider->Subwidget ('Trim_'.$l_Index)))
317               {
318                $l_Widget = $l_Slider->Component
319                   (
320                    'Frame' => 'Trim_'.$l_Index,
321                    '-borderwidth' => 2,
322                    '-relief' => 'raised',
323                    '-width' => ($l_Horizontal ? 25 : 2),
324                    '-height' => ($l_Horizontal ? 2 : 25),
325                    '-background' => 'white',
326                   );
327
328                $l_Widget->bind ('<ButtonPress-1>' => sub {$this->SliderClicked();});
329                $l_Widget->bind ('<B1-Motion>' => sub {$this->SliderMoved();});
330               }
331
332            my $l_Where = (($l_Index - int ($l_Count / 2)) * 3) + 1;
333
334            $l_Widget->place
335               (
336                '-relx' => 0.5,
337                '-rely' => 0.5,
338                '-x' => ($l_Horizontal ? 0 : $l_Where),
339                '-y' => ($l_Horizontal ? $l_Where : 0),
340                '-anchor' => 'center',
341               );
342           }
343
344        $l_Slider->raise();
345       }
346   }
347
348sub borderwidth
349   {
350    my ($this, $p_BorderWidth) = (shift, @_);
351    $this->{m_BorderWidth} = $p_BorderWidth if (defined ($p_BorderWidth));
352    return $this->{m_BorderWidth};
353   }
354
355sub sliderposition
356   {
357    my ($this, $p_SliderPosition) = (shift, @_);
358
359    if (defined ($p_SliderPosition))
360       {
361        $this->{m_SliderPosition} = $p_SliderPosition;
362        $this->Redraw() if ($this->ismapped());
363       }
364
365    return $this->{m_SliderPosition};
366   }
367
368sub ChildNotification
369   {
370    my ($this, $p_Child) = (shift, @_);
371    my $l_Name = $p_Child->name();
372
373    if ($l_Name ne 'lastBorder' && $l_Name ne 'firstBorder' && $l_Name ne 'slider')
374       {
375        push (@{$this->{m_ClientList}}, $p_Child);
376        $p_Child->packForget();
377       }
378   }
379
3801;
381
382__END__
383
384=cut
385
386=head1 NAME
387
388Tk::SplitFrame - a geometry manager for scaling two subwidgets
389
390=head1 SYNOPSIS
391
392    use Tk;
393
394    use Tk::SplitFrame;
395
396    my $MainWindow = MainWindow->new();
397
398    my $SplitFrame = $MainWindow->SplitFrame
399       (
400        '-orientation' => 'vertical',
401        '-trimcolor'  => '#c7c7c7',
402        '-background'  => 'white',
403        '-sliderposition' => 60,
404        '-borderwidth' => 2,
405        '-sliderwidth' => 7,
406        '-relief'      => 'sunken',
407        '-height'      => 100,
408        '-width'       => 100,
409        '-padbefore'   => 0,
410        '-padafter'    => 0
411       );
412
413    # Values shown above are defaults.
414
415    my $LeftLabel = $SplitFrame->Label ('-text' => 'Left');
416
417    my $RightLabel = $SplitFrame->Label ('-text' => 'Right');
418
419    $SplitFrame->pack (-expand => true, -fill => both);
420
421    $SplitFrame->configure ('-sliderposition' => 22);
422
423    Tk::MainLoop;
424
425=head1 DESCRIPTION
426
427A SplitFrame is a geometry manager for the two subwidgets instantiated
428against it. It has a sliding divider between them which, when moved, resizes
429them so that they each remain in contact with it.
430
431The divider can be arranged vertically or horizontally at create time. The
432children our arranged in the order that they are instantiated, from left to
433right or from top to bottom. After instantiation, the order is fixed. The children
434should NOT be packed or placed, the split frame is responsible for this.
435
436The split frame will adjust itself initially to the preferred size of the
437children.
438
439It is a basic frame itself and can be packed or placed wherever needed in other
440frames or toplevel windows.
441
442=head1 AUTHORS
443
444Damion K. Wilson, dkw@rcm.bm
445
446Based on the split windows that you see all the time in Windows, Mac, Java, etc.
447
448=head1 HISTORY
449
450October 1997: Actually started using it
451
452=cut
453