source: LMDZ5/trunk/tools/fcm/bin/fcm_gui_internal @ 3301

Last change on this file since 3301 was 1578, checked in by jghattas, 13 years ago
  • Add fcm in LMDZ5/tools directory

It is no longer needed to have fcm in your environement PATH variable.
Now makelmdz_fcm takes by default this fcm. It is still possible to use
another fcm, using -fcm_path argument in makelmdz_fcm.

  • Property svn:executable set to *
File size: 6.8 KB
Line 
1#!/usr/bin/perl
2# ------------------------------------------------------------------------------
3# NAME
4#   fcm_gui_internal
5#
6# SYNOPSIS
7#   fcm_gui_internal POS FUNCTION
8#
9# DESCRIPTION
10#   The fcm_gui_internal command is part of a simple graphical user interface
11#   for some of the commands of the FCM system. The argument POS is a geometry
12#   string used by the &Main::get_input method to determine the location of the
13#   pop up window. The argument FUNCTION must be a keyword recognised by the
14#   &Fcm::Cm::cm_command function.
15#
16# COPYRIGHT
17#   (C) Crown copyright Met Office. All rights reserved.
18#   For further details please refer to the file COPYRIGHT.txt
19#   which you should have received as part of this distribution.
20# ------------------------------------------------------------------------------
21
22# Standard pragmas
23use warnings;
24use strict;
25
26# Standard modules
27use Tk;
28use File::Basename;
29use File::Spec::Functions;
30
31# FCM component modules:
32use lib catfile (dirname (dirname ($0)), 'lib');
33use Fcm::Cm;
34use Fcm::Config;
35
36# ------------------------------------------------------------------------------
37
38# Get configuration settings
39my $config = Fcm::Config->new ();
40$config->get_config ();
41
42my $pos      = shift @ARGV;
43my $function = shift @ARGV;
44cm_command $function;
45
46# ------------------------------------------------------------------------------
47# SYNOPSIS
48#   $cfg = &main::cfg ();
49#
50# DESCRIPTION
51#   Return the $config variable.
52# ------------------------------------------------------------------------------
53
54sub cfg {
55  return $config;
56}
57
58# ------------------------------------------------------------------------------
59# SYNOPSIS
60#   $ans = &main::get_input (
61#     TITLE   => $title,
62#     MESSAGE => $mesg,
63#     TYPE    => $type,
64#     DEFAULT => $def,
65#   );
66#
67# DESCRIPTION
68#   Get an input string from the user and return it as $ans. If TYPE is 'YN', a
69#   'YesNo' type message box will be displayed to prompt the user to click
70#   either the 'yes' or 'no' button. If TYPE is 'YNA', then an 'all' button is
71#   provided as a third option. Otherwise, a dialog box with an entry box for
72#   the user to type in a string will be displayed. TITLE is the title of the
73#   dialog box, and MESSAGE is the main message of the dialog box. If DEFAULT is
74#   set, $ans is set to the default value when the dialog box is invoked.
75# ------------------------------------------------------------------------------
76
77sub get_input {
78  my %args  = @_;
79  my $title = exists $args{TITLE}   ? $args{TITLE}   : '';
80  my $mesg  = exists $args{MESSAGE} ? $args{MESSAGE} : '';
81  my $type  = exists $args{TYPE}    ? $args{TYPE}    : '';
82  my $def   = exists $args{DEFAULT} ? $args{DEFAULT} : '';
83  my $ans   = '';
84
85  # Create a main window
86  my $mw = MainWindow->new;
87  $mw->title ($title);
88
89  # Define the default which applies if the dialog box is just closed or
90  # the user selects 'cancel'
91  $ans = $def ? $def : '';
92
93  if ($type =~ /^yn/i) {
94    # Create a yes-no(-all) dialog box
95
96    # If TYPE is YNA then add a third button: 'all'
97    my $buttons;
98    if ($type =~ /a$/i) {
99      $buttons = 3;
100
101    } else {
102      $buttons = 2;
103    }
104
105    # Message of the dialog box
106    $mw->Label ('-text' => $mesg)->grid (
107      '-row'        => 0,
108      '-column'     => 0,
109      '-columnspan' => $buttons,
110      '-padx'       => 10,
111      '-pady'       => 10,
112    );
113
114    # The "yes" button
115    my $y_b = $mw->Button (
116      '-text'      => 'Yes',
117      '-underline' => 0,
118      '-command'   => sub {$ans = 'y'; $mw->destroy},
119    )->grid (
120      '-row'    => 1,
121      '-column' => 0,
122      '-padx'   => 5,
123      '-pady'   => 5,
124    );
125
126    # The "no" button
127    my $n_b = $mw->Button (
128      '-text'      => 'No',
129      '-underline' => 0,
130      '-command'   => sub {$ans = 'n'; $mw->destroy},
131    )->grid (
132      '-row'    => 1,
133      '-column' => 1,
134      '-padx'   => 5,
135      '-pady'   => 5,
136    );
137
138    # The "all" button
139    my $a_b;
140    if ($buttons == 3) {
141      $a_b = $mw->Button (
142        '-text'      => 'All',
143        '-underline' => 0,
144        '-command'   => sub {$ans = 'a'; $mw->destroy},
145      )->grid (
146        '-row'    => 1,
147        '-column' => 2,
148        '-padx'   => 5,
149        '-pady'   => 5,
150      );
151    }
152
153    # Keyboard binding
154    if ($buttons == 3) {
155      $mw->bind ('<Key>' => sub {
156        if ($Tk::event->K eq 'Y' or $Tk::event->K eq 'y') {
157          $y_b->invoke;
158
159        } elsif ($Tk::event->K eq 'N' or $Tk::event->K eq 'n') {
160          $n_b->invoke;
161
162        } elsif ($Tk::event->K eq 'A' or $Tk::event->K eq 'a') {
163          $a_b->invoke;
164        }
165      });
166
167    } else {
168      $mw->bind ('<Key>' => sub {
169        if ($Tk::event->K eq 'Y' or $Tk::event->K eq 'y') {
170          $y_b->invoke;
171
172        } elsif ($Tk::event->K eq 'N' or $Tk::event->K eq 'n') {
173          $n_b->invoke;
174        }
175      });
176    }
177
178    # Handle the situation when the user attempts to quit the window
179    $mw->protocol ('WM_DELETE_WINDOW', sub {
180      $ans = $def if $def;
181      $mw->destroy;
182    });
183
184  } else {
185    # Create a dialog box to obtain an input string
186
187    # Message of the dialog box
188    $mw->Label ('-text' => $mesg)->grid (
189      '-row'    => 0,
190      '-column' => 0,
191      '-padx'   => 5,
192      '-pady'   => 5,
193    );
194
195    # Entry box for the user to type in the input string
196    my $entry   = $ans;
197    my $input_e = $mw->Entry (
198      '-textvariable'    => \$entry,
199      '-width'           => 40,
200    )->grid (
201      '-row'    => 0,
202      '-column' => 1,
203      '-sticky' => 'ew',
204      '-padx'   => 5,
205      '-pady'   => 5,
206    );
207
208    my $b_f = $mw->Frame->grid (
209      '-row'        => 1,
210      '-column'     => 0,
211      '-columnspan' => 2,
212      '-sticky'     => 'e',
213    );
214
215    # An OK button to accept the input string
216    my $ok_b = $b_f->Button (
217      '-text' => 'OK',
218      '-command' => sub {$ans = $entry; $mw->destroy},
219    )->grid (
220      '-row'        => 0,
221      '-column'     => 0,
222      '-padx'       => 5,
223      '-pady'       => 5,
224    );
225
226    # A Cancel button to reject the input string
227    my $cancel_b = $b_f->Button (
228      '-text' => 'Cancel',
229      '-command' => sub {$ans = undef; $mw->destroy},
230    )->grid (
231      '-row'        => 0,
232      '-column'     => 1,
233      '-padx'       => 5,
234      '-pady'       => 5,
235    );
236
237    # Keyboard binding
238    $mw->bind ('<Key>' => sub {
239      if ($Tk::event->K eq 'Return' or $Tk::event->K eq 'KP_Enter') {
240        $ok_b->invoke;
241
242      } elsif ($Tk::event->K eq 'Escape') {
243        $cancel_b->invoke;
244      }
245    });
246
247    # Allow the entry box to expand
248    $mw->gridColumnconfigure (1, '-weight' => 1);
249
250    # Set initial focus on the entry box
251    $input_e->focus;
252    $input_e->icursor ('end');
253  }
254
255  $mw->geometry ($pos);
256
257  # Switch on "always on top" property for $mw
258  $mw->property (
259    qw/set _NET_WM_STATE ATOM/,
260    32,
261    ['_NET_WM_STATE_STAYS_ON_TOP'],
262    ($mw->toplevel->wrapper)[0],
263  );
264
265  MainLoop;
266
267  return $ans;
268}
269
270# ------------------------------------------------------------------------------
271
272__END__
Note: See TracBrowser for help on using the repository browser.