#!perl
# file form_dialog.pl

=begin comment

This is a demo to show how to create a Perl/Tk modal dialog box runnin
+g
from a button entry. This also uses the form layout/geometry manager.

Note that a few widget are positioned relative to the center of the di
+alog
box by computing the required width of the widget and then by taking h
+alf
of the widget and using that half-width to offset from the center of t
+he
dialog. If using the -left parameter for placement, the left edge of a
+ widget
will be to the right of that point. Therefore, it is necessary to shif
+t a
widget to the left of the center ('%50') by half of its width in order
+ to
give it the correct placement. The same can be done for vertical cente
+ring.

=cut

use Tk ;

use strict ;
use warnings ;

use Tk::Dialog ;
use Tk::Button ;

######################################################################

my $message = 'nothing yet ...' ;
my $w ;  #used for horizontal placement of widgets relative to form ce
+nter

######################################################################

  my $mw = MainWindow->new ;
  $mw->title('Opens a dialog box from button' ) ;

  $mw->geometry( "250x100" ) ;
  $mw->toplevel->iconbitmap( 'Status4.ico' ) ;

  my $input = $mw->Button(
    -text     => 'Press to input data!',
    -command  => \&demoDialog,
    -padx     => 5
  ) ;
  $w = -( $input->reqwidth()/2 ) ; #here's how to center a button

  $input->form(
    -top    => '%10',
    -left   => [ '%50', $w ]
  ) ;

  my $label = $mw->Label(
    -textvariable => \$message
  ) ;

  $label->form(
    -top  => [ $input, 10 ],
    -left => '%10'
  ) ;

  my $exit = $mw->Button(
    -text => 'Exit',
    -command => [$mw => 'destroy']
  ) ;
  $w = -( $exit->reqwidth()/2 ) ; #here's how to center a button

  $exit->form(
    -bottom => [ '%95' ],
    -left   => [ '%50', $w ]
  ) ;

######################################################################

MainLoop ;

######################################################################

sub demoDialog {

    #must use -buttons, otherwise an 'Ok' is automatically included in
+ the
    # dialog box
    #note that there appears to be no way to position these buttons at
+ the
    # bottom of a dialog box in the 'form' sense. They appear to be
    # amaturishly close to the bottom edge!
  my $dialog = $mw->Dialog(
    -bitmap         => 'question', 
    -title          => 'Demo of Form-based Dialog', 
    -default_button => 'Yes', 
    -buttons        => [ qw/Yes No Cancel/ ] 
  ) ;

  $dialog->geometry( "450x200" ) ;

  my $txt = $dialog->add(
    'Label',
    -text => "Yabba, Dabba"
  ) ;

  $txt->configure(
    -font => [
      -family     => 'Courier',
      -size       => 16,
      -weight     => 'bold',
        ]
    );
  $w = -( $txt->reqwidth()/2 ) ; #here's how to center a widget

  $txt->form(
    -bottom => '%50',
    -left   => [ '%50', $w ] #the $w value is negative, so it moves to
+ left of center
  ) ;

  my $lab = $dialog->add(
    'Label',
    -text => "label text"
  ) ;

  $lab->form( #this is a label that is right justified
    -top    => '%10',
    -right  => '%90'
  ) ;

  my $textent = undef ;
  my $ent = $dialog->add(
    'Entry',
    -textvariable => \$textent
  ) ;

  $ent->form( #a text entry positioned relative to the right edge of t
+he label
    -top    => $lab,
    -right  => [ '&', $lab ]
  ) ;

  my $bttn = $dialog->add(
    'Button',
    -text     => "important stuff",
    -padx     => 5,
    -command  => \&helper
  ) ;
  $w = -( $bttn->reqwidth()/2 ) ; #here's how to center a button

  $bttn->form(
    -bottom => '%90',
    -left   => [ '%50', $w ]
  ) ;

  my $answer = $dialog->Show( ) ;

  if( ! defined( $textent ) ) {
    $textent = "nada" ;
  }

  $message = qq{You pressed '$answer' and answered '$textent' } ;
}

sub helper {
  print "get help\n" ;
}
[download]