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