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