1#!/usr/local/bin/perl
2#     This file is part of the McStas neutron ray-trace simulation package
3#     Copyright (C) 1997-2004, All rights reserved
4#     Risoe National Laborartory, Roskilde, Denmark
5#     Institut Laue Langevin, Grenoble, France
6#
7#     This program is free software; you can redistribute it and/or modify
8#     it under the terms of the GNU General Public License as published by
9#     the Free Software Foundation; version 2 of the License.
10#
11#     This program is distributed in the hope that it will be useful,
12#     but WITHOUT ANY WARRANTY; without even the implied warranty of
13#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14#     GNU General Public License for more details.
15#
16#     You should have received a copy of the GNU General Public License
17#     along with this program; if not, write to the Free Software
18#     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
19#
20# mcformatgui.pl - perl-Tk gui for mcformat tool.
21#
22
23use Cwd;
24use IPC::Open2;
25use File::Basename;
26use File::Path;
27use File::Copy;
28use File::Spec;
29use Time::localtime;
30use Tk::Balloon;
31use Config;
32use FileHandle;
33
34
35# Determine the path to the McStas system directory. This must be done
36# in the BEGIN block so that it can be used in a "use lib" statement
37# afterwards.
38BEGIN {
39    ENV_HEADER
40}
41
42use lib $MCSTAS::perl_dir;
43use lib $MCSTAS::perl_modules;
44require "mccode_config.perl";
45
46# Overload with user's personal config
47if ($ENV{"HOME"} && -e $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}."/".$MCSTAS::mcstas_config{'VERSION'}."/mccode_config.perl") {
48  print "mcformatgui: reading local $MCSTAS::mcstas_config{'MCCODE'} configuration from " . $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}."/".$MCSTAS::mcstas_config{'VERSION'}."/mccode_config.perl\n";
49  require $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}."/".$MCSTAS::mcstas_config{'VERSION'}."/mccode_config.perl";
50}
51
52my $dodisplay = 0;
53my $timeout = 5;
54my $show_help = 0;
55my $iformats = ['McStas','Matlab'];
56my $oformats;
57my $runmodes;
58my $iformat="McStas";
59my $oformat="McStas";
60my $runmode="Merge";
61my $inputdir;
62my $outputdir;
63my $oformats_iMcStas;
64my $runmodes_iMcStas = ['Convert','Merge','Scan assembly','Scan Merge'];
65my $runmodes_ilab = ['Convert'];
66my $recordlog=0;
67
68my $ext;
69my $filename = "";
70my $i;
71my $continue;
72
73my $iformat_crtl;
74my $oformat_line="";
75
76if ($MCSTAS::mcstas_config{'NEXUS'} ne "") {
77   $oformats_iMcStas = ['McStas','Matlab','IDL','HTML','XML','Octave','Python','Scilab','NeXus'];
78} else {
79   $oformats_iMcStas = ['McStas','Matlab','IDL','HTML','XML','Octave','Python','Scilab'];
80}
81
82my $cmd;
83my $logfile;
84my $date = time();
85$logfile = "mcformatgui_${date}.log";
86Tkgui();
87$iformat  = iformat_select($inputdir);
88my $fid;
89
90if ($recordlog) {
91  $logfile = "mcformatgui_${date}.log";
92  $fid = new FileHandle "> $logfile";
93  if (defined $fid) {
94    print $fid "# mcformatgui log file '$logfile'\n";
95    print $fid "# Directories: $inputdir \@ $iformat format -> $outputdir \@ $oformat format.\n";
96    print $fid "# Action: $runmode\n";
97
98    print "mcformatgui: Recording $inputdir -> $outputdir operations into log file '$logfile'\n";
99  }
100}
101
102if ($oformat_line !~ /binary/s) {
103    print "Input format is McStas, running mcformat to $runmode data. Output will go to $outputdir in $oformat...\n";
104    my $mode="";
105    if ($oformat =~ /IDL/i) { $oformat="IDL_binary"; }
106    if    ($runmode =~ /Scan assembly/i) { $mode="--scan-only"; }
107    elsif ($runmode =~ /Scan Merge/i)    { $mode="--scan"; }
108    elsif ($runmode =~ /merge/i)         { $mode="--merge"; }
109    if ($mode =~ /scan/i && $oformat !~ /McStas/i) {
110      my $ret = $w->messageBox(
111          -message => "For a Scan Operation ($mode)\n
112            The McStas/PGPLOT output format if prefered.\n
113            Other formats will not display correctly.\n
114            Press 'Yes' to export in McStas\n
115            or 'No' to keep $oformat.",
116          -title => "Scan operation: McStas prefered.",
117          -type => 'YesNo',
118          -icon => 'question',
119          -default => 'yes');
120        if (lc($ret) eq "yes") { $oformat="McStas"; }
121    }
122    $cmd="mcformat";
123    if ($Config{'osname'} eq 'MSWin32') { $cmd .= ".$MCSTAS::mcstas_config{'EXE'}"; }
124    $cmd.=" --format=$oformat --dir=$outputdir $inputdir $mode";
125} else {
126  print "mcformatgui: I do not have any appropriate method for conversion.\n";
127  print "ERROR        Try mcformat command manually.\n";
128  exit();
129}
130if ($recordlog && defined $fid) {
131  print $fid "# Command: $cmd\n\n";
132  $cmd .= ">> $logfile 2>&1 ";
133  close($fid);
134}
135print "Executing: $cmd\n";
136system("$cmd");
137
138sub Tkgui {
139    use Tk;
140    use Tk::Toplevel;
141    use Tk::DirTree;
142    $continue = 0;
143    my $win = new MainWindow(-title => "McFormatGui: Handle McStas datasets");
144    build_gui($win);
145    MainLoop;
146    if (!($continue == 1)) {
147	exit;
148    }
149}
150
151sub build_gui {
152    # When mcdaemon is run without any input parms, we'll build a gui
153    # to set the parameters.
154    my ($win) = @_;
155    my $topframe = $win->Frame(-relief => 'raised', -borderwidth => 2);
156    my $b = $win->Balloon(-state => 'balloon');
157    $topframe->pack(-side => "top", -fill => "both", -ipady => 3, -ipadx => 3);
158    my $tmp1 = $topframe->Label(-text => "Input dir(s):", -anchor => 'w',
159				     -justify => "center", -width => 15, -fg => 'blue')->pack(-side => "left");
160	  $b->attach($tmp1, -balloonmsg => "Data directory to convert");
161    $topframe->Entry(-width => 40, -relief => "sunken",
162				    -textvariable => \$inputdir)->pack(-side => "left");
163    my $dirselect = $topframe->Button(-text => "Select", -command => sub {
164        $inputdir = select_dir($inputdir);
165        $iformat  = iformat_select($inputdir);
166     })->pack(-side => "left");
167    $b->attach($dirselect, -balloonmsg => "Select an existing directory");
168
169    my $top2frame = $win->Frame(-relief => 'raised', -borderwidth => 2);
170    $top2frame->pack(-side => "top", -fill => "both", -ipady => 3, -ipadx => 3);
171    $tmp2 = $top2frame->Label(-text => "Output dir  :", -anchor => 'w',
172				     -justify => "center", -width => 15, -fg => 'blue')->pack(-side => "left");
173		$b->attach($tmp2, -balloonmsg => "Target directory\nfor converted data");
174    $top2frame->Entry(-width => 40, -relief => "sunken",
175		      -textvariable => \$outputdir)->pack(-side => "left");
176    my $dirselect = $top2frame->Button(-text => "Select", -command => sub {
177        $outputdir = select_dir($outputdir);
178        $outputdir = check_dir($win,$outputdir);
179      })->pack(-side => "left");
180    $b->attach($dirselect, -balloonmsg => "Select an existing directory\nor enter a new one");
181
182    my $midframe = $win->Frame(-relief => 'raised', -borderwidth => 2);
183    $midframe->pack(-side => "top", -fill => "both", -ipady => 3, -ipadx => 3);
184    $tmp3=$midframe->Label(-text => "Output format: ", -anchor => 'w',
185		     -justify => "center", -fg => 'blue')->pack(-side => "left");
186		$b->attach($tmp3, -balloonmsg => "Format for converted data");
187    $oformats = $oformats_iMcStas;
188    $oformat_ctrl = $midframe->Optionmenu(-textvariable => \$oformat, -options =>
189					 $oformats)->pack(-side => 'left');
190    $tmp4=$midframe->Label(-text => "Conversion mode: ", -anchor => 'w',
191		     -justify => "center", -fg => 'blue')->pack(-side => "left");
192		$b->attach($tmp4, -balloonmsg => "Convert: convert files one by one\nMerge: convert files and merge equivalent ones (e.g. clusters/grids)\nScan assembly: convert files and gather them in scan series\nScan merge: same as assembly, but also merge equivalent files");
193    $runmodes = $runmodes_iMcStas;
194    $runmode_ctrl = $midframe->Optionmenu(-textvariable => \$runmode, -options =>
195					 $runmodes)->pack(-side => 'left');
196
197    my $bottomframe = $win->Frame(-relief => 'raised', -borderwidth => 2);
198    $bottomframe->pack(-side => "top", -fill => "both", -ipady => 3, -ipadx => 3);
199    my $recordlog = $bottomframe->Checkbutton(-text => "Record Log file",-variable => \$recordlog)->pack(-side => 'left');
200    $b->attach($recordlog, -balloonmsg => "Records data handling operations into $logfile file");
201
202    $bottomframe->Button(-text => "Cancel", -fg => 'red', -command => sub {exit;})->pack(-side => "right", -anchor => "e");
203    $bottomframe->Button(-text => "Ok", -fg => 'green', -command => sub {
204	if ($inputdir && $outputdir) {
205	    $outputdir = check_dir($win,$outputdir);
206	    $continue=1; $win->destroy;
207	} else {
208	    $win->messageBox(
209			     -message => "You must select both an input and an output dir!",
210			     -title => "Problem:",
211			     -type => 'ok',
212			     -icon => 'error',
213			     -default => 'ok');
214	}
215    })->pack(-side => "right", -anchor => "w");
216}
217
218sub check_dir {
219    my ($win, $output) = @_;
220    if (-d $output && -e $output) {
221	$output = File::Spec->catfile( $output, "$date" );
222	$win->messageBox(
223			 -message => "For safety reasons I will create the subdir \n\n$output\n\n as final destination.\n\n ".
224			 "This directory does not exist now but will be created at runtime.\n",
225			 -title => "Notice: Directory exists",
226			 -type => 'ok',
227			 -icon => 'info',
228			 -default => 'ok');
229    }
230    return $output;
231}
232
233sub select_dir {
234    my ($start_dir) = @_;
235    my $top = new MainWindow;
236    $top->withdraw;
237
238    my $t = $top->Toplevel;
239    $t->title("Choose dir to monitor:");
240    my $ok = 0;
241    my $f = $t->Frame->pack(-fill => "x", -side => "bottom");
242
243    my $curr_dir;
244
245    if ($start_dir) {
246	$curr_dir = $start_dir;
247    } else {
248	$curr_dir = getcwd();
249    }
250
251    my $d;
252    $d = $t->Scrolled('DirTree',
253		      -scrollbars => 'osoe',
254		      -width => 35,
255		      -height => 20,
256		      -selectmode => 'browse',
257		      -exportselection => 1,
258		      -browsecmd => sub { $curr_dir = shift },
259		      -command   => sub { $ok = 1 },
260		      )->pack(-fill => "both", -expand => 1);
261    $f->Button(-text => 'Ok',
262	       -command => sub { $ok =  1 })->pack(-side => 'left');
263    $f->Button(-text => 'Cancel',
264	       -command => sub { $ok = -1 })->pack(-side => 'left');
265
266    $f->waitVariable(\$ok);
267
268    $top->destroy;
269
270    if ($ok == 1) {
271	return $curr_dir;
272    } else {
273	return $start_dir;
274    }
275
276}
277
278sub iformat_select {
279  my ($dir) = @_;
280  my $file = $dir;
281
282  # check input data directory
283  if (-d $file) { # check if dir containing result file
284    my $newfile = "$file/mcstas";
285    if (-e "$newfile.m" || -e "$newfile.sci" || -e "$newfile.sim" || -e "$newfile.html" || -e "$newfile.nxs" || -e "$newfile.pro" || -e "$newfile.xml") {
286      $file = $newfile; }
287  }
288
289  # look if there is only one file type and set iformat
290  if (-e "$file.m")    { $iformat = "Matlab";  $file = "$file.m"; }
291  if (-e "$file.sim")  { $iformat = "McStas";  $file = "$file.sim"; }
292  if (-e "$file.html") { $iformat = "HTML";    $file = "$file.html"; }
293  if (-e "$file.xml")  { $iformat = "XML";     $file = "$file.xml";  }
294  if (-e "$file.pro")  { $iformat = "IDL";     $file = "$file.pro"; }
295  if (-e "$file.nxs")  { $iformat = "NeXus";   $file = "$file.nxs"; }
296
297  if (open $handle, $file) {
298    while(<$handle>) {
299      if(/Format\s*(.*?)\s*$/i) {
300          $oformat_line = $1;
301      }
302    }
303    close($fid);
304    print "Input directory $dir presumably contains data in $iformat format.\n";
305    if ($oformat_line =~ /binary/i) { print "       It contains binary blocks.\n"; }
306  } else { print "mcformatgui: Warning: Could not open file '$file'. Conversion may fail.\n"; }
307
308  return($iformat);
309}
310