Tk::IDEpanedwindow - Subclass of L<Tk::Panedwindow> to Control Pane Resize Behavior

Tk-IDElayout documentation Contained in the Tk-IDElayout distribution.

Index

Code Index:

NAME

Top

Tk::IDEpanedwindow - Subclass of Tk::Panedwindow to Control Pane Resize Behavior

SYNOPSIS

Top

    use Tk::IDEpanedwindow;

    # Create panedwindow (Just like Tk::Panedwindow)
    $panedwidnow = $widget->IDEpanedwindow( ? options ? );

    # Pack the widget
    $panedwidnow->pack(qw/-side top -expand yes -fill both /);

    # Create two frames to insert
    my $label1 = $panedwidnow->Label(-text => "This is the\nleft side", -background => 'yellow');
    my $Frame2 = $panedwidnow->Frame();

    # Insert the frames, with expand factors = 1 (both frames will grow/shrink with the size
    #       of the window)
    $pwH->add($label1, -expandfactor => 1, $Frame2, -expandfactor => 1);

DESCRIPTION

Top

This is a subclass of the Tk::Panedwindow widget that adds a expandfactors option that controls how the paned-windows are resized when the overall widget is resized.

The parent class Tk::Panedwindow only changes the last pane when the entire widget is resized. Using the -expandfactors option of this widget, you can control how each paned-window is resized when the overall widget is resized.

Note: The idea for the -expandfactors option is borrowed from the TCL/TK widget TixPanedWindow.

OPTIONS

Top

In addition to the options from the parent class Tk::Panedwindow, this widget provides the following options:

expandfactors

Array ref of expand factors to use for each pane in the widget.

Each Expand Factor must be a non-negative number. The default value is 0. The expand/shrink factor is used to calculate how much each pane should grow or shrink when the size of the PanedWindow main window is changed. When the main window expands/shrinks by n pixels, then pane i will grow/shrink by about n * factor(i) / summation(factors), where factor(i) is the expand/shrink factor of pane i and summation(factors) is the summation of the expand/shrink factors of all the panes. If summation(factors) is 0.0, however, only the last visible pane will be grown or shrunk.

Note: The behavior of this -expandfactors option is borrowed from the TCL/TK widget TixPanedWindow.

fractSizes

Array ref of fractional (i.e. less than one) sizes left over from the last resize of the pane frames.

Even though frame sizes are number of pixels (integers), we keep track of the fractional part of the calculated frame sizes from resize-event to resize-event. This keeps the sizes of the frames in proportion to each other better than throwing away the fractional part would.

ATTRIBUTES

Top

slaves

Array ref of Tk::Widget objects in each frame of the panedwindow.

Methods

Top

add

Over-ridden add method add a new widget to the collection managed by the Tk::IDEpanedwindow.

This method adds a -expandfactor option to the normal options recognized by the parent Tk::Panedwindow.

Usage:

   $widget->add(?window ...? ?option value ...?);

forget

Over-ridden forget method to delete a widget from the paned-window.

This deletes the widget from our own slaves list before calling the parent method.

Usage:

   $widget->forget($window);

slaves

Gets (and optionally sets) the slaves attribute.

Usage:

	my @slaves = $self->slaves();    # Get slaves

	$self->slaves(@slaves);          # Set slaves

_getNewSizes

Internal method to get / calculate the new widget Sizes (Width or height) of a panewindow widget, based on total pw size, widget sizes, and expand factors.

This is called when the size of the panedwindow widget changes.

Usage:

   @newSizes = $self->_getNewSizes($newSize, $sizes);

        where:   $newSize:   Total new size of the panewindow widget
                               (Along the paned direction)
                 $sizes:     Array ref of old sizes (i.e. not yet adjusted
                                 for the new total-size) for each window
                                 managed by the panedwindow.

adjustSizes

Method to adjust the sizes of each pane in the paned-window direction.

Usage:

   $self->adjustSizes($newSizes);

        where:   $newSizes:   Array ref of new sizes  for each window
                                 managed by the panedwindow.
Tk-IDElayout documentation Contained in the Tk-IDElayout distribution. 
package Tk::IDEpanedwindow;
our ($VERSION) = ('0.32');

use Carp;
use strict;


use Tk;

use base qw/ Tk::Derived Tk::Panedwindow/;

our ($DEBUG); 

Tk::Widget->Construct("IDEpanedwindow");




sub Populate {
    my ($cw, $args) = @_;
     
    $cw->SUPER::Populate($args);

    # Initialize the slaves attribute
    $cw->{slaves} = [];
    
    $cw->{fractSizes} = [];
    
    $cw->ConfigSpecs( 
		      -expandfactors => [ qw/PASSIVE expandfactors expandfactors/, [] ],
    );
    
    my ($totalW, $totalH) = (0,0);
    
    # Add Bindings
    $cw->bind('<Configure>', sub{ 
	    
            return unless ($cw->ismapped); # Don't do anything until widget is actually displayed
            
	    my ($newTotalW, $newTotalH) = ($cw->width, $cw->height);
            
            #print "newTotalW/H $newTotalW/$newTotalH  totalW/H = $totalW/$totalH\n";
	    return if(  $totalH == $newTotalH && $newTotalW == $totalW);
            
            if( $totalW == 0 && $totalH == 0){ # Initially just set the totalW/H variables
                    $totalW = $newTotalW;
                    $totalH = $newTotalH;
                    return;
            }
            
            #print "new H $newTotalH  totalH = $totalH\n";
            
            # Get all widgets managed by pw2
            my @widgets = $cw->slaves;
            #print "sizeof widgets = ".scalar(@widgets)."\n";
            
            #print "widgets = ".join(", ", @widgets)."\n";
            my @heights = ();
            
            my $sizeMethod; # Method used to get widget size, depends on orientation
            $sizeMethod = "height" if( $cw->cget(-orient) =~ /vert/);
            $sizeMethod = "width"  if( $cw->cget(-orient) =~ /horiz/);

            foreach my $widget(@widgets){
                    push @heights, $widget->$sizeMethod();
                    #print $widget->geometry."\n";
            }
            #print "Heights = ".join(", ", @heights)."\n";
            
            # Get the total height of the panewindow widget (but will be 1 initially before mapped?)
	    my $height = $cw->$sizeMethod();
            
	    
	    #print "SashCords = ".join(", ", @sashCoords)." height = $height\n";
	    if($height > 1){
                    my $expandFactors = $cw->cget(-expandfactors);
                    my @newHeights = $cw->_getNewSizes( $height, [@heights], [@$expandFactors]);
                    $cw->adjustSizes([@newHeights]);
                    
	#	    $pw2->sashPlace(0, $sashCoords[0], $height * $ratio);
		    #print "new Sash Location = ".$height*$ratio."\n";
            }

           
	    ($totalW, $totalH) = ($newTotalW, $newTotalH);
    }
    );
}


#######################################################################


sub add{
	
	my $self = shift;
	my @args = @_;
	
	# Parse the args
        my @widgets;
        my %widgetArgs;
        my $widget; # current widget that options apply to
        while(@args){
                $widget = shift @args;
                unless( ref($widget) && $widget->isa("Tk::Widget")){
                        croak("Error: arg '$widget' supplied to Tk::IDEpanedwindow::add is not a Tk Widget\n");
                }
                push @widgets, $widget;
                
                # Make hash entry for the args of this widget
                my $argsHash = $widgetArgs{"$widget"} = {}; 

                while(@args && $args[0] =~ /^\-/ ){ # Process any arguments
                        my $key =   shift @args;
                        my $value = shift @args;
                        $argsHash->{$key} = $value;
                }
        }
        
        my $expandfactors = $self->cget(-expandfactors);
        
        my $slaves = $self->{slaves};
        my $fractSizes = $self->{fractSizes};
        
        ## Process the args of each widget
        foreach $widget(@widgets){
                my $expandfactor = delete $widgetArgs{"$widget"}{-expandfactor} || 0;
                
                # Handle where to put the expandfactor, based on -before or -after args
                if( defined($widgetArgs{"$widget"}{-before})){ # 
                        my $before = $widgetArgs{"$widget"}{-before};
                        my $beforeIndex;
                        my $index = 0;
                        foreach (@$slaves){ # Find index of the $before widget
                                if( $_ eq $before ){
                                        $beforeIndex = $index;
                                        last;
                                }
                        }
                        croak("Error Can't find -before widget $before in slaves list\n") unless defined($beforeIndex);
                        
                        # Update strucutes in the correct place
                        splice @$expandfactors, $beforeIndex, 0, $expandfactor;
                        splice @$slaves, $beforeIndex, 0, $widget;
                        splice @$fractSizes, $beforeIndex, 0, 0;
                }
                elsif( defined($widgetArgs{"$widget"}{-after})){ # 
                        my $after = $widgetArgs{"$widget"}{-after};
                        my $afterIndex;
                        my $index = 0;
                        foreach (@$slaves){ # Find index of the $before widget
                                if( $_ eq $after ){
                                        $afterIndex = $index;
                                        last;
                                }
                        }
                        croak("Error Can't find -after widget $after in slaves list\n") unless defined($afterIndex);
                        
                        splice @$expandfactors, $afterIndex + 1, 0, $expandfactor;
                        splice @$slaves, $afterIndex + 1, 0, $widget;
                        splice @$fractSizes, $afterIndex + 1, 0, 0;
                }
                else{ # Normal add at the end
                                
                        push @$expandfactors, $expandfactor;
                        push @$slaves, $widget;
                        push @$fractSizes, 0;
                }
        }
        
        # Save back the populated expandfactors
        $self->configure(-expandfactors => $expandfactors);
        
        # Call the parent widget  ####
        ##   Build the args to call the parent (minus any expandfactors)
        my @parentArgs;
        foreach $widget(@widgets){
                push @parentArgs, $widget;
                my $options = $widgetArgs{"$widget"};
                if( keys %$options){ # Add any options for this widget
                        push @parentArgs, %$options;
                }
        }
        
        $self->SUPER::add(@parentArgs);
                                
}

#######################################################################


sub forget{
	
	my $self = shift;
        
        my $window = shift;
        
         
        my $expandfactors = $self->cget(-expandfactors);
        
        my $slaves = $self->{slaves};
        my $fractSizes = $self->{fractSizes};
        
        # Find widget in slaves
        my $matchIndex = -1;
        my $i = 0;
        foreach my $slave(@$slaves){
                if( $slave eq $window){
                        $matchIndex = $i;
                }
                $i++;
        }
        
        if( $matchIndex > -1){ # Get rid of this window from our lists, if a match found
                 splice(@$slaves, $matchIndex, 1);
                 splice(@$fractSizes, $matchIndex, 1);
                 splice(@$expandfactors, $matchIndex, 1);
                 
                 # Save back the populated expandfactors
                 $self->configure(-expandfactors => $expandfactors);
        }
        
        $self->SUPER::forget($window);
}
                
##################################################


sub slaves{
    my $self = shift;
    
    if (defined $_[0]) {
    	    my @slaves = @_;
            my $slaves = $self->{slaves};
            @$slaves = @slaves;
    }
    
    my $slaves = $self->{slaves};
    return @$slaves;
    
}

#####################################################################


# Sub to get / calculate the new widget Sizes (Width or height) of a panewindow widget,
#   based on total pw size, widget sizes, and expand factors
sub _getNewSizes{
        my ($pw, $newSize, $sizes) = @_;
        
        my $expandFactors = $pw->cget(-expandfactors);
                
        ### Calculate total size using current sizes
        my $oldTotalSize = 2; # PW always pads top and bottom by two
        my $sashPad = $pw->cget(-sashpad);
        my $sashW   = $pw->cget(-sashwidth);
        
        my $Sindex = 0;
        foreach my $size(@$sizes){
                $oldTotalSize += $size;
                unless( $Sindex == $#$sizes){ # Add sash width, unless this is the last one
                        $oldTotalSize += ($sashPad + $sashW + $sashPad);
                }
                $Sindex++;
        }
        $oldTotalSize += 2; # PW always pads top and bottom by two
        
        # Calc New Space Delta
        my $spaceDelta = $newSize - $oldTotalSize;
        #print "####### newHeight = $newSize, totalHeight $oldTotalSize Space Delta = $spaceDelta\n";
        #print "$pw orient ".$pw->cget(-orient)." ExpandFactors = ".join(", ", @$expandFactors)."\n";   
        # Normalize expand factors
        my @expandFactors = @$expandFactors; # Copy for us to mess with
        my $expandSum = 0;
        foreach (@expandFactors){ $expandSum+=$_; };
        
        # If all factors zero, make the last expandFactor 1 ( like default panedwindow behaviour)
        if( $expandSum < .0001){
                $expandSum = 1;
                $expandFactors[-1] = 1;
        }
        
        
        my @normExpand;
        foreach (@$expandFactors){ push @normExpand, $_/$expandSum };

        # Calulate new heights
        my @newSizes;
        $Sindex = 0;
        my ($newS, $newSfract); # New Size (rounded), and new Fractional size (not rounded)
        my $expandFact;
        my $fractSizes = $pw->{fractSizes};
        foreach my $s (@$sizes){
                my $fractSize = $fractSizes->[$Sindex]; # Fractional size for the current frame
                $expandFact = $normExpand[$Sindex];
                
                $newSfract = $s + $expandFact*$spaceDelta + $fractSize; # Calc new size, including left-over fraction from last times
                
                $newS = sprintf("%.0f", $newSfract); # Round to get real size
                
                # Save left-over fraction for next time
                $fractSizes->[$Sindex] = $newSfract - $newS;
                
                push @newSizes, $newS;
                $Sindex++;
        }
        
        #print "Old Sizes = ".join(", ", @$sizes)." New Sizes = ".join(", ", @newSizes)."\n";
        return @newSizes;
}

################################################################3


sub adjustSizes{
        my ($pw, $newHeights) = @_;

        ### Calculate sashCoords
        my $sashCoord = 2; # PW always pads top and bottom by two
        my $sashPad = $pw->cget(-sashpad);
        my $sashW   = $pw->cget(-sashwidth);
        my $orient = $pw->cget(-orient);
        #return if($orient eq 'vertical');
        
        my $Hindex = 0;
        foreach my $height(@$newHeights){
                $sashCoord += $height;
                unless( $Hindex == $#$newHeights){ # Add sash width, unless this is the last one
                        $sashCoord += $sashPad; # Add padding to get to location of sash
                        #print "## Setting SashCoord $Hindex to $sashCoord\n";
                        #print "orient = ".$pw->cget(-orient)."\n";
                        
                        # Set sashcord based on orientation (horiz or vert)
                        $pw->sashPlace($Hindex, 2, $sashCoord) if( $orient =~ /vert/);
                        $pw->sashPlace($Hindex, $sashCoord, 2) if( $orient =~ /horiz/);
                        $sashCoord += ($sashW + $sashPad); # Add sashwidth and sashpad to get past the sash
                }
                $Hindex++;
        }
}

1;