1#  Created by Dmitry Karasik <dk@plab.ku.dk>
2#  Modifications by Anton Berezin <tobez@tobez.org>
3package Prima::DetailedList;
4
5use strict;
6use warnings;
7use Prima::Classes;
8use Prima::Lists;
9use Prima::Header;
10
11use vars qw(@ISA);
12@ISA = qw(Prima::ListViewer);
13
14{
15my %RNT = (
16	%{Prima::ListViewer-> notification_types()},
17	Sort => nt::Command,
18);
19
20sub notification_types { return \%RNT; }
21}
22
23my %hdrProps = (
24	clickable   => 1,
25	scalable    => 1,
26	minTabWidth => 1,
27);
28
29for ( keys %hdrProps) {
30	eval <<GENPROC;
31sub $_ { return shift-> {hdr}-> $_(\@_); }
32sub Prima::DetailList::DummyHeader::$_ {}
33GENPROC
34}
35
36sub profile_default
37{
38	return {
39		%{Prima::Header-> profile_default},
40		%{$_[ 0]-> SUPER::profile_default},
41		headerClass       => 'Prima::Header',
42		headerProfile     => {},
43		headerDelegations => [qw(MoveItem SizeItem SizeItems Click)],
44		multiColumn       => 0,
45		autoWidth         => 0,
46		columns           => 0,
47		widths            => [],
48		headers           => [],
49		aligns            => [],
50		mainColumn        => 0,
51	};
52}
53
54
55sub init
56{
57	my ( $self, %profile) = @_;
58	$self-> {noHeader} = 1;
59	$self-> {header} = bless {
60		maxWidth => 0,
61	}, q\Prima::DetailList::DummyHeader\;
62	$self-> {$_} = 0 for qw( mainColumn);
63	%profile = $self-> SUPER::init( %profile);
64
65	my $hh = $self-> {headerInitHeight};
66	delete $self-> {headerInitHeight};
67	delete $self-> {noHeader};
68	my $bw = $self-> borderWidth;
69	my @sz = $self-> size;
70
71	$self-> {header} = $self-> insert( $profile{headerClass} =>
72		name     => 'Header',
73		origin   => [ $bw, $sz[1] - $bw - $hh],
74		size     => [ $sz[0] - $bw * 2 + 1, $hh],
75		vertical => 0,
76		growMode => gm::Ceiling,
77		items    => $profile{headers},
78		widths   => $profile{widths},
79		delegations => $profile{headerDelegations},
80		(map { $_ => $profile{$_}} keys %hdrProps),
81		%{$profile{headerProfile}},
82	);
83	$self-> {header}-> send_to_back;
84
85	my $x = $self-> {header}-> items;
86	$self-> {umap} = [ 0 .. $#$x];
87	$self-> $_( $profile{$_}) for qw( aligns columns mainColumn);
88
89	if ( scalar @{$profile{widths}}) {
90		$self-> {itemWidth} = $self-> {header}-> {maxWidth} - 1;
91		$self-> reset_scrolls;
92	} else {
93		$self-> autowidths;
94	}
95	return %profile;
96}
97
98sub setup_indents
99{
100	$_[0]-> SUPER::setup_indents;
101	$_[0]-> {headerInitHeight} = $_[0]-> font-> height + 8;
102	$_[0]-> {indents}-> [ 3] += $_[0]-> {headerInitHeight};
103}
104
105
106sub set_v_scroll
107{
108	my ( $self, $s) = @_;
109	$self-> SUPER::set_v_scroll( $s);
110	return if $self-> {noHeader};
111	my @a = $self-> get_active_area(2);
112	$self-> {header}-> width( $a[0]);
113}
114
115sub set_offset
116{
117	my ( $self, $o) = @_;
118	$self-> SUPER::set_offset( $o);
119	$self-> { header}-> offset( $self-> {offset}) unless $self-> {noHeader};
120}
121
122sub columns
123{
124	return $_[0]-> {numColumns} unless $#_;
125	my ( $self, $c) = @_;
126	$c = 0 if $c < 0;
127	return if defined $self-> {numColumns} && $self-> {numColumns} == $c;
128	my $h    = $self-> {header};
129	my @iec  = @{$h-> items};
130	my @umap = @{$self-> {umap}};
131	if ( scalar(@iec) > $c) {
132		splice( @iec, $c);
133		splice( @umap, $c);
134	} elsif ( scalar(@iec) < $c) {
135		push( @umap, (( undef ) x ( $c - scalar @iec)));
136		push( @iec, (( '' ) x ( $c - scalar @iec)));
137		my $i = 0; for ( @umap) { $_ = $i unless defined $_; $i++; }
138	}
139	$self-> {umap} = \@umap;
140	$h-> items( \@iec);
141	$self-> {numColumns} = $c;
142	$self-> repaint;
143}
144
145sub autowidths
146{
147	my $self = $_[0];
148	my $i;
149	my @w = @{$self-> widths};
150	my @header_w = $self-> {header}-> calc_autowidths;
151	for ( $i = 0; $i < $self-> {numColumns}; $i++) {
152		$self-> mainColumn( $i);
153		$self-> recalc_widths;
154		$w[ $i] = $self-> {maxWidth} + 5
155			if $w[ $i] < $self-> {maxWidth} + 5;
156		$w[$i] = $header_w[$i] if $w[$i] < $header_w[$i];
157	}
158	undef $self-> {widths};
159	$self-> widths( \@w);
160}
161
162sub draw_items
163{
164	my ($self,$canvas) = (shift,shift);
165	my @clrs = (
166		$self-> color,
167		$self-> backColor,
168		$self-> colorIndex( ci::HiliteText),
169		$self-> colorIndex( ci::Hilite)
170	);
171	my @clipRect = $canvas-> clipRect;
172	my $cols   = $self-> {numColumns};
173
174	my $xstart = $self-> {borderWidth} - 1;
175	my ( $i, $ci, $xend);
176	my @widths = @{ $self-> { header}-> widths };
177	my $umap   = $self-> {umap}-> [0];
178	my $o = $self-> {offset} ;
179
180	$xend = $xstart - $o + 2;
181	$xend += $_ + 2 for @widths;
182	$canvas-> clear( $xend, @clipRect[1..3]) if $xend <= $clipRect[2];
183
184	return if $cols == 0;
185
186	my $iref   = \@_;
187	my $rref   = $self-> {items};
188	my $icount = scalar @_;
189
190	my $drawVeilFoc = -1;
191	my $x0d    = $self-> {header}-> {maxWidth} - 2;
192
193	my (@normals, @selected, @p_normal, @p_selected);
194	my ( $lastNormal, $lastSelected) = (undef, undef);
195
196	# sorting items by index
197	$iref = [ sort { $$a[0]<=>$$b[0] } @$iref];
198
199	# calculating conjoint bars for normals / selected
200	@normals = ();
201	$lastNormal = undef;
202
203	for ( $i = 0; $i < $icount; $i++)
204	{
205		my ( $itemIndex, $x, $y, $x2, $y2, $selected, $focusedItem, $prelight) = @{$$iref[$i]};
206		$drawVeilFoc = $i if $focusedItem;
207		if ( $prelight) {
208			if ( $selected ) {
209				push ( @p_selected, [ $x, $y, $x + $x0d, $y2]);
210			} else {
211				push ( @p_normal, [ $x, $y, $x + $x0d, $y2]);
212			}
213
214		} elsif ( $selected) {
215			if ( defined $lastSelected && ( $y2 + 1 == $lastSelected)) {
216				${$selected[-1]}[1] = $y;
217			} else {
218				push ( @selected, [ $x, $y, $x + $x0d, $y2]);
219			}
220			$lastSelected = $y;
221		} else {
222			if ( defined $lastNormal && ( $y2 + 1 == $lastNormal)) {
223				${$normals[-1]}[1] = $y;
224			} else {
225				push ( @normals, [ $x, $y, $x + $x0d, $y2]);
226			}
227			$lastNormal = $y;
228		}
229	}
230
231	$canvas-> backColor( $clrs[1]);
232	$canvas-> clear( @$_) for @normals;
233	$canvas-> backColor( $clrs[3]);
234	$canvas-> clear( @$_) for @selected;
235	if ( @p_normal ) {
236		$self-> draw_item_background( $canvas, @$_, 1, $clrs[1]) for @p_normal;
237	}
238	if ( @p_selected ) {
239		$self-> draw_item_background( $canvas, @$_, 1, $clrs[3]) for @p_selected;
240	}
241
242	# draw veil
243	if ( $drawVeilFoc >= 0) {
244		my ( $itemIndex, $x, $y, $x2, $y2) = @{$$iref[$drawVeilFoc]};
245		$canvas-> rect_focus( $x + $o, $y, $x + $o + $x0d, $y2);
246	}
247
248	# texts
249	my $lc = $clrs[0];
250	my $txw = 1;
251	for ( $ci = 0; $ci < $cols; $ci++) {
252		$umap = $self-> {umap}-> [$ci];
253		my $dx = 0;
254		my $wx = $widths[ $ci] + 2;
255		my $align = $self->{aligns}->[$ci] // $self->{align};
256		if ( $xstart + $wx - $o >= $clipRect[0]) {
257			$canvas-> clipRect(
258				(( $xstart - $o) < $clipRect[0]) ? $clipRect[0] : $xstart - $o,
259				$clipRect[1],
260				(( $xstart + $wx - $o) > $clipRect[2]) ? $clipRect[2] : $xstart + $wx - $o,
261				$clipRect[3]);
262			for ( $i = 0; $i < $icount; $i++) {
263				my ( $itemIndex, $x, $y, $x2, $y2, $selected, $focusedItem) =
264					@{$$iref[$i]};
265				my $c = $clrs[ $selected ? 2 : 0];
266				$canvas-> color( $c), $lc = $c if $c != $lc;
267				if ( $align == ta::Center) {
268					my $iw = $canvas->get_text_width($rref-> [$itemIndex]-> [$umap]);
269					$dx = ($iw < $wx) ? ($wx - $iw) / 2 : 0;
270				} elsif ( $align == ta::Right ) {
271					my $iw = $canvas->get_text_width($rref-> [$itemIndex]-> [$umap]);
272					$dx = ($iw < $wx) ? $wx - $iw : 0;
273				}
274				$canvas-> text_shape_out( $rref-> [$itemIndex]-> [$umap], $x + $txw + $dx, $y);
275			}
276		}
277		$xstart += $wx;
278		$txw    += $wx;
279		last if $xstart - $o >= $clipRect[2];
280	}
281}
282
283sub item2rect
284{
285	my ( $self, $item, @size) = @_;
286	my @a = $self-> get_active_area( 0, @size);
287	my ($i,$ih) = ( $item - $self-> {topItem}, $self-> {itemHeight});
288	return $a[0], $a[3] - $ih * ( $i + 1), $a[0] + $self-> {header}-> {maxWidth}, $a[3] - $ih * $i;
289}
290
291sub Header_SizeItem
292{
293	my ( $self, $header, $col, $oldw, $neww) = @_;
294	my $xs = $self-> {borderWidth} - 1 - $self-> {offset};
295	my $i = 0;
296	my @widths = @{$self-> {header}-> widths};
297	for ( @widths ) {
298		last if $col == $i++;
299		$xs += $_ + 2;
300	}
301	$xs += 3 + $oldw;
302	my @sz = $self-> size;
303	my @a = $self-> get_active_area( 0, @sz);
304	$self-> scroll(
305		$neww - $oldw, 0,
306		confineRect => [ $xs, $a[1], $a[2] + abs( $neww - $oldw), $a[3]],
307		clipRect    => \@a,
308	);
309	$self->invalidate_rect( $xs - $widths[$col], $a[1], $xs, $a[3])
310		if ( $self->{aligns}->[$col] // $self->{align} ) != ta::Left;
311	$self-> {itemWidth} = $self-> {header}-> {maxWidth} - 1;
312	$self-> reset_scrolls if $self-> {hScroll} || $self-> {autoHScroll};
313}
314
315sub aligns {
316	return shift-> {aligns} unless $#_;
317	my $self = shift;
318	$self-> {aligns} = shift;
319}
320
321sub widths {
322	return shift-> { header}-> widths( @_) unless $#_;
323	my $self = shift;
324	$self-> {header}-> widths( @_);
325}
326
327sub headers {
328	return shift-> { header}-> items( @_) unless $#_;
329	my $self = shift;
330	$self-> {header}-> items( @_);
331	my $x = $self-> {header}-> items;
332	$self-> {umap} = [ 0 .. $#$x];
333	$self-> repaint;
334}
335
336sub mainColumn
337{
338	return $_[0]-> {mainColumn} unless $#_;
339	my ( $self, $c) = @_;
340	$c = 0 if $c < 0;
341	$c = $self-> {numColumns} - 1 if $c >= $self-> {numColumns};
342	$self-> {mainColumn} = $c;
343}
344
345sub Header_SizeItems
346{
347	$_[0]-> {itemWidth} = $_[0]-> {header}-> {maxWidth} - 1;
348	$_[0]-> reset_scrolls;
349	$_[0]-> repaint;
350}
351
352sub Header_MoveItem  {
353	my ( $self, $hdr, $o, $p) = @_;
354	splice( @{$self-> {umap}}, $p, 0, splice( @{$self-> {umap}}, $o, 1));
355	$self-> repaint;
356}
357
358sub Header_Click
359{
360	my ( $self, $hdr, $id) = @_;
361	$self-> mainColumn( $self-> {umap}-> [ $id]);
362	$self-> sort( $self-> {mainColumn});
363}
364
365sub get_item_text
366{
367	my ( $self, $index, $sref) = @_;
368	my $c = $self-> {mainColumn};
369	$$sref = $self-> {items}-> [$index]-> [ $c];
370}
371
372sub on_fontchanged
373{
374	my $self = $_[0];
375	$self-> setup_indents;
376	$self-> {header}-> set(
377		bottom => $self-> {header}-> top - $self-> {headerInitHeight},
378		height => $self-> {headerInitHeight},
379	);
380	$self-> SUPER::on_fontchanged;
381}
382
383sub on_measureitem
384{
385	my ( $self, $index, $sref) = @_;
386	my $c = $self-> {mainColumn};
387	$$sref = $self-> get_text_width( $self-> {items}-> [$index]-> [ $c]);
388}
389
390sub on_stringify
391{
392	my ( $self, $index, $sref) = @_;
393	my $c = $self-> {mainColumn};
394	$$sref = $self-> {items}-> [$index]-> [ $c];
395}
396
397sub sort
398{
399	my ( $self, $c) = @_;
400	my $dirSort;
401	if ( defined $c) {
402		return if $c < 0;
403		if ( defined($self-> {lastSortCol}) && ( $self-> {lastSortCol} == $c)) {
404			$dirSort = $self-> {lastSortDir} = ( $self-> {lastSortDir} ? 0 : 1);
405		} else {
406			$dirSort = 1;
407			$self-> {lastSortDir} = 1;
408			$self-> {lastSortCol} = $c;
409		}
410	}
411	else {
412		$self-> { lastSortCol} = 0 unless defined $self-> { lastSortCol};
413		$c = $self-> { lastSortCol};
414		$self-> { lastSortDir} = 0 unless defined $self-> { lastSortDir};
415		$dirSort = $self-> { lastSortDir};
416	}
417	my $foci = undef;
418	my %selected = map {
419		$self->{items}->[$_] =>  $_
420	} keys %{$self-> {selectedItems}}
421		if $self-> {multiSelect};
422
423	$foci = $self-> {items}-> [$self-> {focusedItem}] if $self-> {focusedItem} >= 0;
424	$self-> notify(q(Sort), $c, $dirSort);
425	$self-> repaint;
426
427	return unless defined $foci; # do not select items either;
428	                             # focused item should be < 0 only on empty lists
429	my $i = 0;
430	my $newfoc;
431	my @newsel;
432	for ( @{$self-> {items}}) {
433		if ( $_ == $foci) {
434			$newfoc = $i;
435			last unless $self-> {multiSelect};
436		}
437		push @newsel, $i
438			if $self-> {multiSelect} and exists $selected{ $_ };
439		$i++;
440	}
441	$self-> focusedItem( $newfoc) if defined $newfoc;
442	$self-> selectedItems( \@newsel) if $self-> {multiSelect};
443}
444
445sub on_sort
446{
447	my ( $self, $col, $dir) = @_;
448	if ( $dir) {
449		$self-> {items} = [
450			sort { $$a[$col] cmp $$b[$col]}
451			@{$self-> {items}}];
452	} else {
453		$self-> {items} = [
454			sort { $$b[$col] cmp $$a[$col]}
455			@{$self-> {items}}];
456	}
457	$self-> clear_event;
458}
459
460sub itemWidth {$_[0]-> {itemWidth};}
461sub autoWidth { 0;}
462
4631;
464
465=pod
466
467=head1 NAME
468
469Prima::DetailedList - a multi-column list viewer with controlling
470header widget.
471
472=head1 SYNOPSIS
473
474use Prima::DetailedList;
475
476	use Prima qw(DetailedList Application);
477	my $l = Prima::DetailedList->new(
478		columns => 2,
479		headers => [ 'Column 1', 'Column 2' ],
480		items => [
481			['Row 1, Col 1', 'Row 1, Col 2'],
482			['Row 2, Col 1', 'Row 2, Col 2']
483		],
484	);
485	$l-> sort(1);
486	run Prima;
487
488=for podview <img src="detailedlist.gif">
489
490=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/detailedlist.gif">
491
492=head1 DESCRIPTION
493
494Prima::DetailedList is a descendant of Prima::ListViewer, and as such provides
495a certain level of abstraction. It overloads format of L<items> in order to
496support multi-column ( 2D ) cell span. It also inserts L<Prima::Header> widget
497on top of the list, so the user can interactively move, resize and sort the content
498of the list. The sorting mechanism is realized inside the package; it is
499activated by the mouse click on a header tab.
500
501Since the class inherits Prima::ListViewer, some functionality, like 'item search by
502key', or C<get_item_text> method can not operate on 2D lists. Therefore, L<mainColumn>
503property is introduced, that selects the column representing all the data.
504
505=head1 API
506
507=head2 Events
508
509=over
510
511=item Sort COLUMN, DIRECTION
512
513Called inside L<sort> method, to facilitate custom algorithms of sorting.
514If the callback procedure is willing to sort by COLUMN index, then it must
515call C<clear_event>, to signal the event flow stop. The DIRECTION is a boolean
516flag, specifying whether the sorting must be performed is ascending ( 1 ) or
517descending ( 0 ) order.
518
519The callback procedure must operate on the internal storage of C<{items}>,
520which is an array of arrays of scalars.
521
522The default action is the literal sorting algorithm, where precedence is
523arbitrated by C<cmp> operator ( see L<perlop/"Equality Operators"> ) .
524
525=back
526
527=head2 Properties
528
529=over
530
531=item aligns ARRAY
532
533Array of C<ta::> align constants, where each defined the column alignment.
534Where an item in the array is undef, it means that the value of the C<align> property must be used.
535
536=item columns INTEGER
537
538Governs the number of columns in L<items>. If set-called, and the new number
539is different from the old number, both L<items> and L<headers> are restructured.
540
541Default value: 0
542
543=item headerClass
544
545Assigns a header class.
546
547Create-only property.
548
549Default value: C<Prima::Header>
550
551=item headerProfile HASH
552
553Assigns hash of properties, passed to the header widget during the creation.
554
555Create-only property.
556
557=item headerDelegations ARRAY
558
559Assigns a header widget list of delegated notifications.
560
561Create-only property.
562
563=item headers ARRAY
564
565Array of strings, passed to the header widget as column titles.
566
567=item items ARRAY
568
569Array of arrays of scalars, of arbitrary kind. The default
570behavior, however, assumes that the scalars are strings.
571The data direction is from left to right and from top to bottom.
572
573=item mainColumn INTEGER
574
575Selects the column, responsible for representation of all the data.
576As the user clicks the header tab, C<mainColumn> is automatically
577changed to the corresponding column.
578
579Default value: 0
580
581=back
582
583=head2 Methods
584
585=over
586
587=item sort [ COLUMN ]
588
589Sorts items by the COLUMN index in ascending order. If COLUMN is not specified,
590sorts by the last specified column, or by #0 if it is the first C<sort> invocation.
591
592If COLUMN was specified, and the last specified column equals to COLUMN,
593the sort direction is reversed.
594
595The method does not perform sorting itself, but invokes L<Sort> notification,
596so the sorting algorithms can be overloaded, or be applied differently to
597the columns.
598
599=back
600
601=head1 AUTHOR
602
603Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.
604
605=head1 SEE ALSO
606
607L<Prima>, L<Prima::Lists>, L<Prima::Header>, F<examples/sheet.pl>
608
609=cut
610