#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11136705
use warnings;
use Tk;
use Tk::Pane;

my ($rows, $columns) = (70, 20);
my $sbsize = 22;

my $mw = MainWindow->new();

# example of ->pack in a different Frame

my $buttonbar = $mw->Frame(-bg => 'blue',
  )->pack(-fill => 'x');
$buttonbar->Button(-text => 'Exit', -command => sub{$mw->destroy},
  )->pack(-side => 'right', -fill => 'x', -expand => 1);
$buttonbar->Button(-text => 'Set Size', -command => \&setsize,
  )->pack(-side => 'right', -fill => 'x', -expand => 1);
$buttonbar->Button(-text => 'Remove Column',
  -command => sub{$columns--; changegrid(); setsize(); },
  )->pack(-side => 'right', -fill => 'x', -expand => 1);
$buttonbar->Button(-text => 'Add Column',
  -command => sub{$columns++; changegrid(); setsize(); },
  )->pack(-side => 'right', -fill => 'x', -expand => 1);
$buttonbar->Button(-text => 'Remove Row',
  -command => sub{$rows--; changegrid(); setsize(); },
  )->pack(-side => 'right', -fill => 'x', -expand => 1);
$buttonbar->Button(-text => 'Add Row',
  -command => sub{$rows++; changegrid(); setsize(); },
  )->pack(-side => 'right', -fill => 'x', -expand => 1);

my ($screenw, $screenh) = ($mw->screenwidth, $mw->screenheight);
print "w $screenw h $screenh\n";
$mw->maxsize($screenw, $screenh);

#$mw->maxsize(1000,1200);
#$mw->minsize(400,300);

my $scroll = $mw->Scrolled('Pane',
                         -scrollbars => 'osoe',
                         -sticky => 'news',
  )->pack(-expand => 1, -fill => 'both');

my $f = $scroll->Frame->pack(-expand => 1, -fill => 'both');
changegrid();
$mw->update;
setsize();

MainLoop;
-M $0 < 0 and exec $0; # FIXME for testing

sub setsize
  {
  $mw->update;
  my( $mwh, $sh, $fh) = map $_->height, $mw, $scroll, $f;
  my( $mww, $sw, $fw) = map $_->width, $mw, $scroll, $f;
  my( $mwrh, $srh, $frh) = map $_->reqheight, $mw, $scroll, $f;
  my( $mwrw, $srw, $frw) = map $_->reqwidth, $mw, $scroll, $f;
  my $deltaheight = $sh - $frh;
  my $deltawidth = $sw - $frw;

  print "height $mwh $mwrh $sh $srh $fh $frh\n";
  print " width $mww $mwrw $sw $srw $fw $frw\n";
  print "delta h $deltaheight w $deltawidth\n";
  my $geo = $mw->geometry;
  my ($w, $h) = split /\D/, $geo;
  my $newgeo = ($w - $deltawidth + $sbsize + 10) .
    'x' . ($h - $deltaheight + $sbsize);
  print "old $geo new $newgeo\n";
  $mw->geometry( $newgeo );
  }

sub changegrid
  {
  $_->destroy for $f->children;
  foreach my $row (0..$rows - 1)
    {
    foreach my $col (0..$columns - 1)
      {
      $f->Entry(
        -text => "rc $row $col",
        -width => 0,
        )->grid(-row => $row, -column => $col, -sticky => 'news');
      $row or $f->gridColumnconfigure($col, -weight => 1);
      }
    $f->gridRowconfigure($row, -weight => 1);
    }
  }