Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help??

When using the "grid" geometry manager in a Tk application to place a number of, say, buttons it can be a little confusing when the number of widgets is not an exact multiple of the number of rows or columns constraining the layout. I came up with a small module that calculates the "x" and "y" for each widget, returning a ref to an AoA of widget positions. Here is the module:-

# Module to calculate item positions for the Tk Grid geometry
# manager, returning the results as an anonymous AoA such that the
# data structure represents [ [ item 0 row, item0 column ], [ item 1
# row, item 1 column ] ... [ item n row, item n column ] ]. The Grid
# geometry manager numbers rows and columns from zero.
#
# Subroutine references are only created for fitting elements to a
# number of columns. When fitting to rows the same routines can be
# used but each pair of elements, "x" and "y" if you will, have to
# be reversed, see the two fitToRows.....() subroutines below.
#
# When arranging items to fit a certain number of columns and the
# items are ordered along the rows the algorithm is simple, keep
# filling rows until you run out of items, the last row might be
# short but that's fine.
#
# However, things get more complicated when fitting to columns and the
# order is down the columns as well. Just filling columns until you
# run out of items no longer works in all cases. For example, if we
# want to fit nine items to four columns we will need three rows (two
# times four is only eight) but filling columns willy-nilly means we
# run out of items before we get to the fourth column, leaving it
# empty. Instead we have to calculate how many columns will be full
# ones from items modulo columns, the number of rows being the
# truncated division of items by columns, with one row added if the
# modulo was positive.
#
#       ==========
package GridLayout;
#       ==========

use strict;
use warnings;

# Only integer maths required.
#
use integer;

# Set up Exporter to make subroutines available.
#
use Exporter       qw{ import };
our @EXPORT_OK   = qw{
   fitToColsHSort
   fitToColsVSort
   fitToRowsHSort
   fitToRowsVSort
   };
our %EXPORT_TAGS = (
   ALL => [ @EXPORT_OK ],
   );

# Subroutine to calculate grid positions of elements that are to be
# fitted to a number of columns with the element order sorted
# vertically.
#
#   -----------------
my $rcColsSortAligned = sub
#   -----------------
   {
       # Get number of items and number of columns to fit them to then
       #initialise the anonymous AoA tha will be returned.
       #
       my( $nItems, $colsToFit ) = @_;
       my $raOrder               = [];

       # Calculate the number of rows required; we are using integer
       # arithmetic so dividing number of items by number of columns
       # gives an "at least" number for rows. However, if number of
       # items modulo number of columns is positive then we need
       # another row which will contain that number of full columns
       # with the remaining columns being one item shorter. If not, al
+l
       # columns are full so set number of full columns to match colum
+ns
       # to fit.
       # 
       my $nRows     = $nItems / $colsToFit;
       my $nFullCols = $nItems % $colsToFit;
       $nRows       ++ if $nFullCols;
       $nFullCols  ||= $colsToFit;

       # Populate the columns that are full, looping row within column
+.
       #
       foreach my $col ( 0 .. $nFullCols - 1 )
       {
           foreach my $row ( 0 .. $nRows - 1 )
           {
               push @{ $raOrder }, [ $row, $col ];
           }
       }

       # If all columns are full columns then we are done, return the
       # anonymous AoA.
       #
       return $raOrder if $nFullCols == $colsToFit;

       # For the remaining columns populate all but the last row. Loop
       # row within column again.
       #
       foreach my $col ( $nFullCols .. $colsToFit - 1 )
       {
           foreach my $row ( 0 .. $nRows - 2 )
           {
               push @{ $raOrder }, [ $row, $col ];
           }
       }

       # Now all columns are populated we can return the anonymous AoA
+.
       #
       return $raOrder;
   };

# Subroutine to calculate grid positions of elements that are to be
# fitted to a number of columns with the element order sorted
# horizontally.
#
#   -----------------
my $rcColsSortOpposed = sub
#   -----------------
   {
       # Get number of items and number of columns to fit them to then
       #initialise the anonymous AoA that will be returned.
       #
       my( $nItems, $colsToFit ) = @_;
       my $raOrder               = [];

       # When fitting items to, say, four columns the row number will
       # be the truncated integer division of item number by number of
       # columns. So, items 0, 1, 2 and 3 go into row 0, then 4, 5, 6
       # and 7 into row 1 etc. The column position is simply the item
       # number modulo the number of columns, cycling 0, 1, 2, 3, 0, 1
+,
       # 2, 3 etc.
       #
       foreach my $item ( 0 .. ( $nItems - 1 ) )
       {
           push @{ $raOrder }, [
              $item / $colsToFit,
              $item % $colsToFit
              ];
       }

       # Now all columns are populated we can return the anonymous AoA
+.
       #
       return $raOrder;
   };

# Exported subroutines
# ====================
#
# Fit $nItems items into $nCols columns with items ordered along
# the rows.
#
#   --------------
sub fitToColsHSort
#   --------------
{
    my( $nItems, $nCols ) = @_;

    # We are fitting to columns so the anonymous AoA returned by
    # $rcColsSortOpposed->() is all that's needed.
    #
    return $rcColsSortOpposed->( $nItems, $nCols );
}

# Fit $nItems items into $nCols columns with items ordered down
# the columns.
#
#   --------------
sub fitToColsVSort
#   --------------
{
    my( $nItems, $nCols ) = @_;

    # We are fitting to columns so the anonymous AoA returned by
    # $rcColsSortAligned->() is all that's needed.
    #
    return $rcColsSortAligned->( $nItems, $nCols );
}

# Fit $nItems items into $nRows rows with items ordered along
# the rows.
#
#   --------------
sub fitToRowsHSort
#   --------------
{
    my( $nItems, $nRows ) = @_;

    # We are fitting to rows so the anonymous AoA returned by
    # $rcColsSortAligned->() has to be modified by swapping the
    # row and column values for each item.
    #
    return [
       map { [ reverse @{ $_ } ]  }
       @{ $rcColsSortAligned->( $nItems, $nRows ) }
       ];
}

# Fit $nItems items into $nRows rows with items ordered down
# the columns.
#
#   --------------
sub fitToRowsVSort
#   --------------
{
    my( $nItems, $nRows ) = @_;
    # We are fitting to rows so the anonymous AoA returned by
    # $rcColsSortOpposed->() has to be modified by swapping the
    # row and column values for each item.
    #
    return [
       map { [ reverse @{ $_ } ]  }
       @{ $rcColsSortOpposed->( $nItems, $nRows ) }
       ];
}

1;

[download]

Here is a test script that demonstrates its use:-

#!/usr/bin/perl
#
use strict;
use warnings;

# Use Tk GUI widgets and GridLayout.pm module for calculating widget
# positions for the "grid" geometry manager.
#
use Tk;
use GridLayout qw{ :ALL };

# Set up constants for widget creation and the "pack" geometry manager
+.
#
use constant {
   RIDGE  => q{ridge},
   FLAT   => q{flat},
   RAISED => q{raised},
   Y      => q{y},
   LEFT   => q{left},
   RIGHT  => q{right},
   TOP    => q{top},
   BOTTOM => q{bottom},
   };

# Set up some default GUI appearance options.
#
my $bgColour              = q{LightSteelBlue3};
my %commonFrameOpts       =
   (
      -background         => $bgColour,
      -relief             => RIDGE,
      -borderwidth        => 2,
   );
my %commonLabelOpts       =
   (
      -foreground         => q{NavyBlue},
      -background         => q{LemonChiffon},
      -relief             => FLAT,
      -borderwidth        => 2,
      -padx               => 5,
      -pady               => 5,
   );
my %commonButtonOpts         =
   (
      -background         => q{grey35},
      -foreground         => q{yellow2},
      -activebackground   => q{grey45},
      -activeforeground   => q{yellow},
      -disabledforeground => q{grey55},
   );
my %commonRadioButtonOpts =
   (
      -width              => 6,
      -selectcolor        => q{red},
      -relief             => RAISED,
      -borderwidth        => 2,
      -padx               => 5,
      -pady               => 5,
   );

# Create non-resizeable main window and set title.
#
my $mainWin = MainWindow->new(
   -background  => $bgColour,
   );
$mainWin->resizable( 0, 0 );
$mainWin->title( q{Fit columns and rows} );

# Get screen height in pixels and set the font size to suit the
# resolution.
#
my $screenHeight = $mainWin->screenheight();
my $fontSize     = 8;
$fontSize        = 10 if $screenHeight >= 1024;
$fontSize        = 12 if $screenHeight >= 1536;
$mainWin->optionAdd( q{*font} => qq{courier $fontSize} );

# Default to arranging buttons by columns. Create a frame for the labe
+l
# and the buttons for choosing rows or columns.
#
my $rowsOrColumns = 1;
my $rowColFrame = $mainWin->Frame(
   %commonFrameOpts,
   )->pack(
      -side   => TOP,
      -fill   => Y,
      -expand => 1,
      );

# Create label and associated text variable.
#
my $rsRowColText = \ do { my $dummy };
$rowColFrame->Label(
   %commonLabelOpts,
   -textvariable => $rsRowColText,
   )->pack(
      -side => TOP,
      );

# Create a flat-relief frame within the "rows/columns" frame for the
# buttons making the choice.
#
my $chooseRowColFrame = $rowColFrame->Frame(
   %commonFrameOpts,
   -relief => FLAT,
   )->pack(
      -side   => TOP,
      -fill   => Y,
      -expand => 1,
      );

# Create the radiobuttons with the &arrangeButtons callback.
#
$chooseRowColFrame->Radiobutton(
   %commonRadioButtonOpts,
   -text     => q{Rows},
   -width    => 7,
   -value    => 0,
   -variable => \ $rowsOrColumns,
   -command  => \ &arrangeButtons,
   )->pack(
      -side => LEFT,
      -padx => 5,
      -pady => 5,
      );
$chooseRowColFrame->Radiobutton(
   %commonRadioButtonOpts,
   -text     => q{Columns},
   -width    => 7,
   -value    => 1,
   -variable => \ $rowsOrColumns,
   -command  => \ &arrangeButtons,
   )->pack(
      -side => LEFT,
      -padx => 5,
      -pady => 5,
      );


# Default to sorting buttons horizontally. Create a frame for the labe
+l
# and the buttons for choosing sort direction.
#
my $sortDirection = 0;
my $directionFrame = $mainWin->Frame(
   %commonFrameOpts,
   )->pack(
      -side   => TOP,
      -fill   => Y,
      -expand => 1,
      );

# Create label and associated text variable.
#
my $rsDirectionText = \ do { my $dummy };
$directionFrame->Label(
   %commonLabelOpts,
   -textvariable => $rsDirectionText,
   )->pack(
      -side => TOP,
      );

# Create a flat-relief frame within the "horizontal/vertical" frame fo
+r
# the buttons making the choice.
#
my $chooseDirectionFrame = $directionFrame->Frame(
   %commonFrameOpts,
   -relief => FLAT,
   )->pack(
      -side   => TOP,
      -fill   => Y,
      -expand => 1,
      );

# Create the radiobuttons with the &arrangeButtons callback.
#
$chooseDirectionFrame->Radiobutton(
   %commonRadioButtonOpts,
   -text     => q{Horizontal},
   -width    => 10,
   -value    => 0,
   -variable => \ $sortDirection,
   -command  => \ &arrangeButtons,
   )->pack(
      -side => LEFT,
      -padx => 5,
      -pady => 5,
      );
$chooseDirectionFrame->Radiobutton(
   %commonRadioButtonOpts,
   -text     => q{Vertical},
   -width    => 10,
   -value    => 1,
   -variable => \ $sortDirection,
   -command  => \ &arrangeButtons,
   )->pack(
      -side => LEFT,
      -padx => 5,
      -pady => 5,
      );

# Default to arranging 9 buttons, prepare a frame to hold the buttons
# that choose how many items to arrange.
#
my $numItems = 9;
my $itemCountFrame = $mainWin->Frame(
   %commonFrameOpts,
   )->pack(
      -side   => TOP,
      -fill   => Y,
      -expand => 1,
      );

# Create label and associated text variable.
#
my $rsItemsText = \ do { my $dummy };
$itemCountFrame->Label(
   %commonLabelOpts,
   -textvariable => $rsItemsText,
   )->pack(
      -side => TOP,
      );

# Create a flat-relief frame within the "item count" frame for
# the buttons making the choice.
#
my $chooseItemsFrame = $itemCountFrame->Frame(
   %commonFrameOpts,
   -relief      => FLAT,
   )->pack(
      -side   => TOP,
      -fill   => Y,
      -expand => 1,
      );

# Allow a choice of from 2 to 31 items to display, selected by
# radiobuttons arranged in a grid. For this straighforward rectangular
# layout of 5 x 6 radiobuttons some simple arithmetic suffices to
# calculate the grid positions, no need for the GridLayout module. 
#
for ( 2 .. 31 )
{
    $chooseItemsFrame->Radiobutton(
       %commonRadioButtonOpts,
       -text     => $_,
       -value    => $_,
       -variable => \ $numItems,
       -width    => 3,
       -command  => \ &arrangeButtons,
       )->grid(
          -row    => ( ( $_ - 2 ) / 5 ),
          -column => ( ( $_ - 2 ) % 5 ),
          -padx   => 5,
          -pady   => 5,
          );
}

# Default to arranging in 4 columns, create frame for choosing how
# many rows or columns to arrange.
#
my $numRowsOrCols = 4;
my $rowColCountFrame = $mainWin->Frame(
   %commonFrameOpts,
   )->pack(
      -side   => TOP,
      -fill   => Y,
      -expand => 1,
      );

# Create label and associated text variable.
#
my $rsRowColCountText = \ do { my $dummy };
$rowColCountFrame->Label(
   %commonLabelOpts,
   -textvariable => $rsRowColCountText,
   )->pack(
      -side => TOP,
      );

# Create a flat-relief frame within the "rows/columns count" frame for
# the buttons making the choice.
#
my $chooseColumnsFrame = $rowColCountFrame->Frame(
   %commonFrameOpts,
   -relief => FLAT,
   )->pack(
      -side   => TOP,
      -fill   => Y,
      -expand => 1,
      );

# Create the radiobuttons, 2 through 7, with the &arrangeButtons callb
+ack.
#
for (2 .. 7)
{
    $chooseColumnsFrame->Radiobutton(
       %commonRadioButtonOpts,
       -text     => $_,
       -value    => $_,
       -width    => 3,
       -variable => \ $numRowsOrCols,
       -command  => \ &arrangeButtons,
       )->pack(
          -side => LEFT,
          -padx => 5,
          -pady => 5,
          );
}

# The items being arranged according to the choices made are simple bu
+ttons
# here and we keep track of them in an anonymous hash updated by the
# &arrangeButtons() subroutine. They will be displayed in the $buttonF
+rame
# frame which we create now.
#
my $rhButtons = {};
my $buttonFrame = $mainWin->Frame(
   %commonFrameOpts,
   )->pack(
      -side   => TOP,
      -fill   => Y,
      -expand => 1,
      );

# Finally create a control button frame to hold the "Quit" button.
#
my $controlButtonFrame = $mainWin->Frame(
   %commonFrameOpts,
   -relief      => FLAT,
   )->pack(
      -side => TOP,
      );
$controlButtonFrame->Button(
   %commonButtonOpts,
   -text    => q{Quit},
   -command => sub { $mainWin->destroy(); },
   )->pack(
      -side => RIGHT,
      -padx => 5,
      -pady => 5,
      );

# Call arrangeButtons() to display the default button arrangement then
# enter the main loop and await events.
#
arrangeButtons();
MainLoop();

# Subroutine called to arrange (before MainLoop()) or re-arrange (as
# a widget callback) buttons depending on choices made on row or
# column constraint, row or column count and sorting direction.
#
#   --------------
sub arrangeButtons
#   --------------
{
    # Destroy any existing buttons and clear the buttons hash.
    #
    foreach my $button ( keys %{ $rhButtons } )
    {
        $rhButtons->{ $button }->destroy()
           if Exists( $rhButtons->{ $button } );
        delete $rhButtons->{ $button };
    }

    # Call routines to set label text for each of the four categories
    # that the user might change.
    #
    setRowOrColumnText();
    setDirectionText();
    setItemsText();
    setRowColCountText();

    # Get the button order as an anonymous AoA by calling the appropri
+ate
    # subroutine depending on whether we are constrained by the number
+ of
    # rows or of columns and whether buttons are sorted vertically or
    # horizontally.
    #
    my $raButtonOrder =
       $rowsOrColumns
       ? ( $sortDirection
           ? fitToColsVSort( $numItems, $numRowsOrCols )
           : fitToColsHSort( $numItems, $numRowsOrCols )
         )
       : ( $sortDirection
           ? fitToRowsVSort( $numItems, $numRowsOrCols )
           : fitToRowsHSort( $numItems, $numRowsOrCols )
         );

    # Create the chosen number of buttons, keeping track of them in
    # the $rhButtons anonymous hash. Place them using the calculated
    # grid positions. Numbering the buttons from zero makes things
    # more obvious when looking at the algorithms in the GridLayout
    # module. The buttons are dumb and do nothing when clicked.
    #
    foreach my $buttonNo ( 0 .. $numItems - 1 )
    {
        my $buttonName = q{Button_} . $buttonNo;
        $rhButtons->{ $buttonName } = $buttonFrame->Button(
           %commonButtonOpts,
           -text  => qq{Button $buttonNo},
           -width => 9,
           )->grid(
              -row    => $raButtonOrder->[ $buttonNo ]->[ 0 ],
              -column => $raButtonOrder->[ $buttonNo ]->[ 1 ],
              -padx   => 5,
              -pady   => 5,
              );
    }
}

# Subroutine to update the sorting direction text label.
#
#   ----------------
sub setDirectionText
#   ----------------
{
    ${ $rsDirectionText }
       = q{... sorting }
       . ( qw{ horizontally vertically } )[ $sortDirection ]
       . q{ ...};
}

# Subroutine to update the number of items text label.
#
#   ------------
sub setItemsText
#   ------------
{
    ${ $rsItemsText } = qq{... fit $numItems items ...};
}

# Subroutine to update the number of rows or columns text label.
#
#   ------------------
sub setRowColCountText
#   ------------------
{
    ${ $rsRowColCountText }
       = qq{... to $numRowsOrCols }
       . ( qw{ rows columns } )[ $rowsOrColumns ];
}

# Subroutine to update the arrange by rows or columns text label.
#
#   ------------------
sub setRowOrColumnText
#   ------------------
{
    ${ $rsRowColText }
       = q{By }
       . ( qw{ Rows Columns } )[ $rowsOrColumns ]
       . q{ ...};
}

[download]

I'm posting this in the hope that someone might find it useful.

Update: Corrected typo.

Cheers,

JohnGG

In reply to Routines to help place widgets using Tk "grid" GM by johngg

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others chilling in the Monastery: (2)
As of 2024-04-19 21:43 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found