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