package Prima::DetailedOutline; $VERSION = 0.01; use strict; use Prima::Outlines; use Prima::DetailedList; use vars qw(@ISA @images @imageSize); @ISA = qw(Prima::OutlineViewer Prima::DetailedList); { my %RNT = ( %{ Prima::OutlineViewer->notification_types() }, Sort => nt::Command, ); sub notification_types { return \%RNT; } } my %hdrProps = ( clickable => 1, scalable => 1, dragable => 1, minTabWidth => 1, ); for ( keys %hdrProps) { eval <{header}->$_(\@_); } sub Prima::DetailOutline::DummyHeader::$_ {} GENPROC } sub profile_default { return { %{Prima::Header->profile_default}, %{$_[ 0]-> SUPER::profile_default}, autoRecalc => 1, autoHScroll => 1, hScroll => 0, headerClass => 'Prima::Header', headerProfile => {}, headerDelegations => [qw(MoveItem SizeItem SizeItems Click)], multiColumn => 0, autoWidth => 0, columns => 0, widths => [], headers => [], mainColumn => 0, }; } sub init { my ( $self, %profile) = @_; $self->{noHeader} = 1; $self->{header} = bless {}, q\Prima::DetailOutline::DummyHeader\; $self->{$_} = 0 for qw(mainColumn); %profile = $self-> SUPER::init(%profile); my $hh = $self-> {headerInitHeight}; delete $self-> {headerInitHeight}; delete $self-> {noHeader}; my $bw = $self-> borderWidth; my @sz = $self-> size; my $hasv = $self-> {vScroll}; $self-> {header} = $self-> insert($profile{headerClass} => name => 'Header', origin => [ $bw, $sz[1] - $bw - $hh], size => [ $sz[0] - $bw * 2 + 1 - ( $hasv ? $self->{vScrollBar}-> width : 0), $hh], vertical => 0, growMode => gm::Ceiling, items => $profile{headers}, widths => $profile{widths}, delegations => $profile{headerDelegations}, (map { $_ => $profile{$_}} keys %hdrProps), %{$profile{headerProfile}}, ); my $x = $self->{header}->items; $self->{umap} = [ 0 .. $#$x]; $self->$_( $profile{$_}) for qw(autoRecalc columns mainColumn); $self->autowidths unless scalar @{$profile{widths}}; $self->{recalc} = 1 if $profile{autoRecalc}; return %profile; } sub setup_indents { $_[0]->SUPER::setup_indents; $_[0]->{headerInitHeight} = $_[0]->font-> height + 8; $_[0]->{indents}->[ 3] += $_[0]->{headerInitHeight}; } sub on_paint { my $self = shift; if (defined $self->{recalc} and $self->{recalc}) { delete $self->{recalc}; $self->widths([ (0) x $self->{numColumns} ]); $self->autowidths; } $self->SUPER::on_paint(@_); } sub draw_items { my ($self, $canvas, $paintStruc) = @_; my @clrs = ( $self-> color, $self-> backColor, $self-> colorIndex( ci::HiliteText), $self-> colorIndex( ci::Hilite) ); my @clipRect = $canvas-> clipRect; my $cols = $self-> {numColumns}; my $xstart = $self-> {borderWidth} - 1; my ( $i, $ci, $xend); my @widths = @{ $self-> { header}-> widths }; my $umap = $self-> {umap}->[0]; my $o = $self-> {offset} ; # we altered this a bit so it clears everything after # the firts column instead of everything after all columns # this way is the outline images have gone over bounds, # we can get rid of the excess $xend = $xstart - $o + 2; $xend += $widths[0] + 1; $canvas-> clear( $xend, @clipRect[1..3]) if $xend <= $clipRect[2]; return if $cols == 0; my $icount = scalar @$paintStruc; my $extent = $#widths * 2 + 3; for (@widths) { $extent += $_ } $canvas->backColor($clrs[3]); for ( $i = 0; $i < $icount; $i++) { my ($node, $x, $y, $x2, $y2, $position, $focused) = @{$$paintStruc[$i]}; $x = $xend + 1 if ($xend < $x); if ($focused) { $canvas->clear($x, $y, $extent, $y2); } } $canvas->backColor($clrs[0]); # texts my $lc = $clrs[0]; my $txw = 1; for ( $ci = 0; $ci < $cols; $ci++) { $umap = $self-> {umap}->[$ci]; my $wx = $widths[ $ci] + 2; if ( $xstart + $wx - $o >= $clipRect[0]) { $canvas-> clipRect( (( $xstart - $o) < $clipRect[0]) ? $clipRect[0] : $xstart - $o, $clipRect[1], (( $xstart + $wx - $o) > $clipRect[2]) ? $clipRect[2] : $xstart + $wx - $o, $clipRect[3]); for ( $i = 0; $i < $icount; $i++) { my ( $node, $x, $y, $x2, $y2, $position, $focused) = @{$$paintStruc[$i]}; # the x passed in paintStruc is adjusted for the outline marks # we need to lose that adjustment for everything but the first column $x = 2 - $o if ($ci); my $c = $clrs[ $focused ? 2 : 0]; $canvas-> color( $c), $lc = $c if $c != $lc; $canvas->text_out($node->[0]->[$ci], $x+$txw, $y); } } $xstart += $wx; $txw += $wx; last if $xstart - $o >= $clipRect[2]; } } sub on_measureitem { my ($self, $node, $level, $result) = @_; my $c = $self->{mainColumn}; my $txt = defined($node->[0]->[$c]) ? $node->[0]->[$c] : ''; $$result = $self->get_text_width($txt); # since the text of the first item is offset, # we need to get the offset and add it to the width unless ($c) { my @size = $self->size; my @a = $self->get_active_area(1, @size); my $indent = $self->{indent}; my $deltax = - $self->{offset} + ($indent/2) + $a[0]; $$result += int(($level + 0.5) * $indent) + $deltax; $$result += $indent * 1.5; } } sub on_stringify { my ($self, $index, $sref) = @_; my $c = $self->{mainColumn}; my ($node,$level) = $self->get_item($index); $$sref = $node->[0]->[$c]; } sub recalc_widths { my $self = $_[0]; my @w; my $maxWidth = 0; my $i = 0; my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(MeasureItem)); $self-> push_event; $self-> begin_paint_info; while (my ($node, $lev) = $self->get_item($i)) { my $iw = 0; $notifier->( @notifyParms, $node, $lev, \$iw); $maxWidth = $iw if $maxWidth < $iw; push ( @w, $iw); $i++; } $self-> end_paint_info; $self-> pop_event; $self->{widths} = [@w]; $self->{maxWidth} = $maxWidth; } sub reset_scrolls { my $self = $_[0]; $self-> makehint(0); if ( $self-> {scrollTransaction} != 1) { $self-> vScroll( $self-> {rows} < $self-> {count} ) if $self-> {autoVScroll}; $self-> {vScrollBar}-> set( max => $self-> {count} - $self->{rows}, pageStep => $self-> {rows}, whole => $self-> {count}, partial => $self-> {rows}, value => $self-> {topItem}, ) if $self-> {vScroll}; } if ( $self->{scrollTransaction} != 2) { my @sz = $self-> get_active_area( 2); my @widths = @{ $self->{header}->{widths} or [] }; my $iw = $#widths * 2; for (@widths) { $iw += $_ } if ( $self-> {autoHScroll}) { my $hs = ($sz[0] < $iw) ? 1 : 0; if ( $hs != $self-> {hScroll}) { $self-> hScroll( $hs); @sz = $self-> get_active_area( 2); } } $self-> {hScrollBar}-> set( max => $iw - $sz[0], whole => $iw, value => $self-> {offset}, partial => $sz[0], pageStep => $iw / 5, ) if $self-> {hScroll}; } } sub set_offset { my ( $self, $offset) = @_; my @widths = @{ $self->{header}->{widths} or [] }; my $iw = $#widths * 2; for (@widths) { $iw += $_ } my @a = $self-> get_active_area; my $lc = $a[2] - $a[0]; if ( $iw > $lc) { $offset = $iw - $lc if $offset > $iw - $lc; $offset = 0 if $offset < 0; } else { $offset = 0; } return if $self->{offset} == $offset; my $oldOfs = $self->{offset}; $self->{offset} = $offset; $self->{header}->offset($self->{offset}) unless $self->{noHeader}; if ( $self->{hScroll} && $self->{scrollTransaction} != 2) { $self->{scrollTransaction} = 2; $self-> {hScrollBar}-> value( $offset); $self->{scrollTransaction} = 0; } $self-> makehint(0); $self-> scroll( $oldOfs - $offset, 0, clipRect => \@a); } sub set_auto_recalc { $_[0]->{autoRecalc} = $_[1]; } sub Header_MoveItem { my ($self, $header, $old, $new) = @_; my $sub = sub { my ($current, $parent, $index, $level, $lastChild) = @_; my $texts = $current->[0]; splice(@$texts, $new, 0, splice(@$texts, $old, 1)); }; $self->iterate($sub,1); $self->repaint; } sub on_sort { my ($self, $col, $dir) = @_; $self->item_sort($self->items, $col, $dir); $self->clear_event; } sub item_sort { my ($self, $items, $col, $dir) = @_; @$items = sort { $a->[0][$col] cmp $b->[0][$col] } @$items; unless ($dir) { @$items = reverse @$items } for my $i (@$items) { if (defined $i->[1]) { $self->item_sort($i->[1], $col, $dir) } } } sub on_expand { my ($self, $node, $action) = @_; return unless $self->autoRecalc; $self->{recalc} = 1; $self->repaint; } sub autoRecalc {($#_)?$_[0]->set_auto_recalc ($_[1]):return $_[0]->{autoRecalc} } 1; __DATA__ =pod =head1 NAME Prima::DetailedOutline - a multi-column outline viewer with controlling header widget. =head1 SYNOPSIS use Prima::DetailedOutline; my $l = $w-> insert( 'Prima::DetailedList', columns => 2, headers => [ 'Column 1', 'Column 2' ], items => [ [ ['Item 1, Col 1', 'Item 1, Col 2'], [ [ ['Item 1-1, Col 1', 'Item 1-1, Col 2'] ], [ ['Item 1-2, Col 1', 'Item 1-2, Col 2'], [ [ ['Item 1-2-1, Col 1', 'Item 1-2-1, Col 2'] ], ] ], ] ], [ ['Item 2, Col 1', 'Item 2, Col 2'], [ [ ['Item 2-1, Col 1', 'Item 2-1, Col 2'] ], ] ], ], ); $l-> sort(1); =head1 DESCRIPTION Prima::DetailedOutline combines the functionality of Prima::OutlineViewer and Prima::DetailedList. =head1 API This class inherits all the properties, methods, and events of Prima::OutlineViewer (primary ancestor) and Prima::DetailedList (secondary ancestor). One new property is introduced, and one property is different enough to warrant mention. =head2 Methods =over =item items ARRAY Each item is represented by an arrayref with either one or two elements. The first element is the item data, an arrayref of text strings to display. The second element, if present, is an arrayref of child items. When using the node functionality inherited from Prima::OutlineViewer, the item data (that is, the arrayref of text strings) is the first element of the node. =item autoRecalc BOOLEAN If this is set to a true value, the column widths will be automatically recalculated (via C) whenever a node is expanded or collapsed. =back =head1 COPYRIGHT Copyright 2003 Teo Sankaro This program is distributed under the BSD License. (Although a credit would be nice.) =head1 AUTHOR Teo Sankaro, Eteo_sankaro@hotmail.comE. =head1 SEE ALSO L, L, L =cut