1#  Created by Dmitry Karasik <dk@plab.ku.dk>
2#  Modifications by Anton Berezin <tobez@tobez.org>
3package Prima::Header;
4
5use strict;
6use warnings;
7use Prima::Classes;
8
9use vars qw(@ISA);
10@ISA = qw(Prima::Widget);
11
12use constant CaptureBrimWidth => 2;
13
14{
15my %RNT = (
16	%{Prima::Widget-> notification_types()},
17	DrawItem    => nt::Action,
18	MeasureItem => nt::Action,
19	MoveItem    => nt::Action,
20	SizeItem    => nt::Action,
21	SizeItems   => nt::Action,
22);
23
24sub notification_types { return \%RNT; }
25}
26
27
28sub profile_default
29{
30	my $def = $_[ 0]-> SUPER::profile_default;
31	my %prf = (
32		offset      => 0,
33		items       => [],
34		widths      => [],
35		pressed     => -1,
36		clickable   => 1,
37		scalable    => 1,
38		dragable    => 1,
39		minTabWidth => 2,
40		vertical    => 0,
41		selectable  => 0,
42	);
43	@$def{keys %prf} = values %prf;
44	return $def;
45}
46
47sub init
48{
49	my $self = shift;
50	$self-> {$_} = 0 for qw(offset count maxWidth clickable scalable minTabWidth vertical dragable);
51	$self-> {$_} = -1 for qw(pressed);
52	$self-> {widths} = [];
53	$self-> {items} = [];
54	my %profile = $self-> SUPER::init(@_);
55	$self-> {fontHeight} = $self-> font-> height;
56	$self-> {resetDisabled} = 1;
57	$self-> $_( $profile{$_})
58		for ( qw( vertical minTabWidth items widths offset pressed clickable scalable dragable));
59	if ( scalar @{$profile{widths}} == 0) {
60		$self-> autowidths;
61		$self-> repaint;
62	}
63	return %profile;
64}
65
66sub on_paint
67{
68	my ( $self, $canvas) = @_;
69	my @size = $canvas-> size;
70	my @c = $self-> enabled ?
71	( $self-> color, $self-> backColor) :
72	( $self-> disabledColor, $self-> disabledBackColor);
73	my @c3d  = ( $self-> light3DColor, $self-> dark3DColor);
74
75	my ($prelightPart, $prelightColor) = (-1);
76	if ( defined $self->{prelight} ) {
77		$prelightColor = $self-> prelight_color($c[1]);
78		$prelightPart = $self->{prelight};
79	}
80
81	$self-> rect3d( 0, 0, $size[0]-1, $size[1]-1, 1, @c3d, $c[1]);
82	my $v = $self-> {vertical};
83	my ( $x, $y) = ( - $self-> {offset}, ( $size[1] - $self-> {fontHeight}) / 2);
84	my $i;
85
86	my $pressed = $self-> {pressed};
87	@c3d = reverse @c3d if $v;
88	my ( $wx, $cx) = ( $self-> {widths}, $self-> {count});
89	my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(DrawItem));
90	$self-> push_event;
91	my ( $d, $lim) = $v ? ( $x, $size[1]) : ( $x, $size[0]);
92	for ( $i = 0; $i < $cx; $i++) {
93		next unless $$wx[$i];
94		if ( $d + $$wx[$i] + 2 < 1) {
95			$d += $$wx[$i] + 2;
96			next;
97		}
98		my $mx = ( $d + $$wx[$i] + 1 > $lim - 2) ? ($lim - 2) : ($d + $$wx[$i] + 1);
99		$v ?
100			$self-> clipRect( 1, $d < 1 ? 1 : $d, $size[0] - 2, $mx) :
101			$self-> clipRect( $d < 1 ? 1 : $d, 1, $mx, $size[1] - 2);
102		if ( $i == $prelightPart) {
103			$self-> color($prelightColor);
104			$self-> bar(0,0,@size);
105		}
106		$self-> color( $c[0]);
107		$v ?
108			$notifier-> ( @notifyParms, $canvas, $i, 1, $d + 1, $size[0] - 2, $mx - 1, $d + 4) :
109			$notifier-> ( @notifyParms, $canvas, $i, $d + 1, 1, $mx - 1, $size[1] - 2, $y);
110		if ( $i == $pressed) {
111			$self-> color( $c3d[1]);
112			$v ?
113				$self-> line( $size[0] - 2, $d, $size[0] - 2, $d + $$wx[$i]) :
114				$self-> line( $d, $size[1] - 2, $d + $$wx[$i], $size[1] - 2);
115		} else {
116			$self-> color( $c3d[0]);
117		}
118		$v ?
119			$self-> line( 1, $d, $size[0] - 2, $d) :
120			$self-> line( $d, 1, $d, $size[1] - 2);
121		if ( $i == $pressed) {
122			$self-> color( $c3d[0]);
123			$v ?
124				$self-> line( 1, $d, 1, $d + $$wx[$i]) :
125				$self-> line( $d, 1, $d + $$wx[$i], 1);
126		} else {
127			$self-> color( $c3d[1]);
128		}
129		$d += $$wx[$i] + 1;
130		$v ?
131			$self-> line( 1, $d, $size[0] - 2, $d) :
132			$self-> line( $d, 1, $d, $size[1] - 2);
133		last if $d > $lim - 3;
134		$d++;
135	}
136	$self-> pop_event;
137}
138
139sub on_fontchanged
140{
141	my $self = $_[0];
142	$self-> {fontHeight} = $self-> font-> height;
143}
144
145sub on_drawitem
146{
147	my ( $self, $canvas, $index, $left, $bottom, $right, $top, $y) = @_;
148	$canvas-> text_shape_out( $self-> {items}-> [$index], $left, $y);
149}
150
151sub on_measureitem
152{
153	my ( $self, $index, $result) = @_;
154	$$result = $self-> {vertical} ?
155		$self-> {fontHeight} :
156		$self-> get_text_width( $self-> {items}-> [$index]);
157}
158
159sub point2area
160{
161	my ( $self, $x, $y, $useBorders) = @_;
162	my $i;
163	my $pressable = $self-> {clickable} || $self-> {dragable};
164	return if !$self-> {scalable} && !$pressable;
165	my $lim;
166	if ( $self-> {vertical}) {
167		return undef if ( $x < 1 || $x > $self-> width - 1) && !$useBorders;
168		$lim = $y;
169	} else {
170		return undef if ( $y < 1 || $y > $self-> height - 1) && !$useBorders;
171		$lim = $x;
172	}
173
174	my $cbw = $self-> {scalable} ? CaptureBrimWidth : 0;
175	my $sx = - $self-> {offset} + 1 + $cbw;
176	my $c = $self-> {count};
177	my $wx = $self-> {widths};
178	for ( $i = 0; $i < $c; $i++) {
179		next unless $$wx[$i];
180		$sx += $$wx[$i] - $cbw * 2;
181		if ( $lim < $sx) {
182			return $pressable ? $i : undef;
183		}
184		$sx += $cbw * 2 + 2;
185		if ( $lim < $sx) {
186			return $self-> {scalable} ? -($i+1) : $i;
187		}
188	}
189	return undef;
190}
191
192sub tab2offset
193{
194	my ( $self, $item) = @_;
195	my $i;
196	my $c = $self-> {count};
197	my $x = 1;
198	for ( $i = 0; $i < $item; $i++) {
199		next unless $self-> {widths}-> [$i];
200		$x += $self-> {widths}-> [$i] + 2;
201	}
202	return $x;
203}
204
205sub tab2rect
206{
207	my ( $self, $id) = @_;
208	my $offset = $self-> tab2offset( $id) - $self-> {offset} - 1;
209	return $self-> {vertical} ?
210		( 1, $offset, $self-> width - 1, $offset + $self-> {widths}-> [$id] + 2) :
211		( $offset, 1, $offset + $self-> {widths}-> [$id] + 2, $self-> height - 1);
212}
213
214sub reset_transaction
215{
216	my $self = $_[0];
217	my $lim = $self-> {vertical} ? $self-> height : $self-> width;
218	$self-> {swidth} = $self-> tab2offset( $self-> {tabId}) - $self-> {offset};
219	$self-> {maxwidth} = $lim - $self-> {swidth} - 2;
220	$self-> {maxwidth} -= $self-> {minTabWidth} if $self-> {tabId} < $self-> {count} - 1;
221	if ( $self-> {swidth} < 0) {
222		$self-> {minwidth} = -$self-> {swidth} - 1;
223		$self-> {minwidth} = $self-> {minTabWidth}
224			if $self-> {minwidth} > $self-> {minTabWidth};
225	} else {
226		$self-> {minwidth} = $self-> {minTabWidth};
227	}
228}
229
230sub on_mousedown
231{
232	my ( $self, $btn, $mod, $x, $y) = @_;
233	return unless $btn == mb::Left;
234	return if $self-> {transaction};
235	my $id = $self-> point2area( $x, $y);
236	return unless defined $id;
237	$self-> capture(1);
238	if ( $id < 0) {
239		$self-> {transaction} = 2;
240		$self-> {anchor} = $self-> {vertical} ? $y : $x;
241		$self-> {tabId}  = - $id - 1;
242		$self-> {owidth} = $self-> {widths}-> [$self-> {tabId}];
243		$self-> reset_transaction;
244	} else {
245		$self-> {transaction} = 1;
246		$self-> {tabId} = $id;
247		$self-> pressed( $id);
248		$self-> {clickAllowed} = $self-> {clickable};
249		$self-> {anchor} = $self-> {vertical} ? $y : $x;
250		$self-> {anchor} -= $self-> tab2offset( $id) - $self-> {offset};
251	}
252	$self-> {pointerPos} = [$self-> pointerPos];
253	delete $self-> {pointerSet};
254}
255
256sub on_mouseup
257{
258	my ( $self, $btn, $mod, $x, $y) = @_;
259	return unless $self-> {transaction};
260	return unless $btn == mb::Left;
261	my $id = $self-> point2area( $x, $y);
262
263	$self-> capture(0);
264	if ( $self-> {transaction} == 1) {
265		my @a = $self-> tab2rect( $self-> {tabId});
266		if ( $x >= $a[0] && $x < $a[2] && $y >= $a[1] && $y < $a[3]) {
267			$self-> notify(q(Click), $self-> {tabId}) if $self-> {clickAllowed};
268		}
269		$self-> pressed(-1);
270	} else {
271		$self-> recalc_maxwidth;
272	}
273	$self-> {transaction} = undef;
274}
275
276
277sub on_mousemove
278{
279	my ( $self, $mod, $x, $y) = @_;
280	return if $self->{no_mouse_move};
281	unless ( $self-> {transaction}) {
282		if ( $self-> enabled ) {
283			my $p = $self-> point2area( $x, $y);
284			my $ptr;
285			if ( defined $p && $p < 0) {
286				$ptr = $self-> {vertical} ? cr::SizeNS : cr::SizeWE;
287			} elsif ( $self-> {dragable} && !$self-> {clickable} && defined $p) {
288				$ptr = cr::Move;
289			} else {
290				$ptr = cr::Default;
291			}
292			$self-> pointer( $ptr);
293
294			my $prelight = (defined($p) && $p >= 0) ? $p : undef;
295			if (( $prelight // -1 ) != ( $self->{prelight} // -1)) {
296				$self->{prelight} = $prelight;
297				$self->repaint;
298			}
299
300		}
301		return;
302	}
303
304	if ( $self-> {transaction} == 1) {
305		my @a = $self-> tab2rect( $self-> {tabId});
306		$self-> pressed(
307			( $x >= $a[0] && $x < $a[2] && $y >= $a[1] && $y < $a[3]) ?
308			$self-> {tabId} : -1
309		);
310		return unless $self-> {dragable};
311		my @ppos = $self-> pointerPos;
312		if ( $self-> {clickable} && !$self-> {pointerSet}) {
313			my @p = @{$self-> {pointerPos}};
314			if ( abs( $p[0] - $ppos[0]) > 2 || abs( $p[1] - $ppos[1]) > 2) {
315				$self-> pointer( cr::Move);
316				delete $self-> {pointerPos};
317				$self-> {pointerSet} = 1;
318			}
319		}
320		my @lx = $self-> {vertical} ? @a[1,3] : @a[0,2];
321		my $d  = $self-> {vertical} ? $y : $x;
322		return if $d >= $lx[0] && $d < $lx[1];
323		my $osc = $self-> {scalable}; $self-> {scalable} = 0;
324		my $p = $self-> point2area( $x, $y, 1); # exclude borders
325		$self-> {scalable} = $osc;
326		my $o = $self-> {tabId};
327		return unless defined $p;
328		return if $p == $o;
329		$self-> {clickAllowed} = 0;
330		my $newpos;
331		if ( $self-> {widths}-> [$p] > $self-> {widths}-> [$o]) {
332			$ppos[$self-> {vertical} ? 1 : 0] +=
333				( $self-> {widths}-> [$p] - $self-> {widths}-> [$o]) * (( $p > $o) ? 1 : -1);
334			$newpos = 1;
335		}
336
337		splice( @{$self-> {items}}, $p, 0, splice( @{$self-> {items}}, $o, 1));
338		splice( @{$self-> {widths}}, $p, 0, splice( @{$self-> {widths}}, $o, 1));
339		$self-> {tabId} = $p;
340		$self-> repaint;
341		$self-> notify(q(MoveItem), $o, $p);
342		local $self->{no_mouse_move} = 1;
343		$self-> pointerPos( @ppos) if $newpos;
344	} else {
345		my @sz = $self-> size;
346		my $d = $self-> {vertical} ? $y : $x;
347		my $nw = $self-> {owidth} + $d - $self-> {anchor};
348		$nw = $self-> {maxwidth} if $nw > $self-> {maxwidth};
349		$nw = $self-> {minwidth} if $nw < $self-> {minwidth};
350		$nw = $self-> {minTabWidth} if $nw < $self-> {minTabWidth};
351		my $ow = $self-> {widths}-> [$self-> {tabId}];
352		return if $nw == $ow;
353		$self-> {widths}-> [$self-> {tabId}] = $nw;
354		my $o  = $self-> {swidth} + $ow;
355		$self-> {maxWidth} += $nw - $ow;
356		$self-> {vertical} ?
357			$self-> scroll(
358				0, $nw - $ow,
359				confineRect => [ 1, $o, $sz[0] - 1, $sz[1] - 1 + abs($nw - $ow)],
360				clipRect    => [ 1, 1, $sz[0]-1, $sz[1]-1],
361			) : $self-> scroll(
362				$nw - $ow, 0,
363				confineRect => [ $o, 1, $sz[0] - 1 + abs($nw - $ow), $sz[1] - 1],
364				clipRect    => [ 1, 1, $sz[0]-1, $sz[1]-1],
365			);
366		$self-> notify(q(SizeItem), $self-> {tabId}, $ow, $nw);
367	}
368}
369
370sub on_mouseleave
371{
372	my $self = shift;
373	$self-> repaint if defined( delete $self->{prelight} );
374}
375
376sub on_mouseclick
377{
378	$_[0]-> clear_event;
379	return unless $_[5];
380	shift-> notify(q(MouseDown), @_);
381}
382
383
384sub on_click
385{
386#	my ( $self, $index) = @_;
387}
388
389sub protect
390{
391	die "Prima::Header: Cannot change parameters during transaction\n" if $_[0]-> {transaction};
392}
393
394sub autowidths
395{
396	my ($self) = @_;
397	my @r = $self-> calc_autowidths;
398	$self-> {widths} = \@r;
399	$self-> recalc_maxwidth;
400	$self-> notify(q(SizeItems));
401}
402
403sub calc_autowidths
404{
405	my $self = $_[0];
406	$self-> protect;
407	my $cx = $self-> {count};
408	my $i;
409	$self-> begin_paint_info;
410	my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(MeasureItem));
411	my @r;
412	for ( $i = 0; $i < $cx; $i++) {
413		my $result = 0;
414		$notifier-> ( @notifyParms, $i, \$result);
415		$result = $self-> {minTabWidth} if $result < $self-> {minTabWidth};
416		push @r, $result;
417		next unless $result;
418	}
419	$self-> end_paint_info;
420	return @r;
421}
422
423sub recalc_maxwidth
424{
425	my $self = $_[0];
426	my $mxw = 2;
427	for ( @{$self-> {widths}}) {
428		$mxw += $_ + 2 if $_;
429	}
430	$self-> {maxWidth} = $mxw;
431}
432
433sub offset
434{
435	return $_[0]-> {offset} unless $#_;
436	my ( $self, $offset) = @_;
437	$offset = 0 if $offset < 0;
438	$offset = $self-> {maxWidth} - 5 if $offset >= $self-> {maxWidth} - 4;
439	return if $offset == $self-> {offset};
440	$self-> {offset} = $offset;
441	$self-> reset_transaction if $self-> {transaction};
442	$self-> repaint;
443}
444
445sub clickable
446{
447	return $_[0]-> {clickable} unless $#_;
448	$_[0]-> {clickable} = $_[1];
449}
450
451sub vertical
452{
453	return $_[0]-> {vertical} unless $#_;
454	return if $_[0]-> {vertical} == $_[1];
455	$_[0]-> protect;
456	$_[0]-> {vertical} = $_[1];
457	$_[0]-> repaint;
458}
459
460sub scalable
461{
462	return $_[0]-> {scalable} unless $#_;
463	$_[0]-> {scalable} = $_[1];
464}
465
466sub dragable
467{
468	return $_[0]-> {dragable} unless $#_;
469	$_[0]-> {dragable} = $_[1];
470}
471
472sub minTabWidth
473{
474	return $_[0]-> {minTabWidth} unless $#_;
475	my $changed = 0;
476	my $m = $_[1];
477	$m = 0 if $m < 0;
478	$_[0]-> {minTabWidth} = $m;
479	for (@{$_[0]-> {widths}}) {
480		$_ = $m, $changed = 1 if $_ < $m;
481	}
482	$_[0]-> recalc_maxwidth;
483	$_[0]-> notify(q(SizeItems)) if $changed;
484}
485
486sub items
487{
488	unless ( $#_) {
489		return wantarray ? @{$_[0]-> {items}} : [@{$_[0]-> {items}}];
490	}
491	my ( $self, @items) = @_;
492	$self-> protect;
493	@items = @{$items[0]} if scalar(@items) == 1 && ref($items[0]) eq 'ARRAY';
494	$self-> {items} = [@items];
495	my $oc = $self-> {count};
496	$self-> {count} = scalar @items;
497	if ( $oc > $self-> {count}) {
498		splice( @{$self-> {widths}}, $self-> {count});
499		$self-> notify(q(SizeItems));
500	} elsif ( $oc < $self-> {count}) {
501		push( @{$self-> {widths}}, (( $self-> {minTabWidth}) x ( $self-> {count} - $oc)));
502		$self-> notify(q(SizeItems));
503	}
504	$self-> recalc_maxwidth;
505	$self-> offset( $self-> offset);
506	$self-> repaint;
507}
508
509sub widths
510{
511	unless ( $#_) {
512		return wantarray ? @{$_[0]-> {widths}} : [@{$_[0]-> {widths}}];
513	}
514	my ( $self, @widths) = @_;
515	$self-> protect;
516	@widths = @{$widths[0]} if scalar(@widths) == 1 && ref($widths[0]) eq 'ARRAY';
517	$self-> {widths} = [@widths];
518	if ( scalar @widths > $self-> {count}) {
519		splice( @{$self-> {widths}}, $self-> {count});
520	} elsif ( scalar @widths < $self-> {count}) {
521		push( @{$self-> {widths}},
522			(( $self-> {minTabWidth}) x ( $self-> {count} - scalar @widths)));
523	}
524	for ( @{$self-> {widths}}) {
525		$_ = $self-> {minTabWidth} if $_ < $self-> {minTabWidth};
526	}
527	$self-> recalc_maxwidth;
528	$self-> offset( $self-> offset);
529	$self-> repaint;
530	$self-> notify(q(SizeItems));
531}
532
533sub pressed
534{
535	return $_[0]-> {pressed} unless $#_;
536	my ( $self, $pid) = @_;
537	$pid = -1 if $pid < 0 || $pid >= $self-> {count};
538	return if $pid == $self-> {pressed};
539	my $opid = $self-> {pressed};
540	$self-> {pressed} = $pid;
541	if (( $opid < 0) || ( $pid < 0)) {
542		$self-> invalidate_rect( $self-> tab2rect( ( $pid < 0) ? $opid : $pid));
543	} else {
544		$self-> repaint;
545	}
546}
547
5481;
549
550=head1 NAME
551
552Prima::Header - a multi-tabbed header widget.
553
554=head1 DESCRIPTION
555
556The widget class provides functionality of several button-like
557caption tabs, that can be moved and resized by the user.
558The class was implemented with a view to serve as a table header
559for list and grid widgets.
560
561=head1 API
562
563=head2 Events
564
565=over
566
567=item Click INDEX
568
569Called when the user clicks on the tab, positioned at INDEX.
570
571=item DrawItem CANVAS, INDEX, X1, Y1, X2, Y2, TEXT_BASELINE
572
573A callback used to draw the tabs. CANVAS is the output object;
574INDEX is the index of a tab.
575X1,Y2,X2,Y2 are the coordinates of the boundaries of the tab rectangle;
576TEXT_BASELINE is a pre-calculated vertical position for eventual
577centered text output.
578
579=item MeasureItem INDEX, RESULT
580
581Stores in scalar, referenced by RESULT, the width or height ( depending
582on L<vertical> property value ) of the tab in pixels.
583
584=item MoveItem OLD_INDEX, NEW_INDEX
585
586Called when the user moves a tab from its old location, specified by OLD_INDEX,
587to the NEW_INDEX position. By the time of call, all internal structures are
588updated.
589
590=item SizeItem INDEX, OLD_EXTENT, NEW_EXTENT
591
592Called when the user resizes a tab in INDEX position. OLD_EXTENT and NEW_EXTENT
593are either width or height of the tab, depending on L<vertical> property value.
594
595=item SizeItems
596
597Called when more than one tab has changed its extent. This might happen as a result
598of user action, as well as an effect of set-calling to some properties.
599
600=back
601
602=head2 Properties
603
604=over
605
606=item clickable BOOLEAN
607
608Selects if the user is allowed to click the tabs.
609
610Default value: 1
611
612=item dragable BOOLEAN
613
614Selects if the user is allowed to move of the tabs.
615
616Default value: 1
617
618=item items ARRAY
619
620Array of scalars, representing the internal data of the tabs.
621By default the scalars are treated as text strings.
622
623=item minTabWidth INTEGER
624
625A minimal extent in pixels a tab must occupy.
626
627Default value: 2
628
629=item offset INTEGER
630
631An offset on the major axis ( depends on L<vertical> property value )
632that the widget is drawn with. Used for the conjunction with list widgets
633( see L<Prima::DetailedList> ), when the list is horizontally or
634vertically scrolled.
635
636Default value: 0
637
638=item pressed INTEGER
639
640Contains the index of the currently pressed tab. A -1 value is selected
641when no tabs are pressed.
642
643Default value: -1
644
645=item scalable BOOLEAN
646
647Selects if the user is allowed to resize the tabs.
648
649Default value: 1
650
651=item vertical BOOLEAN
652
653If 1, the tabs are aligned vertically;
654the L<offset>, L<widths> property and extent parameters of the callback
655notification assume heights of the tabs.
656
657If 0, the tabs are aligned horizontally, and the extent properties
658and parameters assume tab widths.
659
660=item widths ARRAY
661
662Array of integer values, corresponding to the extents of the tabs.
663The extents are widths ( C<vertical> is 0 ) or heights ( C<vertical> is 1 ).
664
665=back
666
667=head2 Methods
668
669=over
670
671=item tab2offset INDEX
672
673Returns offset of the INDEXth tab ( without regard to L<offset> property value ).
674
675=item tab2rect INDEX
676
677Returns four integers, representing the rectangle area, occupied by
678the INDEXth tab ( without regard to L<offset> property value ).
679
680=back
681
682=head1 AUTHOR
683
684Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.
685
686=head1 SEE ALSO
687
688L<Prima>, L<Prima::Widget>, L<Prima::DetailedList>, F<examples/sheet.pl>.
689
690=cut
691