Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Routines to help place widgets using Tk "grid" GM

by johngg (Canon)
on Oct 20, 2020 at 10:51 UTC ( #11123018=CUFP: 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;

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{ ...}; }

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

Update: Corrected typo.

Cheers,

JohnGG

Replies are listed 'Best First'.
Re: Routines to help place widgets using Tk "grid" GM
by Anonymous Monk on Nov 24, 2020 at 22:46 UTC
    Hi JohnGG,

    What a great demonstration piece you've written! It clearly shows how Tk's "grid" works.
    The code executes perfectly on my Fedora 28 | ActivePerl 5.24.1 | Tk 804.034 system.

    I've used perlTk for many years; it's great to see it still in use. Thank you for this wonderful work.

    Cheers - Ron.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://11123018]
Front-paged by Discipulus
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (3)
As of 2020-11-28 16:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?