1package Prima::DetailedOutline;
2
3use strict;
4use warnings;
5use Prima::Outlines;
6use Prima::DetailedList;
7
8use vars qw(@ISA @images @imageSize);
9@ISA = qw(Prima::OutlineViewer Prima::DetailedList);
10
11{
12	my %RNT = (
13	%{ Prima::OutlineViewer->notification_types() },
14	Sort => nt::Command,
15	);
16
17	sub notification_types { return \%RNT; }
18}
19
20
21my %hdrProps = (
22	clickable   => 1,
23	scalable    => 1,
24	dragable    => 1,
25	minTabWidth => 1,
26);
27
28for ( keys %hdrProps) {
29	eval <<GENPROC;
30	sub $_ { return shift->{header}->$_(\@_); }
31	sub Prima::DetailOutline::DummyHeader::$_ {}
32GENPROC
33}
34
35sub profile_default {
36	return {
37 		%{Prima::Header->profile_default},
38		%{$_[ 0]-> SUPER::profile_default},
39		autoRecalc        => 1,
40		autoHScroll       => 1,
41		hScroll           => 0,
42		headerClass       => 'Prima::Header',
43		headerProfile     => {},
44		headerDelegations => [qw(MoveItem SizeItem SizeItems Click)],
45		multiColumn       => 0,
46		autoWidth         => 0,
47		columns           => 0,
48		widths            => [],
49		headers           => [],
50		mainColumn        => 0,
51	};
52}
53
54
55sub init {
56	my ( $self, %profile) = @_;
57	$self->{noHeader} = 1;
58	$self->{header} = bless {}, q\Prima::DetailOutline::DummyHeader\;
59	$self->{$_} = 0 for qw(mainColumn);
60	%profile = $self-> SUPER::init(%profile);
61
62	my $hh = $self-> {headerInitHeight};
63	delete $self-> {headerInitHeight};
64	delete $self-> {noHeader};
65	my $bw = $self-> borderWidth;
66	my @sz = $self-> size;
67
68	$self-> {header} = $self-> insert($profile{headerClass} =>
69		name     => 'Header',
70		origin   => [ $bw, $sz[1] - $bw - $hh],
71		size     => [ $sz[0] - $bw * 2 + 1, $hh],
72		vertical => 0,
73		growMode => gm::Ceiling,
74		items    => $profile{headers},
75		widths   => $profile{widths},
76		delegations => $profile{headerDelegations},
77		(map { $_ => $profile{$_}} keys %hdrProps),
78		%{$profile{headerProfile}},
79	);
80	$self-> {header}-> send_to_back;
81	my $x = $self->{header}->items;
82	$self->{umap} = [ 0 .. $#$x];
83	$self->$_( $profile{$_}) for qw(autoRecalc columns mainColumn);
84	$self->autowidths unless scalar @{$profile{widths}};
85	$self->{recalc} = 1 if $profile{autoRecalc};
86	$self->{align} = ta::Left;
87	return %profile;
88}
89
90sub setup_indents {
91	$_[0]->SUPER::setup_indents;
92	$_[0]->{headerInitHeight} = $_[0]->font-> height + 8;
93	$_[0]->{indents}->[ 3] += $_[0]->{headerInitHeight};
94}
95
96sub on_paint {
97	my $self = shift;
98	if (defined $self->{recalc} and $self->{recalc}) {
99		delete $self->{recalc};
100		$self->widths([ (0) x $self->{numColumns} ]);
101		$self->autowidths;
102	}
103	$self->SUPER::on_paint(@_);
104}
105
106sub draw_items
107{
108	my ($self, $canvas, $paintStruc) = @_;
109	my @clrs = (
110		$self-> color,
111		$self-> backColor,
112		$self-> colorIndex( ci::HiliteText),
113		$self-> colorIndex( ci::Hilite)
114	);
115	my @clipRect = $canvas-> clipRect;
116	my $cols   = $self-> {numColumns};
117
118	my $xstart = $self-> {borderWidth} - 1;
119	my ( $i, $ci, $xend);
120	my @widths = @{ $self-> { header}-> widths };
121	my $umap   = $self-> {umap}->[0];
122	my $o = $self-> {offset} ;
123
124	# we altered this a bit so it clears everything after
125	# the firts column instead of everything after all columns
126	# this way is the outline images have gone over bounds,
127	# we can get rid of the excess
128	$xend = $xstart - $o + 2;
129	$xend += $widths[0] + 1;
130	$canvas-> clear( $xend, @clipRect[1..3]) if $xend <= $clipRect[2];
131
132	return if $cols == 0;
133
134	my $icount = scalar @$paintStruc;
135	my $extent = $#widths * 2 + 3;
136	for (@widths) { $extent += $_ }
137	$canvas->backColor($clrs[3]);
138	for ( $i = 0; $i < $icount; $i++) {
139		my ($node, $x, $y, $x2, $y2, $position, $selected, $focused, $prelight) = @{$$paintStruc[$i]};
140		next unless $prelight || $selected;
141		$x = $xend + 1 if ($xend < $x);
142		$self->draw_item_background( $canvas, $x, $y, $extent, $y2, $prelight, $selected ? $clrs[3] : $clrs[1]);
143	}
144	$canvas->backColor($clrs[0]);
145
146	# texts
147	my $lc = $clrs[0];
148	my $txw = 1;
149	for ( $ci = 0; $ci < $cols; $ci++) {
150		$umap = $self-> {umap}->[$ci];
151		my $wx = $widths[ $ci] + 2;
152		if ( $xstart + $wx - $o >= $clipRect[0]) {
153			$canvas-> clipRect(
154				(( $xstart - $o) < $clipRect[0]) ? $clipRect[0] : $xstart - $o,
155				$clipRect[1],
156				(( $xstart + $wx - $o) > $clipRect[2]) ? $clipRect[2] : $xstart + $wx - $o,
157				$clipRect[3]);
158			for ( $i = 0; $i < $icount; $i++) {
159				my ( $node, $x, $y, $x2, $y2, $position, $focused) = @{$$paintStruc[$i]};
160				# the x passed in paintStruc is adjusted for the outline marks
161				# we need to lose that adjustment for everything but the first column
162				$x = 2 - $o if ($ci);
163				my $c = $clrs[ $focused ? 2 : 0];
164				$canvas-> color( $c), $lc = $c if $c != $lc;
165				$canvas->text_shape_out($node->[0]->[$ci], $x+$txw, $y);
166			}
167		}
168		$xstart += $wx;
169		$txw    += $wx;
170		last if $xstart - $o >= $clipRect[2];
171	}
172}
173
174sub on_measureitem {
175	my ($self, $node, $level, $result) = @_;
176	my $c = $self->{mainColumn};
177	my $txt = defined($node->[0]->[$c]) ? $node->[0]->[$c] : '';
178	$$result = $self->get_text_width($txt);
179
180	# since the text of the first item is offset,
181	# we need to get the offset and add it to the width
182	unless ($c) {
183		my @size = $self->size;
184		my @a = $self->get_active_area(1, @size);
185		my $indent = $self->{indent};
186		my $deltax = - $self->{offset} + ($indent/2) + $a[0];
187		$$result += int(($level + 0.5) * $indent) + $deltax;
188		$$result += $indent * 1.5;
189	}
190}
191
192sub on_stringify {
193	my ($self, $node, $sref) = @_;
194	$$sref = $node->[0]->[$self->{mainColumn}];
195}
196
197sub recalc_widths {
198	my $self = $_[0];
199	my @w;
200	my $maxWidth = 0;
201	my $i = 0;
202	my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(MeasureItem));
203	$self-> push_event;
204	$self-> begin_paint_info;
205	while (my ($node, $lev) = $self->get_item($i)) {
206		my $iw = 0;
207		$notifier->( @notifyParms, $node, $lev, \$iw);
208		$maxWidth = $iw if $maxWidth < $iw;
209		push ( @w, $iw);
210		$i++;
211	}
212	$self-> end_paint_info;
213	$self-> pop_event;
214	$self->{widths} = [@w];
215	$self->{maxWidth} = $maxWidth;
216}
217
218sub reset_scrolls {
219	my $self = $_[0];
220	$self-> makehint(0);
221	if ( $self-> {scrollTransaction} != 1) {
222		$self-> vScroll( $self-> {rows} < $self-> {count} ) if $self-> {autoVScroll};
223		$self-> {vScrollBar}-> set(
224			max      => $self-> {count} - $self->{rows},
225			pageStep => $self-> {rows},
226			whole    => $self-> {count},
227			partial  => $self-> {rows},
228			value    => $self-> {topItem},
229		) if $self-> {vScroll};
230	}
231
232	if ( $self->{scrollTransaction} != 2) {
233		my @sz = $self-> get_active_area( 2);
234		my @widths = @{ $self->{header}->{widths} or [] };
235		my $iw = $#widths * 2;
236		for (@widths) { $iw += $_ }
237		if ( $self-> {autoHScroll}) {
238			my $hs = ($sz[0] < $iw) ? 1 : 0;
239			if ( $hs != $self-> {hScroll}) {
240				$self-> hScroll( $hs);
241				@sz = $self-> get_active_area( 2);
242			}
243		}
244		$self-> {hScrollBar}-> set(
245			max      => $iw - $sz[0],
246			whole    => $iw,
247			value    => $self-> {offset},
248			partial  => $sz[0],
249			pageStep => $iw / 5,
250		) if $self-> {hScroll};
251	}
252}
253
254sub set_offset {
255	my ( $self, $offset) = @_;
256	my @widths = @{ $self->{header}->{widths} or [] };
257	my $iw = $#widths * 2;
258	for (@widths) { $iw += $_ }
259	my @a = $self-> get_active_area;
260
261	my $lc = $a[2] - $a[0];
262	if ( $iw > $lc) {
263		$offset = $iw - $lc if $offset > $iw - $lc;
264		$offset = 0 if $offset < 0;
265	}
266	else {
267		$offset = 0;
268	}
269	return if $self->{offset} == $offset;
270	my $oldOfs = $self->{offset};
271	$self->{offset} = $offset;
272	$self->{header}->offset($self->{offset}) unless $self->{noHeader};
273	if ( $self->{hScroll} && $self->{scrollTransaction} != 2) {
274		$self->{scrollTransaction} = 2;
275		$self-> {hScrollBar}-> value( $offset);
276		$self->{scrollTransaction} = 0;
277	}
278	$self-> makehint(0);
279	$self-> scroll( $oldOfs - $offset, 0,
280		clipRect => \@a);
281}
282
283sub set_auto_recalc {
284	$_[0]->{autoRecalc} = $_[1];
285}
286
287sub Header_MoveItem {
288	my ($self, $header, $old, $new) = @_;
289	my $sub = sub {
290		my ($current, $parent, $index, $level, $lastChild) = @_;
291		my $texts = $current->[0];
292		splice(@$texts, $new, 0, splice(@$texts, $old, 1));
293	};
294	$self->iterate($sub,1);
295
296	$self->repaint;
297}
298
299sub on_sort {
300	my ($self, $col, $dir) = @_;
301	$self->item_sort($self->items, $col, $dir);
302	$self->clear_event;
303}
304
305sub item_sort {
306	my ($self, $items, $col, $dir) = @_;
307	@$items = sort { $a->[0][$col] cmp $b->[0][$col] } @$items;
308	unless ($dir) { @$items = reverse @$items }
309	for my $i (@$items) {
310		if (defined $i->[1]) { $self->item_sort($i->[1], $col, $dir) }
311	}
312	$self->reset_item_cache;
313}
314
315sub on_expand {
316	my ($self, $node, $action) = @_;
317	return unless $self->autoRecalc;
318	$self->{recalc} = 1;
319	$self->repaint;
320}
321
322sub autoRecalc {($#_)?$_[0]->set_auto_recalc ($_[1]):return $_[0]->{autoRecalc} }
323
3241;
325
326=pod
327
328=head1 NAME
329
330Prima::DetailedOutline - a multi-column outline viewer with controlling
331header widget.
332
333=head1 SYNOPSIS
334
335  use Prima qw(DetailedOutline Application);
336
337  my $l = Prima::DetailedOutline->new(
338        columns => 2,
339        headers => [ 'Column 1', 'Column 2' ],
340	size    => [200, 100],
341        items => [
342              [ ['Item 1, Col 1', 'Item 1, Col 2'], [
343                    [ ['Item 1-1, Col 1', 'Item 1-1, Col 2'] ],
344                    [ ['Item 1-2, Col 1', 'Item 1-2, Col 2'], [
345                          [ ['Item 1-2-1, Col 1', 'Item 1-2-1, Col 2'] ],
346                    ] ],
347              ] ],
348              [ ['Item 2, Col 1', 'Item 2, Col 2'], [
349                    [ ['Item 2-1, Col 1', 'Item 2-1, Col 2'] ],
350              ] ],
351        ],
352  );
353  $l-> sort(1);
354  run Prima;
355
356=for podview <img src="detailedoutline.gif">
357
358=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/detailedoutline.gif">
359
360=head1 DESCRIPTION
361
362Prima::DetailedOutline combines the functionality of Prima::OutlineViewer
363and Prima::DetailedList.
364
365=head1 API
366
367This class inherits all the properties, methods, and events of Prima::OutlineViewer
368(primary ancestor) and Prima::DetailedList (secondary ancestor).  One new property
369is introduced, and one property is different enough to warrant mention.
370
371=head2 Methods
372
373=over
374
375=item items ARRAY
376
377Each item is represented by an arrayref with either one or two elements.  The
378first element is the item data, an arrayref of text strings to display.  The
379second element, if present, is an arrayref of child items.
380
381When using the node functionality inherited from Prima::OutlineViewer, the
382item data (that is, the arrayref of text strings) is the first element of the
383node.
384
385=item autoRecalc BOOLEAN
386
387If this is set to a true value, the column widths will be automatically recalculated
388(via C<autowidths>) whenever a node is expanded or collapsed.
389
390=back
391
392=head1 COPYRIGHT
393
394Copyright 2003 Teo Sankaro
395
396This program is distributed under the BSD License.
397(Although a credit would be nice.)
398
399=head1 AUTHOR
400
401Teo Sankaro, E<lt>teo_sankaro@hotmail.comE<gt>.
402
403=head1 SEE ALSO
404
405L<Prima>, L<Prima::Outlines>, L<Prima::DetailedList>
406
407=cut
408