#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Pane;

my $mw = tkinit;

my $f1 = make_frame( $mw, 'green', 'noscroll', 'top', 0, 'both' );
my $f2 = make_frame( $mw, 'blue',  'scrolled', 'top', 0, 'both' );

# Populate frames with subframe containing a label and a button.
# Attempt to pack the subframe into the "top" of the containing widget.
label_button_frame( $f1, 'gold' );    # Packs as expected
label_button_frame( $f2, 'red' );     # Fails to pack nicely??

# Manage gui
MainLoop;


# Subroutines
sub make_frame {
   my ( $parent, $bgcolor, $scrolled, $side, $expand, $fill ) = @_;
   my $b_scr = ( $scrolled eq 'scrolled' ) ? 1 : 0;
   my $frame = $b_scr
    ? $parent->Scrolled( 'Frame', -scrollbars => 'oooo' )
    : $parent->Frame();

#    -scrollbars=>'osoe'): $parent->Frame();
   $frame->configure( -bg => $bgcolor );
   $frame->pack( -side => $side, -expand => $expand, -fill => $fill );
   return $frame;
}


sub label_button_frame {
   my ( $parent, $bgcolor ) = @_;
   my $mw = $parent->toplevel();
   my $fr = make_frame( $parent, $bgcolor, 'noscroll', 'top', 1, 'x' );
   $fr->configure( -relief => 'groove', -borderwidth => 4 );
   $fr->Label( -text => 'My Label', -rel => 'groove' )->pack( -side => 'left' );
   my $pcmd = sub { $mw->destroy };
   $fr->Button( -text => 'Exit', -command => $pcmd )->pack( -side => 'right' );
   return $fr;
}