view release on metacpan or  search on metacpan

lib/Tk/FormUI.pm  view on Meta::CPAN

sub show_once
{
  my $self   = shift;
  my $parent = shift;
  my $test   = shift;
  my $win;    ## Window widget
  my $result; ## Variable used to capture the result

  ## Create the window
  if ($parent)
  {
    ## Create as a TopLevel to the specified parent
    $win = $parent->TopLevel(-title => $self->title);
  }
  else
  {
    ## Create as a new MainWindow
    $win = MainWindow->new(-title => $self->title);
  }
  
  ## Hide the window
  $win->withdraw;
  
  ## Do not allow user to resize
  $win->resizable(0,0);

  ## Now use the grid geometry manager to layout everything
  my $grid_row = 0;
  
  ## See if we have a message
  if ($self->message)
  {
    ## Leave space for the message and a spacer
    ## but wait to create the widget
    $grid_row = 2;
  }

  my $first_field;
  ## Now add the fields
  foreach my $field (@{$self->fields})
  {
    ## See if the widget was created
    if (my $widget = $field->build_widget($win))
    {
      ## See if there's an error
      my $err = $field->error;
      if ($err)
      {
        ## Display the error message
        $win->Label(
          -text        => $err,
          -font        => $self->error_font,
          -anchor      => qq{w},
          -justify     => qq{left},
          -foreground  => $self->error_font_color,
        )
        ->grid(
          -row        => $grid_row++,
          -rowspan    => 1,
          -column     => 0,
          -columnspan => 2,
          -sticky     => qq{w},
        );
      }

      ## Create the label
      my $label = $field->build_label($win);
      
      ## See if there's an error
      if ($err)
      {
        ## Update the field's label to use the error marker, font,
        ## and font color
        $label->configure(
          -text        => $self->error_marker . qq{ } . $field->label . qq{:},
          -font        => $self->error_font,
          -foreground  => $self->error_font_color,
        );
      }
      
      ## Place the label
      $label->grid(
        -row        => $grid_row,
        -rowspan    => 1,
        -column     => 0,
        -columnspan => 1,
        -sticky     => qq{ne},
      );

      ## Place the widget
      $widget->grid(
        -row        => $grid_row,
        -rowspan    => 1,
        -column     => 1,
        -columnspan => 1,
        -sticky     => qq{w},
      );
      
      ## Increment the row index
      $grid_row++;
      
      ## See if this is our first non-readonly field
      if (!$first_field && !$field->readonly)
      {
        $first_field = $field;
      }
    }
  }
  
  ## Use an empty frame as a spacer 
  $win->Frame(-height => 5)->grid(-row => $grid_row++);
  
  ## Create the button
  my $button_text = $self->button_label;
  my $underline   = index($button_text, qq{&});
  $button_text =~ s/\&//gx; ## Remove the &
  $win->Button(
    -text      => $button_text,
    -font      => $self->button_font,
    -width     => length($button_text) + 2,
    -command   => sub {$result = 1;},
    -underline => $underline,
  )
  ->grid(
    -row        => $grid_row++,
    -rowspan    => 1,
    -column     => 0,
    -columnspan => 2,
    -sticky     => qq{},
  );
  
  ## Set the form's message
  $self->_set_message($win);
  
  $self->_watch_variable(\$result);
  
  ## Setup any keyboard bindings
  $self->_set_key_bindings($win);
  
  ## Calculate the geometry
  $self->_calc_geometry($win);

  ## Display the window
  $win->deiconify;
  
  ## Detect user closing the window
  $win->protocol('WM_DELETE_WINDOW',sub {$result = 0;});

  ## See if we are testing
  if ($test)
  {
    ## Make sure the string is the correct format
    if ($test =~ /TEST:\s+(\d)/x)
    {
      ## 0 == "CANCEL" 1 == "SUBMIT"
      $test = $1;
      
      ## Set a callback to close the window
      $win->after(1500, sub {$result = $test;});
    }
  }

  ## See if we have a first field specified
  if ($first_field)
  {
    if ($first_field->is_type($ENTRY))
    {
      ## If this is an entry field, select the entire string
      ## and place the cursor at the end of the string
      $first_field->widget->selectionRange(0, 'end');
      $first_field->widget->icursor('end');
    }
    
    ## Set the focus to the field
    $first_field->widget->focus();

  }
  ## Wait for variable to change
  $win->waitVariable(\$result);

  ## Hide the window
  $win->withdraw();
  
  ## Clear all errors until form data is validated again
  $self->clear_errors;
  
  if ($result)
  {

lib/Tk/FormUI.pm  view on Meta::CPAN

##----------------------------------------------------------------------------
##     @fn _set_message($win)
##  @brief Set the message at the top of the form's window
##  @param $win - Window object
## @return NONE
##   @note 
##----------------------------------------------------------------------------
sub _set_message
{
  my $self = shift;
  my $win  = shift;
  
  ## See if we have a message
  if ($self->message)
  {
    ## To keep the message from making the dialog box too
    ## large, we will look at the current window width and
    ## wrap the message accordingly
    
    ## Allow gemoetry manager to calculate all widgets
    $win->update;
    
    ## Determine number of rows and columns in the grid 
    my ($columns, $rows) = $win->gridSize();
    
    ## Use the dialog's minimum width as the starting point
    my $max_x = $self->min_width;
    
    ## Iterate through all rows and columns
    my $row = 0;
    while ($row < $rows)
    {
      my $col = 0;
      while ($col < $columns)
      {
        ## Get the bounding box of the widget
        my ($x, $y, $width, $height) = $win->gridBbox($col, $row);
        ## Get the max x of the widget
        $x += $width;
        ## See if this is larger than our current max x
        $max_x = $x if ($x > $max_x);
        
        ## Increment the colums
        $col++;
      }
      ## Increment the rows
      $row++;
    }
    
    ## Create a label widget
    $win->Label(
      -wraplength => $max_x,
      -text       => $self->message,
      -justify    => qq{left},
      -font       => $self->message_font,
    )
    ->grid(
      -row        => 0,
      -rowspan    => 1,
      -column     => 0,
      -columnspan => 2,
      -sticky     => qq{},
    );
    
    ## Use an empty frame as a spacer 
    $win->Frame(-height => 5)->grid(-row => 1);
  }
  
  return;
}



##****************************************************************************
##****************************************************************************

=head2 initialize($param)

=over 2

=item B<Description>

initialize the form from a HASH reference, JSON string, or JSON file.
In all cases, the hash should have the following format

  {
    title  => 'My Form',
    fields => [
      {
        type  => 'Entry',
        key   => 'name',
        label => 'Name',
      },
      {
        type  => 'Radiobutton',
        key   => 'sex',
        label => 'Gender',
        choices => [
          {
            label => 'Male',
            value => 'male',
          },
          {
            label => 'Female',
            value => 'female',
          },
        ],
      }
    ]
  }

=item B<Parameters>

$param - HASH reference, or scalar containin JSON string, or filename

=item B<Return>

NONE

=back