#!/usr/local/bin/perl -w # use strict; use warnings; use Tk; my $mainWin = MainWindow->new(); $mainWin->resizable(0, 0); $mainWin->title("Fit columns and rows"); my $rowsOrColumns = 1; my $rowColText; my $rowColFrame = $mainWin->Frame( -relief => "ridge", -borderwidth => 2)->pack( -side => "top", -fill => "y", -expand => 1); $rowColFrame->Label( -textvariable => \$rowColText, -relief => 'flat', -borderwidth => 2, -padx=> 5, -pady => 5)->pack( -side => 'top'); my $chooseRowColFrame = $rowColFrame->Frame( -relief => "flat", -borderwidth => 2)->pack( -side => "top", -fill => "y", -expand => 1); $chooseRowColFrame->Radiobutton( -text => "Rows", -width => 7, -value => 0, -variable => \$rowsOrColumns, -command => \&arrangeButtons)->pack( -side => "left", -padx => 5, -pady => 5); $chooseRowColFrame->Radiobutton( -text => "Columns", -width => 7, -value => 1, -variable => \$rowsOrColumns, -command => \&arrangeButtons)->pack( -side => "left", -padx => 5, -pady => 5); my $sortDirection = 0; my $directionText; my $directionFrame = $mainWin->Frame( -relief => "ridge", -borderwidth => 2)->pack( -side => "top", -fill => "y", -expand => 1); $directionFrame->Label( -textvariable => \$directionText, -relief => 'flat', -borderwidth => 2, -padx=> 5, -pady => 5)->pack( -side => 'top'); my $chooseDirectionFrame = $directionFrame->Frame( -relief => "flat", -borderwidth => 2)->pack( -side => "top", -fill => "y", -expand => 1); $chooseDirectionFrame->Radiobutton( -text => "Horizontal", -width => 10, -value => 0, -variable => \$sortDirection, -command => \&arrangeButtons)->pack( -side => "left", -padx => 5, -pady => 5); $chooseDirectionFrame->Radiobutton( -text => "Vertical", -width => 10, -value => 1, -variable => \$sortDirection, -command => \&arrangeButtons)->pack( -side => "left", -padx => 5, -pady => 5); my $numItems = 13; my $itemsText; my $itemCountFrame = $mainWin->Frame( -relief => "ridge", -borderwidth => 2)->pack( -side => "top", -fill => "y", -expand => 1); $itemCountFrame->Label( -textvariable => \$itemsText, -relief => 'flat', -borderwidth => 2, -padx=> 5, -pady => 5)->pack( -side => 'top'); my $chooseItemsFrame = $itemCountFrame->Frame( -relief => "flat", -borderwidth => 2)->pack( -side => "top", -fill => "y", -expand => 1); for (2 .. 27) { $chooseItemsFrame->Radiobutton( -text => "$_", -value => $_, -variable => \$numItems, -width => 3, -command => \&arrangeButtons)->grid( -row => (($_ - 2) / 5), -column => (($_ - 2) % 5), -padx => 5, -pady => 5); } my $numRowsOrCols = 2; my $rowColCountText; my $rowColCountFrame = $mainWin->Frame( -relief => "ridge", -borderwidth => 2)->pack( -side => "top", -fill => "y", -expand => 1); $rowColCountFrame->Label( -textvariable => \$rowColCountText, -relief => 'flat', -borderwidth => 2, -padx=> 5, -pady => 5)->pack( -side => 'top'); my $chooseColumnsFrame = $rowColCountFrame->Frame( -relief => "flat", -borderwidth => 2)->pack( -side => "top", -fill => "y", -expand => 1); for (2 .. 7) { $chooseColumnsFrame->Radiobutton( -text => "$_", -value => $_, -variable => \$numRowsOrCols, -command => \&arrangeButtons)->pack( -side => "left", -padx => 5, -pady => 5); } my $rhButtons = {}; my $buttonFrame = $mainWin->Frame( -relief => "ridge", -borderwidth => 2)->pack( -side => "top", -fill => "y", -expand => 1); my $controlButtonFrame = $mainWin->Frame( -relief => "flat", -borderwidth => 2)->pack( -side => "top"); $controlButtonFrame->Button( -text => "Quit", -background => "SlateBlue3", -activebackground => "turquoise1", -foreground => "yellow1", -command => sub {exit;})->pack( -side => "right", -padx => 5, -pady => 5); arrangeButtons(); MainLoop(); sub arrangeButtons { foreach my $button (values %$rhButtons) { $button->destroy() if Exists($button); } setRowOrColumnText(); setDirectionText(); setItemsText(); setRowColCountText(); my $rlButtonOrder = $rowsOrColumns ? ($sortDirection ? fitToColsVSort($numItems, $numRowsOrCols) : fitToColsHSort($numItems, $numRowsOrCols)) : ($sortDirection ? fitToRowsVSort($numItems, $numRowsOrCols) : fitToRowsHSort($numItems, $numRowsOrCols)); foreach my $buttonNo (1 .. $numItems) { my $buttonName = "Button_" . $buttonNo; $rhButtons->{$buttonName} = $buttonFrame->Button( -text => "Button $buttonNo", -width => 9)->grid( -row => $rlButtonOrder->[$buttonNo - 1]->[0], -column => $rlButtonOrder->[$buttonNo - 1]->[1], -padx => 5, -pady => 5); } } # -------------- sub fitToColsVSort # -------------- { my($numItems, $numCols) = @_; my $rlOrder = []; my $leftOver = $numItems % $numCols; my $maxRowNo = $numItems / $numCols + ($leftOver ? 1 : 0); my $rowNo = 0; my $colNo = 0; for (1 .. $numItems) { push @$rlOrder, [$rowNo, $colNo]; $rowNo ++; if($rowNo == $maxRowNo) { if($leftOver) { $leftOver --; $maxRowNo -- unless $leftOver; } $rowNo = 0; $colNo ++; } } return $rlOrder; } # -------------- sub fitToColsHSort # -------------- { my($numItems, $numCols) = @_; my $rlOrder = []; foreach my $item (0 .. ($numItems - 1)) { push @$rlOrder, [($item) / $numCols, ($item) % $numCols]; } return $rlOrder; } # -------------- sub fitToRowsVSort # -------------- { my($numItems, $numRows) = @_; my $rlOrder = []; foreach my $item (0 .. ($numItems - 1)) { push @$rlOrder, [($item) % $numRows, ($item) / $numRows]; } return $rlOrder; } # -------------- sub fitToRowsHSort # -------------- { my($numItems, $numRows) = @_; my $rlOrder = []; my $leftOver = $numItems % $numRows; my $maxColNo = $numItems / $numRows + ($leftOver ? 1 : 0); my $rowNo = 0; my $colNo = 0; for (1 .. $numItems) { push @$rlOrder, [$rowNo, $colNo]; $colNo ++; if($colNo == $maxColNo) { if($leftOver) { $leftOver --; $maxColNo -- unless $leftOver; } $colNo = 0; $rowNo ++; } } return $rlOrder; } # ------------------ sub setRowOrColumnText # ------------------ { $rowColText = "By " . (qw(Rows Columns))[$rowsOrColumns] . " ..."; } # ---------------- sub setDirectionText # ---------------- { $directionText = "... sorting " . (qw(horizontally vertically))[$sortDirection] . " ..."; } # ------------ sub setItemsText # ------------ { $itemsText = "... fit $numItems items ..."; } # ------------------ sub setRowColCountText # ------------------ { $rowColCountText = "... to $numRowsOrCols " . (qw(rows columns))[$rowsOrColumns]; }