#!perl -w

use strict;

# This script is built for the Benchmark module.
use Benchmark qw(cmpthese);

# Import Tk modules
use Tk  800.005;
use Tk::Frame;
use Tk::TextUndo;
use Tk::Text;
use Tk::Entry;
use Tk::Label;
use Tk::Scrollbar;
use Tk::Adjuster;
use Tk::Menu;
use Tk::Menubutton;
use Tk::DialogBox;

# %tk holds refs to all the widgets
use vars qw/%tk/;

# Main Window
$tk{mw} = new MainWindow;
$tk{mw}->geometry('320x320');
Initialize_ui( $tk{mw} );
$tk{count} = 1000;

MainLoop;

sub OnRun
{
    my $supportcode = $tk{code_text}->get(0.1, 'end');
    chomp $supportcode;
    my $test1 = $tk{test1_text}->get(0.1,'end');
    chomp $test1;
    my $test2 = $tk{test2_text}->get(0.1,'end');
    chomp $test2;
    my $testcode    = "{".$test1.",".$test2.",}";
    my $count = $tk{count};

    $tk{output_text}->delete(0.1, 'end');
    my $widget = $tk{output_text}->Subwidget("text");
    tie *STDOUT, ref $widget, $widget;

    print "COUNT=",$count,"\n";
    print "TEST CODE:\n",$testcode,"\n";
    print "SUPPORT CODE:\n",$supportcode,"\n";
    print "RESULTS:\n";
    
    eval (qq($supportcode
         cmpthese($count, $testcode  );
         ));
    print "ERROR: ", $@ if ($@);
}

sub OnClear {
    $tk{count} = 1000;
    $tk{test1_text }->delete(0.1, 'end');
    $tk{test2_text }->delete(0.1, 'end');
    $tk{code_text  }->delete(0.1, 'end');
    $tk{output_text}->delete(0.1, 'end');
}

sub Initialize_ui {
    # $root is a ref to the MainWindow
    my($root) = @_;

    # create widgets
    $tk{toolbar_frame} = $root->Frame ();
    $tk{Clear} = $root->Button (
                  -text => 'Clear',
                  -command => \&OnClear,
                  );
    $tk{Run} = $root->Button (
                  -text => 'Run',
                  -command => \&OnRun,
                  );
    $tk{count_label} = $root->Label (
                     -text => 'count',
                     );
    $tk{count_entry} = $root->Entry (
                     -textvariable => \$tk{count},
                     );
    $tk{test1_label} = $root->Label (
                     -text => 'test1',
                     );
    $tk{test1_text} = $root->Scrolled(
                      'TextUndo',
                      -scrollbars => 'e',
                      -height => '1',
                      -width => '1',
                      );
    $tk{test2_label} = $root->Label (
                     -text => 'test2',
                     );
    $tk{test2_text} = $root->Scrolled(
                      'TextUndo',
                      -scrollbars => 'e',
                      -height => '1',
                      -width => '1',
                      );
    $tk{code_label} = $root->Label (
                    -text => 'code',
                    );
    $tk{code_text} = $root->Scrolled(
                     'TextUndo',
                     -scrollbars => 'e',
                     -height => '1',
                     -width => '1',
                     );
    $tk{adjuster} = $root->Adjuster(
                    -widget => $tk{code_text},
                    -side  => 'top',
                    );
    $tk{output_label} = $root->Label (
                      -text => 'output',
                      );
    $tk{output_text} = $root->Scrolled(
                       'Text',
                       -scrollbars => 'e',
                       -height => '1',
                       -width => '1',
                       );

    # Layout management
    $tk{toolbar_frame}->grid(
                 -in => $root,
                 -column => '2',
                 -row => '1',
                 -sticky => 'nw',
                 );
    $tk{Clear}->grid(
           -in => $tk{toolbar_frame},
           -column => '1',
           -row => '1',
           -sticky => 'nw',
           );
    $tk{Run}->grid(
           -in => $tk{toolbar_frame},
           -column => '2',
           -row => '1',
           -sticky => 'nw',
           );
    $tk{count_label}->grid(
               -in => $root,
               -column => '1',
               -row => '2',
               -sticky => 'nw',
               );
    $tk{count_entry}->grid(
               -in => $root,
               -column => '2',
               -row => '2',
               -sticky => 'nw',
               );
    $tk{test1_label}->grid(
               -in => $root,
               -column => '1',
               -row => '3',
               -sticky => 'nw',
               );
    $tk{test1_text}->grid(
              -in => $root,
              -column => '2',
              -row => '3',
              -sticky => 'nesw',
              );
    $tk{test2_label}->grid(
               -in => $root,
               -column => '1',
               -row => '4',
               -sticky => 'nw',
               );
    $tk{test2_text}->grid(
              -in => $root,
              -column => '2',
              -row => '4',
              -sticky => 'nesw',
              );
    $tk{code_label}->grid(
              -in => $root,
              -column => '1',
              -row => '5',
              -sticky => 'nw',
              );
    $tk{code_text}->grid(
             -in => $root,
             -column => '2',
             -row => '5',
             -sticky => 'nesw',
             );
    $tk{adjuster}->grid(
             -in => $root,
             -column => '2',
             -row => '6',
             -sticky => 'ew',
            );
    $tk{output_label}->grid(
                -in => $root,
                -column => '1',
                -row => '7',
                -sticky => 'nw',
                );
    $tk{output_text}->grid(
               -in => $root,
               -column => '2',
               -row => '7',
               -sticky => 'nesw',
               );

    # Resize behavior management

    # container $root (rows)
    $root->gridRowconfigure(1, -weight  => 0, -minsize  => 9);
    $root->gridRowconfigure(2, -weight  => 0, -minsize  => 9);
    $root->gridRowconfigure(3, -weight  => 0, -minsize  => 30);
    $root->gridRowconfigure(4, -weight  => 0, -minsize  => 30);
    $root->gridRowconfigure(5, -weight  => 1, -minsize  => 45);
    $root->gridRowconfigure(6, -weight  => 0, -minsize  => 20);
    $root->gridRowconfigure(7, -weight  => 1, -minsize  => 60);

    # container $root (columns)
    $root->gridColumnconfigure(1, -weight => 0, 
                               -minsize => 2);
    $root->gridColumnconfigure(2, -weight => 1, 
                               -minsize => 130);

    # container $tk{toolbar_frame} (rows)
    $tk{toolbar_frame}->gridRowconfigure(1, -weight  => 0, 
                                         -minsize  => 24);

    # container $tk{toolbar_frame} (columns)
    $tk{toolbar_frame}->gridColumnconfigure(1, -weight => 0, 
                                            -minsize => 30);
    $tk{toolbar_frame}->gridColumnconfigure(2, -weight => 0, 
                                            -minsize => 30);
}

1;

__END__

[download]

In reply to Tk Quick Benchmark Tool by hiseldl

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


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.