1#!/usr/local/bin/perl 2# 3# Implements graphical user interface for McStas 4# 5# 6# This file is part of the McStas neutron ray-trace simulation package 7# Copyright (C) 1997-2008, All rights reserved 8# Risoe National Laborartory, Roskilde, Denmark 9# Institut Laue Langevin, Grenoble, France 10# 11# This program is free software; you can redistribute it and/or modify 12# it under the terms of the GNU General Public License as published by 13# the Free Software Foundation; version 2 of the License. 14# 15# This program is distributed in the hope that it will be useful, 16# but WITHOUT ANY WARRANTY; without even the implied warranty of 17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18# GNU General Public License for more details. 19# 20# You should have received a copy of the GNU General Public License 21# along with this program; if not, write to the Free Software 22# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23 24# Config module needed for various platform checks. 25# PW, 20030314 26use Config; 27use Tk::Balloon; 28use POSIX qw(_exit); 29 30# Determine the path to the McStas system directory. This must be done 31# in the BEGIN block so that it can be used in a "use lib" statement 32# afterwards. 33BEGIN { 34 ENV_HEADER 35} 36 37use lib $MCSTAS::perl_dir; 38use lib $MCSTAS::perl_modules; 39require "mccode_config.perl"; 40 41# Overload with user's personal config 42if ($ENV{"HOME"} && -e $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}."/".$MCSTAS::mcstas_config{'VERSION'}."/mccode_config.perl") { 43 print "$0: reading local $MCSTAS::mcstas_config{'MCCODE'} configuration from " . $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}."/".$MCSTAS::mcstas_config{'VERSION'}."/mccode_config.perl\n"; 44 require $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}."/".$MCSTAS::mcstas_config{'VERSION'}."/mccode_config.perl"; 45} 46 47use strict; 48use FileHandle; 49use Tk; 50use Tk::TextUndo; 51use Tk::ROText; 52use Tk::DialogBox; 53use File::Path; 54 55require "mcfrontlib.pl"; 56require "mcguilib.pl"; 57# Requirement for mcplotlib.pl removed, will be loaded only 58# if mcdisplay PGPLOT backend is used. 59# PW, 20030314 60# require "mcplotlib.pl"; 61require "mcrunlib.pl"; 62 63my $kill_when_editor_exits = 0; 64my $current_sim_file; 65my $current_sim_def = ""; 66my ($inf_instr, $inf_sim, $inf_data); 67my %inf_param_map; 68 69my ($main_window,$edit_window, $edit_control, $edit_label); 70my ($status_label, $current_results_label, $cmdwin, $current_instr_label, $workdir); 71 72my $prefix = $MCSTAS::mcstas_config{'PREFIX'}; 73my $suffix = $MCSTAS::mcstas_config{'SUFFIX'}; 74my $background; # Only really makes sense on Unix systems... 75my $detach = 0; 76if ($Config{'osname'} ne 'MSWin32') { 77 $background = '&'; 78} 79 80my %shortcuts; 81# Gui shortcut setup, different for OS X, Unix, Win32 82if ($Config{'osname'} eq 'darwin') { 83 $shortcuts{'menuopen'} = '<Meta-o>'; 84 $shortcuts{'menurun'} = '<Meta-u>'; 85 $shortcuts{'menuplot'} = '<Meta-p>'; 86 # These ones are not too obvious, Meta-C and Meta-M taken by general 87 # OS bindings, Meta-s causing problems... 88 $shortcuts{'menuprefs'} = '<Meta-F1>'; 89 $shortcuts{'insertcomp'} = '<Meta-F2>'; 90 $shortcuts{'menusave'} = '<Meta-F3>'; 91 # This one is implicit 92 $shortcuts{'menuquit'} = '<Meta-w>'; 93 $shortcuts{'cut'} = '<Ctrl-x>'; 94 $shortcuts{'copy'} = '<Ctrl-c>'; 95 $shortcuts{'paste'} = '<Ctrl-v>'; 96} else { 97 $shortcuts{'insertcomp'} = '<Alt-m>'; 98 $shortcuts{'menuopen'} = '<Alt-o>'; 99 $shortcuts{'menurun'} = '<Alt-u>'; 100 $shortcuts{'menuplot'} = '<Alt-p>'; 101 $shortcuts{'menuprefs'} = '<Alt-c>'; 102 $shortcuts{'menusave'} = '<Alt-s>'; 103 $shortcuts{'menuquit'} = '<Alt-q>'; 104 $shortcuts{'cut'} = '<Ctrl-x>'; 105 $shortcuts{'copy'} = '<Ctrl-c>'; 106 $shortcuts{'paste'} = '<Ctrl-v>'; 107} 108 109my $external_editor = $MCSTAS::mcstas_config{'EXTERNAL_EDITOR'}; 110our $quote=0; # default editor behaviour is to NOT surround strings with quotes 111$MCSTAS::mcstas_config{'CFLAGS_SAVED'} = $MCSTAS::mcstas_config{'CFLAGS'}; 112$MCSTAS::mcstas_config{'CFLAGS'} = '' unless $MCSTAS::mcstas_config{'MCGUI_CFLAGS'}; 113 114my $compinfo; # Cache of parsed component definitions 115my @compdefs; # List of available component definitions 116 117# Our own Tk:Error function, to trap errors in TextUndo->Save(). See 118# Tk documentation of Tk::Error. 119my $error_override; # Temporary override Tk::Error. 120sub Tk::Error { 121 my ($w, $err, @loc) = @_; 122 if($error_override) { 123 &$error_override($w, $err, @loc); 124 } else { 125 print STDERR "Tk::Error###: $err "; 126 print STDERR join("\n ", @loc), "\n"; 127 } 128} 129 130 131sub ask_save_before_simulate { 132 my ($w) = @_; 133 if($edit_control && $edit_control->numberChanges() > 0) { 134 my $ret = $w->messageBox( 135 -message => "Save instrument \"$current_sim_def\" first?", 136 -title => "Save file?", 137 -type => 'YesNoCancel', 138 -icon => 'question', 139 -default => 'yes'); 140 menu_save($w) if lc($ret) eq "yes"; 141 return $ret eq "Cancel" ? 0 : 1; 142 } else { 143 return 1; 144 } 145} 146 147sub is_erase_ok { 148 my ($w) = @_; 149 if($edit_control && $edit_control->numberChanges() > 0) { 150 my $ret = $w->messageBox(-message => "Ok to lose changes?", 151 -title => "Erase ok?", 152 -type => 'okcancel', 153 -icon => 'question', 154 -default => 'cancel'); 155 # Make response all lowercase: 156 $ret = lc($ret); 157 return $ret eq "ok" ? 1 : 0; 158 } else { 159 return 1; 160 } 161} 162 163sub menu_quit { 164 if(is_erase_ok($main_window)) { 165 # save log of session 166 if($current_sim_def) { 167 my $file; 168 my ($inidir, $inifile); 169 if($current_sim_def =~ m!^(.*)/([^/]*)$!) { 170 ($inidir, $inifile) = ($1, $2); 171 } else { 172 ($inidir, $inifile) = ("", $current_sim_def); 173 } 174 $inifile =~ s/\.instr$//; 175 my $date = localtime(time()); 176 $inifile .= "_${date}.log"; 177 $inifile =~ s!\ !_!g; 178 $file = $inidir . $inifile; 179 my $outputtext = $cmdwin->get('1.0', 'end'); 180 putmsg($cmdwin, "Save log file $file\n"); 181 open(MCLOG,">>$file"); 182 print MCLOG "# Log file $file generated by McStas/mcgui\n"; 183 print MCLOG "# Date: $date\n"; 184 print MCLOG "# Current instrument: $current_sim_def\n"; 185 print MCLOG "# Current results: $current_sim_file\n"; 186 print MCLOG "$outputtext"; 187 close(MCLOG); 188 } 189 $main_window->destroy; 190 } 191} 192 193sub menu_edit_current { 194 if($edit_control) { 195 $edit_window->raise(); 196 } else { 197 my $tkwin; 198 if ($MCSTAS::mcstas_config{'EDITOR'} eq 0 || $MCSTAS::mcstas_config{'EDITOR'} eq 1) { 199 $tkwin = $main_window->Toplevel; 200 eval { # Try CodeText editor first 201 setup_edit($main_window,$tkwin); 202 }; 203 if ($@) { # or revert to old-school editor if that failed. 204 printf "Starting Tk::CodeText based editor failed. Using simpler McStas 1.7 style editor\n"; 205 setup_edit_1_7($main_window,$tkwin); 206 } 207 } elsif ($MCSTAS::mcstas_config{'EDITOR'} eq 1 && $MCSTAS::mcstas_config{'CODETEXT'}) { 208 209 } else { 210 menu_spawn_editor($main_window); 211 } 212 } 213} 214 215sub menu_spawn_editor { 216 my ($w) = @_; 217 my $cmd = "$external_editor $current_sim_def"; 218 if ($external_editor eq "no") { return 0; } 219 # Must be handled differently on Win32 vs. unix platforms... 220 spawn_external($w,$cmd); 221} 222 223sub menu_spawn_internal_editor { 224 my ($w) = @_; 225 my $cmd = "mcgui$suffix --edit $current_sim_def"; 226 if ($external_editor eq "no") { return 0; } 227 # Must be handled differently on Win32 vs. unix platforms... 228 spawn_external($w,$cmd); 229} 230 231 232sub menu_spawn_mcdaemon { 233 my ($w) = @_; 234 my $cmd = "mcdaemon$suffix"; 235 spawn_external($w,$cmd); 236} 237 238sub menu_spawn_mcformatgui { 239 my ($w) = @_; 240 my $cmd = "mcformatgui$suffix"; 241 spawn_external($w,$cmd); 242} 243 244 245sub menu_spawn_mcplot { 246 my ($w) = @_; 247 my $file = $w->getOpenFile(-title => "Select simulation file", -initialdir => getcwd()); 248 if ($file == 0) { 249 my $cmd = "$MCSTAS::mcstas_config{'PLOTCMD'} $file"; 250 spawn_external($w,$cmd); 251 } 252} 253 254sub spawn_external { 255 # Procedure to put external processes in the background 256 my ($w, $cmd) = @_; 257 my $pid; 258 if($Config{'osname'} eq "MSWin32") { 259 system("start $cmd"); 260 } else { 261 $pid = fork(); 262 if(!defined($pid)) { 263 $w->messageBox(-message => 264 "Failed to spawn command \"$cmd\".", 265 -title => "Command failed", 266 -type => 'OK', 267 -icon => 'error'); 268 return 0; 269 } elsif($pid > 0) { 270 waitpid($pid, 0); 271 return 1; 272 } else { 273 # Double fork to avoid having to wait() for the command to 274 # finish (or having it become a zombie). See man perlfunc. 275 unless(fork()) { 276 exec("$cmd"); 277 # If we get here, the exec() failed. 278 print STDERR "Error: exec() of command $cmd failed!\n"; 279 POSIX::_exit(1); # CORE:exit needed to avoid Perl/Tk failure. 280 } 281 POSIX::_exit(0); # CORE:exit needed to avoid Perl/Tk failure. 282 } 283 } 284} 285 286sub mcdoc_current { 287 my $cmd = "$prefix mcdoc$suffix $current_sim_def $background"; 288 if (-e $current_sim_def) { 289 putmsg($cmdwin, "Opening instrument docs: $cmd\n", 'msg'); 290 system("$cmd"); 291 } 292} 293sub mcdoc_web { 294 my $cmd = "$prefix mcdoc$suffix --web $background"; 295 putmsg($cmdwin, "Opening Web Page: $cmd\n", 'msg'); 296 system("$cmd"); 297} 298 299sub mcdoc_manual { 300 my $cmd = "$prefix mcdoc$suffix --manual $background"; 301 putmsg($cmdwin, "Opening User Manual: $cmd\n", 'msg'); 302 system("$cmd"); 303} 304 305sub mcdoc_compman { 306 my $cmd = "$prefix mcdoc$suffix --comp $background"; 307 putmsg($cmdwin, "Opening Component Manual: $cmd\n", 'msg'); 308 system("$cmd"); 309} 310 311sub mcdoc_components { 312 my $cmd = "$prefix mcdoc$suffix $background"; 313 putmsg($cmdwin, "Opening Library help: $cmd\n", 'msg'); 314 system("$cmd"); 315} 316 317sub mcdoc_generate { 318 my $cmd = "$prefix mcdoc$suffix --force $background"; 319 putmsg($cmdwin, "Generating Library help (local): $cmd\n", 'msg'); 320 system("$cmd"); 321} 322 323sub mcdoc_test { 324 my $status; 325 my $printer = sub { putmsg($cmdwin, "$_[0]\n", 'msg'); $main_window->update;}; 326 $status = do_test($printer, 1, $MCSTAS::mcstas_config{'PLOTTER'}, 'compatible graphics','',0,'1e6','BNL_H8.instr'); 327 if (defined $status) { putmsg($cmdwin, "$status", 'msg'); } 328} 329 330sub tools_shortcuts { 331 my ($w) = @_; 332 333 $w->fontCreate('small', 334 -family=>'Helvetica', 335 -weight=>'normal', 336 -size=>12); 337 my $msg="mcgui has platform dependent shorcut keys.\n\nOn this machine ". 338 "(OS type $Config{'osname'}) they are:\n\n". 339 "$shortcuts{'menuopen'} - Open instrument file\n". 340 "$shortcuts{'menurun'} - Run instrument\n". 341 "$shortcuts{'menuplot'} - Plot simulation data\n". 342 "$shortcuts{'menuprefs'} - Config menu\n". 343 "$shortcuts{'menuquit'} - Quit\n\n". 344 "$shortcuts{'insertcomp'} - Editor, insert comp\n". 345 "$shortcuts{'menusave'} - Editor, save instrument\n". 346 "$shortcuts{'cut'} - Editor cut\n". 347 "$shortcuts{'copy'} - Editor copy\n". 348 "$shortcuts{'paste'} - Editor paste"; 349 if ($MCSTAS::mcstas_config{'PLOTTER'} =~ /mcstas|mcxtrace|pgplot/i) { 350 $msg .= "\n\n 351 'P' - Plotter/PGPLOT export BW postscript 352 'C' - Plotter/PGPLOT export color postscript 353 'N' - Plotter/PGPLOT export PNG file 354 'M' - Plotter/PGPLOT export PPM file 355 'G' - Plotter/PGPLOT export GIF file 356 'L' - Plotter/PGPLOT Toggle log10 plotting mode (data) 357 'T' - Plotter/PGPLOT Toggle contour plotting mode (data) 358 'Z' - Plotter/PGPLOT zoom (in Trace/3D view) 359 'Q' - Plotter/PGPLOT quit"; 360 } 361 362 if ($Config{'osname'} eq 'MSWin32') { 363 $w->messageBox(-message =>$msg, 364 -title => "McGUI: Shortcut keys", 365 -type => 'OK', 366 -icon => 'info'); 367 } else { 368 $w->messageBox(-message =>$msg, 369 -title => "McGUI: Shortcut keys", 370 -type => 'OK', 371 -font => 'small', 372 -icon => 'info'); 373 } 374 $w->fontDelete('small'); 375} 376 377sub tools_terminal { 378 # Starts the relevant "evnvironment script" - platform independent 379 my $scriptfile; 380 if ($Config{'osname'} eq 'MSWin32') { 381 $scriptfile = "start $MCSTAS::sys_dir\\..\\bin\\mccodego.bat" 382 } else { 383 $scriptfile = "$MCSTAS::sys_dir/environment"; 384 if ($Config{'osname'} eq 'darwin') { 385 $scriptfile = "open $scriptfile" 386 } else { 387 $scriptfile = "x-terminal-emulator -e $scriptfile" 388 } 389 } 390 system($scriptfile); 391} 392sub tools_set_default_mcstas { 393 # Runs the packaged "postinst" script which sets up system-wide Unix links to 394 # the McCode version at hand 395 my ($w) = @_; 396 my $msg="Press Yes to use this McStas version from your terminals\n"; 397 my $do_dsa=$w->messageBox(-message =>$msg, 398 -title => "McGUI: Make this McStas system default?", 399 -type => 'YesNoCancel', 400 -icon => 'question', 401 -default => 'yes'); 402 if ((lc($do_dsa) eq "no")||(lc($do_dsa) eq "cancel")) { 403 putmsg($cmdwin, "Set as system default cancelled!\n", 'msg'); 404 return 0; 405 } 406 system("postinst set_mccode_default"); 407} 408 409sub tools_set_osx_bundle_pl { 410 # Runs the packaged "postinst" script which sets up the bundle to use the pl mcgui 411 my ($w) = @_; 412 my $msg="Press Yes to use run the Perl-based McStas App\n"; 413 my $do_dsa=$w->messageBox(-message =>$msg, 414 -title => "McGUI: Use Perl McStas App?", 415 -type => 'YesNoCancel', 416 -icon => 'question', 417 -default => 'yes'); 418 if ((lc($do_dsa) eq "no")||(lc($do_dsa) eq "cancel")) { 419 putmsg($cmdwin, "Set Perl App cancelled!\n", 'msg'); 420 return 0; 421 } 422 system("postinst osx_app_default pl"); 423} 424 425sub tools_set_osx_bundle_py { 426 # Runs the packaged "postinst" script which sets up the bundle to use the py mcgui 427 my ($w) = @_; 428 my $msg="Press Yes to use run the Python-based McStas App\n"; 429 my $do_dsa=$w->messageBox(-message =>$msg, 430 -title => "McGUI: Use Python McStas App?", 431 -type => 'YesNoCancel', 432 -icon => 'question', 433 -default => 'yes'); 434 if ((lc($do_dsa) eq "no")||(lc($do_dsa) eq "cancel")) { 435 putmsg($cmdwin, "Set Python App cancelled!\n", 'msg'); 436 return 0; 437 } 438 system("postinst osx_app_default py"); 439} 440 441 442sub tools_dsa { 443 my ($w) = @_; 444 my $msg="Press Yes to create DSA key.\n"; 445 my $key_exist = 0; 446 if (-e "$ENV{'HOME'}/.ssh/id_dsa") { 447 $msg = $msg."\nWarning! A DSA key exists!\n". 448 "By pressing Yes it will be overwritten!"; 449 $key_exist = 1; 450 } 451 my $do_dsa=$w->messageBox(-message =>$msg, 452 -title => "McGUI: Generate DSA key?", 453 -type => 'YesNoCancel', 454 -icon => 'question', 455 -default => 'yes'); 456 if ((lc($do_dsa) eq "no")||(lc($do_dsa) eq "cancel")) { 457 putmsg($cmdwin, "DSA key generation cancelled!\n", 'msg'); 458 return 0; 459 } 460 if ($key_exist == 1) { 461 system("rm -f $ENV{'HOME'}/.ssh/id_dsa $ENV{'HOME'}/.ssh/id_dsa.pub"); 462 } 463 # create DSA key for local MPI execution. 464 my $cmd = "ssh-keygen -q -t dsa -P \"\" -f $ENV{'HOME'}/.ssh/id_dsa"; 465 putmsg($cmdwin, "Installing DSA key for SSH: \n$cmd\n", 'msg'); 466 my $success=my_system($w, "Please wait while generating DSA key\n", $cmd); 467 if ($success) { 468 $cmd = "cat $ENV{'HOME'}/.ssh/id_dsa.pub >> $ENV{'HOME'}/.ssh/authorized_keys"; 469 system("$cmd"); 470 putmsg($cmdwin, "\nDSA key generated to $ENV{'HOME'}/.ssh/authorized_keys\n", 'msg'); 471 } else { putmsg($cmdwin, "\nDSA key generation FAILED!\n"); } 472} 473 474sub mcdoc_about { 475 my ($w) = @_; 476 my $version = `$MCSTAS::mcstas_config{'MCCODE'} --version`; 477 # create a small font for Message Box 478 $w->fontCreate('small', 479 -family=>'Helvetica', 480 -weight=>'normal', 481 -size=>12); 482 my $msg="This is the McStas Graphical User Interface. McStas is a tool for Monte Carlo neutron scattering simulations. It provides a complete set of tools, components, and example instruments.\n 483 This software required a significant effort to be brought to you. If you enjoy it, please use following references in your work:\n 484 P. Willendrup, E. Farhi and K. Lefmann, Physica B, 350 (2004) 735.\n 485 K. Lefmann and K. Nielsen, Neutron News 10, 20, (1999).\n 486 $version 487 Please visit <http://www.mcstas.org/>"; 488 if ($Config{'osname'} eq 'MSWin32') { 489 $w->messageBox(-message =>$msg, 490 -title => "McGUI: About McStas", 491 -type => 'OK', 492 -icon => 'info'); 493 } else { 494 $w->messageBox(-message =>$msg, 495 -title => "McGUI: About McStas", 496 -type => 'OK', 497 -font => 'small', 498 -icon => 'info'); 499 } 500 $w->fontDelete('small'); 501} 502 503 504sub new_simulation_results { 505 my ($w) = @_; 506 my $text = $current_sim_file ? $current_sim_file : "<None>"; 507 $current_results_label->configure(-text => "Simulation results: $text"); 508} 509 510sub new_sim_def_name { 511 my ($w, $name) = @_; 512 unless($current_sim_def ne "" && $name eq $current_sim_def) { 513 undef($current_sim_file); 514 new_simulation_results($w); 515 } 516 $current_sim_def = $name; 517 # Strip any repeated "/" charactors (ie. "///" -> "/"). 518 $current_sim_def =~ s!//!/!g; 519 # On NON-Win32 platforms, replace ' ' by '\ ' to ensure correct 520 # handling of spaces in filenames... Unfortunately, this is a 521 # more complicated matter on Win32 - has to be handled in each 522 # subroutine... :( 523 if (!$Config{'osname'} eq 'MSWin32') { 524 $current_sim_def =~ s! !\ !g; 525 } 526 # Strip any redundant leading "./". 527 while($current_sim_def =~ m!^\./(.*)$!) { 528 $current_sim_def = $1; 529 } 530 # Strip any redundant "dir/../". 531 # Problem: Needs to handle "/../../" correctly to work ... 532# while($current_sim_def =~ m!^[^/]+/\.\./(.*)$!) { 533# $current_sim_def = $1; 534# } 535# while($current_sim_def =~ m!^(.*)/[^/]+/\.\./(.*)$!) { 536# $current_sim_def = "$1/$2"; 537# } 538 $main_window->title("McStas: $current_sim_def"); 539 my $text = "Instrument file: " . 540 ($current_sim_def ne "" ? $current_sim_def : "<None>"); 541 if ($current_sim_def ne "" && $edit_window) { 542 $edit_window->title("Edit: $current_sim_def"); 543 } 544 $current_instr_label->configure(-text => $text); 545 # On Win32, doing a chdir is probably better at this point... 546 if ($Config{'osname'} eq 'MSWin32') { 547 chdir(dirname($current_sim_def)); 548 } 549 putmsg($cmdwin, "$text\n", 'msg'); 550} 551 552sub open_instr_def { 553 my ($w, $file) = @_; 554 $edit_control->Load($file) if $edit_control; 555 new_sim_def_name($w, $file); 556} 557 558 559sub set_run_dir { 560 my ($w, $file) = @_; 561 my $dir = select_dir(); 562 set_workdir($w, $dir); 563} 564 565sub set_workdir{ 566 my ($w, $dir) = @_; 567 if (!($dir eq "")) { 568 if ($Config{'osname'} eq 'MSWin32') { 569 $dir =~ s+/+\\+g; 570 } 571 $workdir->delete("1.0", "end"); 572 chdir($dir); 573 $workdir->insert('end', $dir); 574 } 575} 576 577sub menu_open { 578 my ($w) = @_; 579 return 0 unless(is_erase_ok($w)); 580 my $file = $w->getOpenFile(-defaultextension => ".instr", 581 -title => "Select instrument file", -initialdir => getcwd()); 582 return 0 unless $file; 583 open_instr_def($w, $file); 584 return 1; 585} 586 587sub menu_save { 588 my ($w) = @_; 589 if($current_sim_def ne "") { 590 $edit_control->Save($current_sim_def); 591 $edit_window->title("Edit: $current_sim_def"); 592 new_sim_def_name($w, $current_sim_def); 593 } else { 594 $error_override = sub { # Temporary Tk::Error override 595 $w->messageBox(-message => "Could not save file:\n$_[1].", 596 -title => "Save failed", 597 -type => 'OK', 598 -icon => 'error'); 599 }; 600 menu_saveas($w); 601 $error_override = undef; # Reinstall default Tk::Error handler/ 602 } 603} 604 605sub menu_saveas { 606 my ($w) = @_; 607 my $file; 608 if($current_sim_def) { 609 my ($inidir, $inifile); 610 if($current_sim_def =~ m!^(.*)/([^/]*)$!) { 611 ($inidir, $inifile) = ($1, $2); 612 } else { 613 ($inidir, $inifile) = ("", $current_sim_def); 614 } 615 $file = $w->getSaveFile(-defaultextension => ".instr", 616 -title => "Select instrument file name", 617 -initialdir => $inidir, 618 -initialfile => $inifile); 619 } else { 620 $file = $w->getSaveFile(-defaultextension => ".instr", 621 -title => "Select instrument file name"); 622 } 623 return 0 unless $file; 624 $edit_control->FileName($file); 625 new_sim_def_name($w, $file); 626 menu_save($w); 627 return 1; 628} 629 630sub menu_save_config { 631 my ($w) = @_; 632 633 my $initdir; 634 635 if (-d $ENV{"HOME"}) { 636 if (!(-d $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'})) { 637 mkdir $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}; 638 if (!(-d $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}."/".$MCSTAS::mcstas_config{'VERSION'})) { 639 mkdir $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}."/".$MCSTAS::mcstas_config{'VERSION'}; 640 } 641 } 642 $initdir = $ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}."/".$MCSTAS::mcstas_config{'VERSION'}; 643 } else { 644 $initdir = $MCSTAS::perl_dir 645 } 646 my $file = $w->getSaveFile(-defaultextension => ".perl", 647 -title => "Select preference file name", 648 -initialdir => $initdir, 649 -initialfile => "mccode_config.perl"); 650 if ($file) { save_config($w,$file); } 651} 652 653sub save_config { 654 my ($w, $file) = @_; 655 656 # Start by collecting header + footer from perl_dir configfile 657 # for safe possible writing of this file... 658 659 my ($HEADER, $FOOTER); 660 my $found_head = 0; my $found_foot = 0; 661 662 my $fh = new FileHandle; 663 my $fid = open($fh, "<", "$MCSTAS::perl_dir/mccode_config.perl"); 664 while (<$fh>) { 665 if (!$found_head) { 666 $HEADER = $HEADER.$_; 667 } 668 if (/^# HEADER/) { $found_head = 1; }; 669 if (/^# FOOTER/) { $found_foot = 1; }; 670 if ($found_foot) { 671 $FOOTER = $FOOTER.$_; 672 } 673 } 674 675 close($fh); 676 677 my $fid = open($fh, ">", $file); 678 679 if(!$fid) { 680 $w->messageBox(-message => "Error saving $file (permissions?)", 681 -title => "Error saving configuration", 682 -type => 'OK', 683 -icon => 'error'); 684 putmsg($w, "Problems saving configuration\n $file\n", 'msg'); 685 return; 686 } else { 687 print $fh $HEADER; 688 689 my @keys = keys %MCSTAS::mcstas_config; 690 my @values = values %MCSTAS::mcstas_config; 691 692 my ($j, $value, $key); 693 694 print $fh "\n\%MCSTAS::mcstas_config = (\n"; 695 for ($j=0; $j<@keys; $j++) { 696 # CFLAGS/CFLAGS_SAVED must be handled as special case 697 if (!($keys[$j] eq "CFLAGS")) { 698 if ($keys[$j] eq "CFLAGS_SAVED") { $keys[$j] = "CFLAGS" }; 699 print $fh "\t$keys[$j] => "; 700 if ($values[$j]+0 ne $values[$j]) {$values[$j] = "'$values[$j]'";} 701 print $fh "$values[$j]"; 702 if ($j<@keys-1) { 703 print $fh ",\n"; 704 } 705 } 706 } 707 print $fh "\n);\n\n"; 708 print $fh $FOOTER; 709 close($fh); 710 putmsg($w, "Configuration file\n $file\nsaved successfully\n", 'msg'); 711 return; 712 } 713} 714 715sub menu_new { 716 my ($w) = @_; 717 return 0 unless(is_erase_ok($w)); 718 my $file = $w->getSaveFile(-defaultextension => ".instr", 719 -title => "Select instrument file name"); 720 return 0 unless $file; 721 $edit_control->delete("1.0", "end"); 722 $edit_control->FileName($file); 723 new_sim_def_name($w, $file); 724 return 1; 725} 726 727sub menu_undo { 728 my ($w) = @_; 729 if($edit_control->numberChanges() <= 0) { 730 $w->messageBox(-message => "There is no further undo information.", 731 -title => "Undo not possible", 732 -type => 'OK', 733 -icon => 'error'); 734 } else { 735 $edit_control->eventGenerate("<<Undo>>"); 736 } 737} 738 739sub read_sim_data { 740 my ($w) = @_; 741 return 0 unless $current_sim_file && -r $current_sim_file; 742 my ($ii, $si, $di) = read_sim_file($current_sim_file); 743 return 0 unless $ii && $si && $di; 744 # Save old settings of "plot results". 745 $si->{'Autoplot'} = $inf_sim->{'Autoplot'}; 746 $inf_instr = $ii; 747 $inf_sim = $si; 748 $inf_data = $di; 749 my $i; 750 foreach $i (keys %{$si->{'Params'}}) { 751 $inf_param_map{$i} = $si->{'Params'}{$i}; 752 } 753 $si->{'Params'} = \%inf_param_map; 754 return 1; 755} 756 757sub load_sim_file { 758 my ($w) = @_; 759 my $file = $w->getOpenFile(-defaultextension => ".sim", 760 -title => "Select simulation file", -initialdir => getcwd()); 761 if($file && -r $file) { 762 $current_sim_file = $file ; 763 new_simulation_results($w); 764 } 765 read_sim_data($w); 766} 767 768sub save_disp_file { 769 # Function for saving mcdisplay type output 770 # PW 20030314 771 my ($w,$ext) = @_; 772 my $file = $w->getSaveFile(-defaultextension => $ext, 773 -title => "Select output filename", -initialdir => getcwd(), -initialfile => "mcdisplay_output.$ext"); 774 return $file; 775} 776 777sub putmsg { 778 my ($t, $m, $tag) = @_; 779 $cmdwin->insert('end', $m, $tag); 780 $cmdwin->see('end'); 781} 782 783sub run_dialog_create { 784 my ($w, $title, $text, $cancel_cmd, $update_cmd) = @_; 785 my $dlg = $w->Toplevel(-title => $title); 786 # Ad-hoc "wrapping" of the tooltip text, without use of string limit + Text::Wrap 787 $title =~ s/\ /\n/g; 788 789 $dlg->transient($dlg->Parent->toplevel); 790 $dlg->withdraw; 791 $dlg->protocol("WM_DELETE_WINDOW" => sub { } ); 792 $b = $dlg->Balloon(-state => 'balloon'); 793 # Add labels 794 my $text_label = $dlg->Label(-text => $text, 795 -anchor => 'w', 796 -justify => 'left')->pack(-fill => 'x'); 797 $b->attach($text_label, -balloonmsg => $title); 798 my $bot_frame = $dlg->Frame(-relief => "raised", -bd => 1); 799 $bot_frame->pack(-side => "top", -fill => "both", 800 -ipady => 3, -ipadx => 3); 801 my $but = $bot_frame->Button(-text => "Cancel", -command => $cancel_cmd); 802 my $buttext = "Save results\nand Stop/Abort"; 803 if ($text =~ /compil/i || $text =~ /DSA/i || $title =~ /compil/i || $title =~ /DSA/i ) { $buttext="Abort current Job"; } 804 $b->attach($but, -balloonmsg => $buttext); 805 $but->pack(-side => "left", -expand => 1, -padx => 1, -pady => 1); 806 return $dlg; 807} 808 809sub run_dialog_popup { 810 my ($dlg) = @_; 811 # Display the dialog box 812 my $old_focus = $dlg->focusSave; 813 my $old_grab = $dlg->grabSave; 814 $dlg->Popup; 815 $dlg->grab; 816 return [$old_focus, $old_grab]; 817} 818 819sub run_dialog_retract { 820 my ($dlg, $oldfg) = @_; 821 $dlg->grabRelease; 822 $dlg->destroy; 823 &{$oldfg->[0]} if $oldfg; 824 &{$oldfg->[1]} if $oldfg; 825} 826 827sub run_dialog_reader { 828 my ($w, $fh, $rotext, $state, $success) = @_; 829 my $s; 830 my $len = sysread($fh, $s, 256, 0); 831 if($len) { 832 putmsg($rotext, $s); 833 } else { 834 $w->fileevent($fh,'readable', ""); 835 return if $$state; 836 $$state = 1; 837 $$success = defined($len); 838 } 839} 840 841sub run_dialog { 842 my ($w, $fh, $pid, $inittext) = @_; 843 # The $state variable is set when the simulation finishes. 844 my ($state, $success) = (0, 0); 845 # Initialize the dialog. 846 my $cancel_cmd = sub { 847 putmsg($cmdwin, "\nSending TERM to pid=$pid ($state)\n"); 848 kill "TERM", $pid unless $state; # signal 15 is SIGTERM 849 }; 850 my $update_cmd = sub { 851 putmsg($cmdwin, "\nSending USR2 to pid=$pid ($state)\n"); 852 kill "USR2", $pid unless $state; # signal USR2 853 }; 854 my $text="Job"; 855 if ($inf_sim->{'Mode'}==1) { $text='Trace/3D View'; } 856 elsif ($inf_sim->{'Mode'}==2) { $text='Parameter Optimization'; } 857 if ($pid && $Config{'osname'} ne 'MSWin32') { 858 $text .= " [pid $pid]"; 859 } 860 my $dlg = run_dialog_create($w, $inittext, 861 "$text running ($current_sim_def)...", 862 $cancel_cmd, $update_cmd); 863 putmsg($cmdwin, "$inittext\n", 'msg'); # Must appear before any other output 864 # Set up the pipe reader callback 865 my $reader = sub { 866 run_dialog_reader($w, $fh, $cmdwin, \$state, \$success); 867 }; 868 869 $status_label->configure(-text => "Status: Running $text"); 870 my $savefocus = run_dialog_popup($dlg); 871 my $status; 872 873 # The following is a little hack which allows us to upgrade perl on Win32, 874 # where we have been stuck with 5.6 since 2003... 875 if ($Config{'osname'} ne 'MSWin32') { 876 $w->fileevent($fh, 'readable', $reader); 877 do { 878 $w->waitVariable(\$state); 879 } until $state; 880 $status = close($fh); 881 } else { 882 # On Win32, mcrun and other commands run by themselves in seperate 883 # cmd.exe shell windows... Error messages etc. will go there. 884 $status = 1; 885 $success = 1; 886 } 887 run_dialog_retract($dlg, $savefocus); 888 889 $status_label->configure(-text => "Status: Done"); 890 if(!$success || (! $status && ($? != 0 || $!))) { 891 putmsg($cmdwin, "Job exited abnormally.\n"); 892 return undef; 893 } else { 894 putmsg($cmdwin, "Job finished.\n", 'msg'); 895 return 1; 896 } 897} 898 899sub dialog_get_out_file { 900 # In case of mcrunflag set, let mcrun handle the compilation 901 my ($w, $file, $force, $mpi, $cflags, $mcrunflag) = @_; 902 # The $state variable is set when the spawned command finishes. 903 my ($state, $cmd_success); 904 my $success = 0; 905 my ($fh, $pid, $out_name); 906 # Initialize the dialog. 907 my $cancel_cmd = sub { 908 putmsg($cmdwin, "Sending KILL to $pid (compile)\n", 'msg'); 909 kill "TERM", $pid if $pid; # signal 15 is SIGTERM 910 }; 911 my $dlg = run_dialog_create($w, "Compiling simulation $current_sim_def", 912 "Compiling simulation\n($current_sim_def)", $cancel_cmd); 913 my $printer = sub { putmsg($cmdwin, "$_[0]\n", 'msg'); }; 914 # Set up the pipe reader callback 915 $status_label->configure(-text => "Status: Compiling simulation"); 916 # The dialog isn't actually popped up unless/until a command is 917 # run or an error occurs. 918 my $savefocus; 919 my ($compile_data, $msg) = get_out_file_init($file, $force, $mpi, 1); 920 if(!$compile_data) { 921 &$printer("Could not compile simulation:\n$msg"); 922 } else { 923 $state = 0; 924 for(;;) { 925 my ($type, $val) = get_out_file_next($compile_data, $printer, $mpi, $mcrunflag); 926 if($type eq 'FINISHED') { 927 $success = 1; 928 $out_name = $val; 929 last; 930 } elsif($type eq 'RUN_CMD') { 931 $success = my_system($w, "Compiling simulation $current_sim_def", 932 join(" ", @$val)); 933 if (defined($mcrunflag) && $mcrunflag == 1) { 934 $type = 'FINISHED'; 935 $success=1; 936 &$printer("Please wait for $MCSTAS::mcstas_config{'RUNCMD'} window to exit."); 937 last; 938 } 939 unless($success) { 940 &$printer("** Error exit **."); 941 last; 942 } 943 } elsif($type eq 'ERROR') { 944 &$printer("Error: $msg"); 945 last; 946 } elsif($type eq 'CONTINUE') { 947 next; 948 } else { 949 die "Internal: compile_dialog(): $type, $msg"; 950 } 951 } 952 } 953 run_dialog_retract($dlg, $savefocus); 954 my $donetype = $success ? "Done" : "Compile failed"; 955 $status_label->configure(-text => "Status: $donetype"); 956 &$printer("$donetype.") unless $success && !$savefocus; 957 return $success ? $out_name : undef; 958} 959 960sub compile_instrument { 961 my ($w, $force) = @_; 962 return undef unless ask_save_before_simulate($w); 963 my $mcrunflag; 964 if ($Config{'osname'} eq 'MSWin32') { 965 $mcrunflag = 1; 966 } 967 my $out_name = dialog_get_out_file($w, $current_sim_def, $force, 968 $MCSTAS::mcstas_config{'CLUSTER'} == 2 ? 1 : 0, $MCSTAS::mcstas_config{'CLUSTER'} == 1 ? 1 : 0, $mcrunflag); 969 unless($out_name && -x $out_name) { 970 if ($mcrunflag == 1) { 971 $w->messageBox(-message => "Compile running in seperate window.\nPlease wait for the process to finish!", 972 -title => "Notice", 973 -type => 'OK', 974 -icon => 'warning'); 975 return undef; 976 } else { 977 $w->messageBox(-message => "Could not compile simulation.", 978 -title => "Compile failed", 979 -type => 'OK', 980 -icon => 'error'); 981 return undef; 982 } 983 } 984 $inf_sim->{'Forcecompile'} = 0; 985 return $out_name; 986} 987 988sub menu_compile{ 989 my ($w) = @_; 990 unless($current_sim_def) { 991 $w->messageBox(-message => "No simulation definition loaded.", 992 -title => "Compilation error", 993 -type => 'OK', 994 -icon => 'error'); 995 return undef; 996 } 997 # Force recompilation. 998 compile_instrument($w, 1); 999 return 1; 1000} 1001 1002sub my_system { 1003 my ($w, $inittext, @sysargs) = @_; 1004 my $fh = new FileHandle; 1005 my $child_pid; 1006 # Open calls must be handled according to 1007 # platform... 1008 # PW 20030314 1009 if ($Config{'osname'} eq 'MSWin32') { 1010 $child_pid = open($fh, "start safewrap.pl @sysargs 2>&1 |"); 1011 } else { 1012 $child_pid = open($fh, "-|"); 1013 } 1014 unless(defined($child_pid)) { 1015 $w->messageBox(-message => "Could not run $inittext.", 1016 -title => "Job failed", 1017 -type => 'OK', 1018 -icon => 'error'); 1019 return undef; 1020 } 1021 if($child_pid) { # Parent 1022 return run_dialog($w, $fh, $child_pid, $inittext); 1023 } else { # Child 1024 open(STDERR, ">&STDOUT") || die "Can't dup stdout"; 1025 # Make the child the process group leader, so that 1026 # we can kill off any subprocesses it may have 1027 # spawned when the user selects CANCEL. 1028 setpgrp(0,0); 1029 exec @sysargs if @sysargs; # The "if @sysargs" avoids a Perl warning. 1030 # If we get here, the exec() failed. 1031 print STDERR "Error: exec() of $sysargs[0] failed!\n"; 1032 POSIX::_exit(1); # CORE:exit needed to avoid Perl/Tk failure. 1033 } 1034} 1035 1036sub menu_run_simulation { 1037 my ($w) = @_; 1038 unless($current_sim_def) { 1039 return undef unless menu_open($w); 1040 } 1041 my $out_name = compile_instrument($w); 1042 return 0 unless $out_name; 1043 # Attempt to avoid problem with missing "." in $PATH. Unix only. 1044 if (!($Config{'osname'} eq 'MSWin32')) { 1045 unless($out_name =~ "/") { 1046 $out_name = "./$out_name"; 1047 } 1048 } 1049 my $out_info = get_sim_info($out_name); 1050 unless($out_info) { 1051 $w->messageBox(-message => "Could not run simulation.", 1052 -title => "Run failed", 1053 -type => 'OK', 1054 -icon => 'error'); 1055 return 0; 1056 } 1057 # In case last used path was autogenerated, strip it off before running simulation 1058 if ($inf_sim->{'DirAutogen'} == 1) { 1059 $inf_sim->{'Dir'} = ''; 1060 $inf_sim->{'DirAutogen'} = 0; 1061 } 1062 my ($bt, $newsi) = simulation_dialog($w, $out_info, $inf_sim); 1063 1064 if($bt eq 'Start') { 1065 my @command = (); 1066 # Check 'Plotter' setting 1067 my $plotter = $MCSTAS::mcstas_config{'PLOTTER'}; 1068 1069 # Check 'Mode' setting if a scan/trace/optim is 1070 # requested 1071 if ($newsi->{'Mode'} == 1) { # Trace 3D 1072 push @command, "$MCSTAS::mcstas_config{'TRACECMD'}"; 1073 if ($plotter =~ /PGPLOT|McStas|McXtrace|Gnuplot/i) { 1074 push @command, "--plotter=PGPLOT"; 1075 # Selection of PGPLOT 3-pane view from config menu only. 1076 # Default is to NOT use 3-pane view. 1077 if ($MCSTAS::mcstas_config{'MCGUI_PGMULTI'}) { 1078 push @command, "--multi"; 1079 } 1080 } elsif ($plotter =~ /Matlab/i && $plotter =~ /scriptfile/i) { 1081 push @command, "--plotter=Matlab"; 1082 my $output_file = save_disp_file($w,'m'); 1083 if (!$output_file) { 1084 putmsg($cmdwin, "Trace cancelled...\n"); 1085 return; 1086 } 1087 $output_file = "\"$output_file\""; 1088 push @command, "-f$output_file"; 1089 1090 } elsif ($plotter =~ /Matlab/i) { 1091 push @command, "--plotter=Matlab"; 1092 } elsif ($plotter =~ /nexus/i) { 1093 # Used to generate an IDF for a subsequent NeXus/Mantid dataset 1094 push @command, "--plotter=Mantid"; 1095 $newsi->{'Ncount'}=0; 1096 } elsif ($plotter =~ /html|vrml/i) { 1097 push @command, "--plotter=VRML"; 1098 # Make a check for # of neutron histories, 1099 # should be made small to avoid waiting a long time for 1100 # mcdisplay... 1101 # Subtract 0 to make sure $num_histories is treated as a 1102 # number... 1103 my $num_histories = $newsi->{'Ncount'} - 0; 1104 if ($num_histories >=1001) { 1105 my $break = $w->messageBox(-message => "$num_histories is a very large number\nof neutron histories when using\nVRML\nContinue ?", 1106 -title => "Warning: large number", 1107 -type => 'yesnocancel', 1108 -icon => 'error', 1109 -default => 'no'); 1110 # Make first char lower case - default on 1111 # Win32 upper case default on Unix... (perl 5.8) 1112 $break = lcfirst($break); 1113 if ((lc($break) eq "no")||(lc($break) eq "cancel")) { 1114 return 0; 1115 } 1116 } 1117 1118 } 1119 1120 push @command, "--inspect=$newsi->{'Inspect'}" if $newsi->{'Inspect'}; 1121 push @command, "--first=$newsi->{'First'}" if $newsi->{'First'}; 1122 push @command, "--last=$newsi->{'Last'}" if $newsi->{'Last'}; 1123 # push @command, "--save"; 1124 } # end Mode=Trace mcdisplay 1125 elsif ($newsi->{'Mode'} == 2) { # optimize 1126 push @command, "$MCSTAS::mcstas_config{'prefix'}$MCSTAS::mcstas_config{'RUNCMD'}"; 1127 if (not ($newsi->{'Last'} || $newsi->{'Inspect'} || $newsi->{'First'})) { 1128 putmsg($cmdwin, "Warning: No criteria/monitor selected\n 1129 Global optimization using all monitors\n"); 1130 push @command, "--optim"; 1131 } else { 1132 push @command, "--optim=$newsi->{'Inspect'}" if $newsi->{'Inspect'}; 1133 push @command, "--optim=$newsi->{'First'}" if $newsi->{'First'}; 1134 push @command, "--optim=$newsi->{'Last'}" if $newsi->{'Last'}; 1135 } 1136 push @command, "--optim-prec=$MCSTAS::mcstas_config{'PREC'}" if $MCSTAS::mcstas_config{'PREC'}; 1137 } # end Mode=Optimize 1138 elsif ($newsi->{'Mode'} == 0) { # simulate 1139 push @command, "$MCSTAS::mcstas_config{'prefix'}$MCSTAS::mcstas_config{'RUNCMD'}"; 1140 } # end Mode=simulate 1141 push @command, "$out_name"; 1142 my ($OutDir,$OutDirBak); 1143 # In the special case of --dir, we simply replace ' ' with '_' 1144 # on Win32 (also giving out a warning message). This is done 1145 # because Win32::GetShortPathName only works on directories that 1146 # actually exist... :( 1147 if (!($newsi->{'Dir'})) { 1148 my $tmpdir = ${out_name}; 1149 $tmpdir =~ s/\.$MCSTAS::mcstas_config{'EXE'}$//; 1150 $tmpdir .= '_' . POSIX::strftime("%Y%m%d_%H%M%S", localtime); 1151 $newsi->{'Dir'} = $tmpdir; 1152 $newsi->{'DirAutogen'} =1; 1153 } 1154 if ($newsi->{'Dir'} && !($newsi->{'Mode'})) { 1155 $OutDir=$newsi->{'Dir'}; 1156 if ($Config{'osname'} eq 'MSWin32') { 1157 $OutDirBak = $OutDir; 1158 $OutDir =~ s! !_!g; 1159 if (! "$OutDir" == "$OutDirBak") { 1160 putmsg($cmdwin, "You have requested output directory \"$OutDirBak\"\n"); 1161 putmsg($cmdwin, "For compatibility reasons, spaces are replaced by underscores.\n"); 1162 putmsg($cmdwin, "Your output files will go to \"$OutDir\"\n"); 1163 $newsi->{'Dir'} = $OutDir; 1164 } 1165 } else { 1166 $OutDir =~ s! !\ !g; 1167 } 1168 } 1169 # clustering methods 1170 if ($newsi->{'cluster'} == 2) { 1171 push @command, "--mpi=$MCSTAS::mcstas_config{'NODES'}"; 1172 } elsif ($newsi->{'cluster'} == 3) { 1173 push @command, "--multi=$MCSTAS::mcstas_config{'NODES'}"; 1174 if ($MCSTAS::mcstas_config{'GRID_FORCECOMPILE'}) { 1175 push @command, "-c"; 1176 } 1177 } 1178 if ($newsi->{'Forcecompile'} == 1) { 1179 if ($newsi->{'cluster'} == 3) { 1180 # force compile from mcrun 1181 push @command, "--force-compile"; 1182 $newsi->{'Forcecompile'} = 0; 1183 } else { # compile from mcgui (locally) 1184 $MCSTAS::mcstas_config{'CLUSTER'} = $newsi->{'cluster'}; 1185 $out_name = compile_instrument($w, 1); 1186 } 1187 } 1188 1189 push @command, "--ncount=$newsi->{'Ncount'}"; 1190 push @command, "--trace" if ($newsi->{'Mode'} eq 1); 1191 push @command, "--seed=$newsi->{'Seed'}" if $newsi->{'Seed'} ne "" && $newsi->{'Seed'} ne 0; 1192 push @command, "--dir=$OutDir" if ($newsi->{'Dir'} && !$newsi->{'Mode'}==1); 1193 1194 # we now always use McStas/PGPLOT legacy format, except for HTML and NeXus 1195 if ($newsi->{'Mode'}!=1 && $plotter !~ /PGPLOT|McStas|Gnuplot|Matlab/i) { 1196 push @command, "--plotter=$plotter"; 1197 } 1198 1199 # add parameter values 1200 my @unset = (); 1201 my @multiple = (); 1202 if ($newsi->{'NScan'} eq '') { $newsi->{'NScan'} = 1; } 1203 for (@{$out_info->{'Parameters'}}) { 1204 if (length($newsi->{'Params'}{$_})>0) { 1205 # Check for comma separated values 1206 my @values = split(',',$newsi->{'Params'}{$_}); 1207 my $value = $newsi->{'Params'}{$_}; 1208 if (@values > 1) { 1209 @multiple = (@multiple, $_); 1210 if (($newsi->{'Mode'} == 0 && $newsi->{'NScan'} < 2) 1211 || $newsi->{'Mode'} == 1) { 1212 # compute mean value if range not applicable 1213 my $j; 1214 my $meanvalue=0; 1215 for ($j=0; $j<@values; $j++) { 1216 $meanvalue = $values[$j]; 1217 } 1218 $meanvalue = $meanvalue / @values; 1219 $value = $meanvalue; 1220 } 1221 } 1222 push @command, "$_=$value"; 1223 } else { 1224 push @unset, $_; 1225 } 1226 } 1227 if (@unset>0) { 1228 $w->messageBox(-message => 1229 "Unset parameter(s):\n\n@unset\n\nPlease fill all fields!", 1230 -title => "Unset parameters!", 1231 -type => 'OK', 1232 -icon => 'error'); 1233 return; 1234 } 1235 if (@multiple > 0 && (($newsi->{'Mode'} == 0 && $newsi->{'NScan'} < 2) 1236 || $newsi->{'Mode'} == 1) ) { 1237 $w->messageBox(-message => 1238 "Scan range(s) not applicable. Mean value subsituted for parameter(s):\n\n@multiple", 1239 -title => "No scan here!", 1240 -type => 'OK', 1241 -icon => 'info'); 1242 } 1243 if (@multiple eq 0 && $newsi->{'NScan'} > 1) { 1244 if ($newsi->{'Mode'} == 0) { 1245 $w->messageBox(-message => 1246 "No scan range(s) given! Performing single simulation", 1247 -title => "No scan here!", 1248 -type => 'OK', 1249 -icon => 'info'); 1250 $newsi->{'NScan'} = 0; 1251 } elsif ($newsi->{'Mode'} == 2) { 1252 $w->messageBox(-message => 1253 "No optimization range(s) given! ", 1254 -title => "No range here!", 1255 -type => 'OK', 1256 -icon => 'error'); 1257 return; 1258 } 1259 } 1260 if ($newsi->{'gravity'} eq 1 && !$newsi->{'Mode'}) { 1261 if ($newsi->{'GravityWarn'} eq 0) { 1262 $w->messageBox(-message => 1263 "Only use --gravitation with components that support this!", 1264 -title => "BEWARE!", 1265 -type => 'OK', 1266 -icon => 'warning'); 1267 $newsi->{'GravityWarn'} = 1; 1268 } 1269 push @command, "--gravitation"; 1270 } 1271 if (($newsi->{'Mode'} == 0 && $newsi->{'NScan'} > 1) 1272 || $newsi->{'Mode'} == 2) { 1273 push @command, "-N$newsi->{'NScan'}"; 1274 } 1275 1276 my $tmpfile; 1277 if ($newsi->{'Detach'} == 1) { # Background simulations using 'at' 1278 1279 # Create temporary file 1280 my $fid; 1281 if ($MCSTAS::mcstas_config{'TEMP'} ne "no") { 1282 require File::Temp; 1283 ($fid, $tmpfile) = File::Temp::tempfile("McStas_XXXX", SUFFIX => '.sh'); 1284 if (not defined $fid) { $tmpfile=""; } 1285 } 1286 if ($tmpfile eq "") { 1287 $tmpfile="McStas_000000.sh"; 1288 $fid = new FileHandle "> $tmpfile"; 1289 } 1290 if (not defined $fid) { die "Could not open temporary McStas file $tmpfile\n"; } 1291 1292 # Write to temporary file 1293 print $fid "#!/bin/sh\n"; 1294 print $fid "#\n# This is a temporary shell script to "; 1295 print $fid "run a McStas simulation detached\n# from the GUI"; 1296 print $fid "\n#\n# Will be removed shortly.\n#\n"; 1297 1298 my $cmd = join(" ", @command); 1299 my $date = localtime(time()); 1300 my $logfile = "${out_name}_${date}.log"; 1301 $logfile =~ s!\ !_!g; 1302 print $fid "$cmd > $logfile 2>&1 "; 1303 1304 # Close; set execute mode 1305 close($fid); 1306 $fid = open(READ, "chmod a+x $tmpfile|"); 1307 close($fid); 1308 $cmdwin->insert('end', "\nExecuting background job\n$cmd\n(logfile $logfile)\n\n",''); 1309 1310 # Clear @command, things to do are now in $tmpfile 1311 @command = ($MCSTAS::mcstas_config{'AT'}, "-f", $tmpfile, "now"); 1312 } 1313 $inf_sim->{'Mode'} = $newsi->{'Mode'}; 1314 my $inittext = "Running simulation '$out_name' ...\n" . 1315 join(" ", @command) . "\n"; 1316 my $success = my_system $w, $inittext, @command; 1317 $inf_sim=$newsi; 1318 return unless $success; 1319 my $ext; 1320 if ($plotter =~ /PGPLOT|McStas|McXtrace|Matlab|Gnuplot/i) { $ext="sim"; } 1321 elsif ($plotter =~ /HTML/i) { $ext="html"; } 1322 elsif ($plotter =~ /NeXus|HDF/i) { $ext="h5"; } 1323 $current_sim_file = $newsi->{'Dir'} ? 1324 "$newsi->{'Dir'}/mccode.$ext" : 1325 "mccode.$ext"; 1326 new_simulation_results($w); 1327 # In case of non-PGPLOT plotter, we can not read the data from disk. 1328 # Instead, we simply keep $newsi information in $inf_sim 1329 if ($plotter !~ /PGPLOT|McStas|Matlab|Gnuplot|NeXus/i) { 1330 read_sim_data($w); 1331 } else { 1332 $inf_sim=$newsi; 1333 } 1334 $inf_sim->{'Autoplot'} = $newsi->{'Autoplot'}; 1335 $inf_sim->{'Mode'} = $newsi->{'Mode'}; 1336 $MCSTAS::mcstas_config{'CLUSTER'} = $newsi->{'cluster'}; 1337 1338 if ($newsi->{'Autoplot'}) { # Is beeing set to 0 above if Win32 + trace 1339 plot_dialog($w, $inf_instr, $inf_sim, $inf_data, 1340 $current_sim_file); 1341 } 1342 1343 if ($newsi->{'Detach'}) { # Clean up after background simulation 1344 sleep(1); 1345 unlink($tmpfile) 1346# my $fid = open(READ,"rm -f $tmpfile|"); 1347# close($fid); 1348 } 1349 1350 } 1351 } 1352 1353sub menu_plot_results { 1354 my ($w) = @_; 1355 unless($current_sim_file) { 1356 my $ret = load_sim_file($w); 1357 return 0 unless $ret && -e $current_sim_file; 1358 } 1359 plot_dialog($w, $inf_instr, $inf_sim, $inf_data, $current_sim_file); 1360 return 1; 1361} 1362 1363sub menu_preferences { 1364 # sub for selection of mcdisplay "backend". 1365 # Default read from $MCSTAS::mcstas_config{'PLOTTER'} 1366 # PW 20030314 1367 # Added entry for selection of internal editor 1368 # PW 20040527 1369 my ($w) = @_; 1370 my $ret; 1371 our $MPIstuff = $MCSTAS::mcstas_config{'CLUSTER'}; 1372 ($ret) = preferences_dialog($w); # 1373 $MCSTAS::mcstas_config{'CLUSTER'} = $MPIstuff; 1374} 1375 1376 1377sub menu_read_sim_file { 1378 my ($w) = @_; 1379 load_sim_file($w); 1380 menu_plot_results($w); 1381} 1382 1383 1384# Build the text (McStas metalanguage) representation of a component 1385# using data fillied in by the user. 1386sub make_comp_inst { 1387 my ($cdata, $r) = @_; 1388 my ($p, $s); 1389 $s = "\n"; 1390 $s .= "COMPONENT $r->{'INSTANCE'} = $r->{'DEFINITION'}(\n"; 1391 my @ps = (); 1392 my $col = ""; 1393 for $p (@{$cdata->{'inputpar'}}) { 1394 my $add; 1395 if(defined($r->{'VALUE'}{$p}) && $r->{'VALUE'}{$p} !~ /^\s*$/) { 1396 if(defined($cdata->{'parhelp'}{$p}{'type'})) { 1397 if (($cdata->{'parhelp'}{$p}{'type'} eq "string" || 1398 $cdata->{'parhelp'}{$p}{'type'} =~ /char/) && 1399 $quote == 1 && 1400 $r->{'VALUE'}{$p} !~ /\".*\"/ && 1401 $r->{'VALUE'}{$p} !~ /\'.*\'/) { 1402 # Firstly, remove existing quotes :) 1403 $r->{'VALUE'}{$p} =~ s!\"!!g; 1404 $r->{'VALUE'}{$p} =~ s!\'!!g; 1405 # Next, add quotes... 1406 $r->{'VALUE'}{$p} = "\"$r->{'VALUE'}{$p}\""; 1407 } 1408 } 1409 $add .= "$p = $r->{'VALUE'}{$p}"; 1410 } elsif(defined($cdata->{'parhelp'}{$p}{'default'})) { 1411 next; # Omit non-specified default parameter 1412 } else { 1413 $add.= "$p = "; 1414 } 1415 if(length($col) > 0) { 1416 if(length("$col, $add") > 60) { 1417 push @ps, $col; 1418 $col = $add; 1419 } else { 1420 $col = "$col, $add"; 1421 } 1422 } else { 1423 $col = $add; 1424 } 1425 } 1426 push @ps, $col if length($col) > 0; 1427 $s .= " " . join(",\n ", @ps) . ")\n"; 1428 $s .= " AT (". $r->{'AT'}{'x'} . ", " . $r->{'AT'}{'y'} . ", " . 1429 $r->{'AT'}{'z'} . ") RELATIVE " . $r->{'AT'}{'relative'} . "\n"; 1430 $s .= " ROTATED (" . $r->{'ROTATED'}{'x'} . ", " . $r->{'ROTATED'}{'y'} . 1431 ", " . $r->{'ROTATED'}{'z'} . ") RELATIVE " . 1432 $r->{'ROTATED'}{'relative'} . "\n" 1433 if($r->{'ROTATED'}{'x'} || $r->{'ROTATED'}{'y'} || 1434 $r->{'ROTATED'}{'z'} || $r->{'ROTATED'}{'relative'}); 1435 return $s; 1436} 1437 1438# The text for the instrument template. 1439my $instr_template_start = <<INSTR_FINISH; 1440/******************************************************************************* 1441* McStas instrument definition URL=http://www.mcstas.org 1442* 1443* Instrument: test (rename also the example and DEFINE lines below) 1444* 1445* %Identification 1446* Written by: Your name (email) 1447* Date: Current Date 1448* Origin: Your institution 1449* Release: McStas 1450* Version: 0.2 1451* %INSTRUMENT_SITE: Institution_name_as_a_single word 1452* 1453* Instrument short description 1454* 1455* %Description 1456* Instrument longer description (type, elements, usage...) 1457* 1458* Example: mcrun test.instr <parameters=values> 1459* 1460* %Parameters 1461* Par1: [unit] Parameter1 description 1462* 1463* %Link 1464* A reference/HTML link for more information 1465* 1466* %End 1467*******************************************************************************/ 1468 1469/* Change name of instrument and input parameters with default values */ 1470DEFINE INSTRUMENT test(Par1=1) 1471 1472/* The DECLARE section allows us to declare variables or small */ 1473/* functions in C syntax. These may be used in the whole instrument. */ 1474DECLARE 1475%{ 1476%} 1477 1478/* The INITIALIZE section is executed when the simulation starts */ 1479/* (C code). You may use them as component parameter values. */ 1480INITIALIZE 1481%{ 1482%} 1483 1484/* Here comes the TRACE section, where the actual */ 1485/* instrument is defined as a sequence of components. */ 1486TRACE 1487 1488/* The Arm() class component defines reference points and orientations */ 1489/* in 3D space. Every component instance must have a unique name. Here, */ 1490/* Origin is used. This Arm() component is set to define the origin of */ 1491/* our global coordinate system (AT (0,0,0) ABSOLUTE). It may be used */ 1492/* for further RELATIVE reference, Other useful keywords are : ROTATED */ 1493/* EXTEND GROUP PREVIOUS. Also think about adding a neutron source ! */ 1494/* Progress_bar is an Arm displaying simulation progress. */ 1495COMPONENT Origin = Progress_bar() 1496 AT (0,0,0) ABSOLUTE 1497INSTR_FINISH 1498my $instr_template_end = <<INSTR_FINISH; 1499 1500/* This section is executed when the simulation ends (C code). Other */ 1501/* optional sections are : SAVE */ 1502FINALLY 1503%{ 1504%} 1505/* The END token marks the instrument definition end */ 1506END 1507INSTR_FINISH 1508 1509sub menu_insert_instr_template { 1510 if($edit_control) { 1511 $edit_control->insert('1.0', $instr_template_start); 1512 # Save the current cursor position so that we can move it to 1513 # before the last part of the template if necessary. 1514 my $currentpos = $edit_control->index('insert'); 1515 $edit_control->insert('end', $instr_template_end); 1516 $edit_control->markSet('insert', $currentpos); 1517 if (not $current_sim_def) { 1518 $edit_window->title("Edit: Insert components in TRACE and save your instrument"); 1519 } 1520 } 1521} 1522 1523sub menu_insert_file { 1524 my ($w) = @_; 1525 if($edit_control) { 1526 my $file = $w->getOpenFile(-title => "Select file to insert", -initialdir => getcwd()); 1527 return 0 unless $file; 1528 my $fid = open(FILE, "<$file"); 1529 my $input; 1530 while (<FILE>) { 1531 $input = "$input$_"; 1532 } 1533 $edit_control->see('insert'); 1534 $edit_control->insert('insert', $input); 1535 $edit_control->see('insert'); 1536 } 1537} 1538 1539# Allow the user to populate a given component definition in a dialog 1540# window, and produce a corresponding component instance. 1541sub menu_insert_x { 1542 my ($w, $path) = @_; 1543 my $cdata = fetch_comp_info($path, $compinfo); 1544 1545 my $r = comp_instance_dialog($w, $cdata); 1546 return undef unless $r; 1547 die "No values given" unless $r; 1548 1549 if($edit_control) { 1550 $edit_control->see('insert'); 1551 $edit_control->insert('insert', make_comp_inst($cdata, $r)); 1552 $edit_control->see('insert'); 1553 } 1554 return 1; 1555} 1556 1557# Choose a component definition from a list in a dialog window, and 1558# then allow the user to populate it in another dialog. 1559sub menu_insert_component { 1560 my ($w) = @_; 1561 1562 my $comp = comp_select_dialog($w, \@compdefs, $compinfo); 1563 return undef unless $comp; 1564 return menu_insert_x($w, $comp); 1565} 1566 1567# Directories containing component definitions. 1568# MOD: E. Farhi, Oct 2nd, 2001: add obsolete dir. Aug 27th, 2002: contrib 1569my @comp_sources = 1570 (["Source", ["$MCSTAS::sys_dir/sources"]], 1571 ["Optics", ["$MCSTAS::sys_dir/optics"]], 1572 ["Sample", ["$MCSTAS::sys_dir/samples"]], 1573 ["Monitor", ["$MCSTAS::sys_dir/monitors"]], 1574 ["Misc", ["$MCSTAS::sys_dir/misc"]], 1575 ["Contrib", ["$MCSTAS::sys_dir/contrib"]], 1576 ["Contrib/union", ["$MCSTAS::sys_dir/contrib/union"]], 1577 ["Obsolete", ["$MCSTAS::sys_dir/obsolete"]], 1578 ["Other", ["$MCSTAS::sys_dir", "."]]); 1579 1580# Fill out the menu for building component instances. 1581sub make_insert_menu { 1582 my ($w, $menu) = @_; 1583 @compdefs = (); 1584 my @menudefs = (); 1585 my ($sec,$dir); 1586 for $sec (@comp_sources) { 1587 my $sl = [$sec->[0], []]; 1588 for $dir (@{$sec->[1]}) { 1589 if(opendir(DIR, $dir)) { 1590 my @comps = readdir(DIR); 1591 closedir DIR; 1592 next unless @comps; 1593 my @paths = map("$dir/$_", grep(/\.(comp|cmp|com)$/, @comps)); 1594 @paths = sort @paths; 1595 push(@compdefs, @paths); 1596 push(@{$sl->[1]}, map([compname($_), $_], @paths)); 1597 } 1598 } 1599 push @menudefs, $sl; 1600 } 1601 $menu->command(-label => "Instrument template", 1602 -command => sub { menu_insert_instr_template($w) }, 1603 -underline => 0); 1604 $menu->command(-label => "File ...", 1605 -command => sub { menu_insert_file($w) }, 1606 -underline => 0); 1607 $menu->command(-label => "Component ...", 1608 -accelerator => $shortcuts{'insertcomp'} , 1609 -command => sub { menu_insert_component($w) }, 1610 -underline => 0); 1611 $w->bind($shortcuts{'insertcomp'} => sub { menu_insert_component($w) }); 1612 # Now build all the menu entries for direct selection of component 1613 # definitions. 1614 my $p; 1615 for $p (@menudefs) { # $p holds title and component list 1616 my $m2 = $menu->cascade(-label => $p->[0]); 1617 my $c; 1618 for $c (@{$p->[1]}) { # $c holds name and path 1619 $m2->command(-label => "$c->[0] ...", 1620 -command => sub { menu_insert_x($w, $c->[1]) }); 1621 } 1622 } 1623 $menu->pack(-side=>'left'); 1624} 1625 1626sub setup_menu { 1627 my ($w) = @_; 1628 my $menu = $w->Frame(-relief => 'raised', -borderwidth => 2); 1629 $menu->pack(-fill => 'x'); 1630 my $filemenu = $menu->Menubutton(-text => 'File', -underline => 0); 1631 $filemenu->command(-label => 'Open instrument ...', 1632 -accelerator => $shortcuts{'menuopen'} , 1633 -command => [\&menu_open, $w], 1634 -underline => 0); 1635 $w->bind( $shortcuts{'menuopen'} => [\&menu_open, $w]); 1636 $filemenu->command(-label => 'Edit current/New...', 1637 -underline => 0, 1638 -command => \&menu_edit_current); 1639 $filemenu->command(-label => 'Edit current/New (detached)', 1640 -underline => 0, 1641 -command => sub { menu_spawn_internal_editor($w) } ); 1642 if($external_editor) { 1643 my $shortname = (split " ", $external_editor)[0]; 1644 $shortname = (split "/", $shortname)[-1]; 1645 $filemenu->command(-label => 'Spawn editor "' . $shortname . '"', 1646 -command => sub { menu_spawn_editor($w) } ); 1647 } 1648 $filemenu->command(-label => 'Compile instrument', 1649 -underline => 0, 1650 -command => sub {menu_compile($w)}); 1651 $filemenu->command(-label => 'Save output/Log file...', 1652 -underline => 1, 1653 -command => sub { setup_cmdwin_saveas($w) }); 1654 $filemenu->command(-label => 'Clear output', 1655 -underline => 1, 1656 -command => sub { $cmdwin->delete("1.0", "end") }); 1657 $filemenu->separator; 1658 $filemenu->command(-label => 'Preferences...', 1659 -underline => 1, 1660 -accelerator => $shortcuts{'menuprefs'} , 1661 -command => sub {menu_preferences($w);}); 1662 $w->bind( $shortcuts{'menuprefs'} => [\&menu_preferences, $w]); 1663 $filemenu->command(-label => 'Save configuration...', 1664 -underline => 2, 1665 -command => sub {menu_save_config($w)}); 1666 $filemenu->separator; 1667 $filemenu->command(-label => 'Quit', 1668 -underline => 0, 1669 -accelerator => $shortcuts{'menuquit'} , 1670 -command => \&menu_quit); 1671 $w->bind( $shortcuts{'menuquit'} => \&menu_quit); 1672 $filemenu->pack(-side=>'left'); 1673 my $simmenu = $menu->Menubutton(-text => 'Simulation', -underline => 2); 1674 $simmenu->command(-label => 'Read old simulation ...', 1675 -underline => 0, 1676 -command => sub { menu_read_sim_file($w) }); 1677 $simmenu->separator; 1678 $simmenu->command(-label => 'Run simulation...', 1679 -underline => 1, 1680 -accelerator => $shortcuts{'menurun'} , 1681 -command => sub {menu_run_simulation($w);}); 1682 $w->bind( $shortcuts{'menurun'} => [\&menu_run_simulation, $w]); 1683 $simmenu->command(-label => 'Plot results...', 1684 -underline => 0, 1685 -accelerator => $shortcuts{'menuplot'} , 1686 -command => sub {menu_plot_results($w);}); 1687 $w->bind( $shortcuts{'insertcomp'} => [\&menu_plot_results, $w]); 1688 1689 $simmenu->pack(-side=>'left'); 1690 1691 sitemenu_build($w,$menu); 1692 1693 my $toolmenu = $menu->Menubutton(-text => 'Tools', -underline => 0); 1694 1695 $toolmenu->command(-label => 'Plot current results', 1696 -command => sub {menu_plot_results($w);}); 1697 $toolmenu->command(-label => 'Plot other results', 1698 -command => sub {menu_spawn_mcplot($w);}); 1699 $toolmenu->command(-label => 'Online plotting of results', 1700 -command => sub {menu_spawn_mcdaemon($w);}); 1701 $toolmenu->command(-label => 'Dataset convert/merge', 1702 -command => sub {menu_spawn_mcformatgui($w,$current_sim_file);}); 1703 $toolmenu->pack(-side=>'left'); 1704 $toolmenu->command(-label => 'mcgui Shorcut keys', 1705 -command => sub {tools_shortcuts($w)}); 1706 $toolmenu->command(-label => 'Open terminal env.', 1707 -command => sub {tools_terminal($w)}); 1708 # The following items for now only applies to non-Win32 systems... 1709 if (!($Config{'osname'} eq 'MSWin32')) { 1710 $toolmenu->command(-label => 'Set this McStas as sys default', 1711 -command => sub {tools_set_default_mcstas($w)}); 1712 $toolmenu->command(-label => 'Activate MPI/grid (DSA key)', 1713 -command => sub {tools_dsa($w)}); 1714 } 1715 # The following item only apply to Mac OS systems... 1716 if ($Config{'osname'} eq 'darwin') { 1717 $toolmenu->command(-label => 'Use Python App', 1718 -command => sub {tools_set_osx_bundle_py($w)}); 1719 $toolmenu->command(-label => 'Use Perl App', 1720 -command => sub {tools_set_osx_bundle_pl($w)}); 1721 } 1722 1723 my $helpmenu = $menu->Menubutton(-text => 'Help (McDoc)', -underline => 0); 1724 1725 $helpmenu->command(-label => 'McStas User manual', 1726 -command => sub {mcdoc_manual()}); 1727 $helpmenu->command(-label => 'McStas Component manual', 1728 -command => sub {mcdoc_compman()}); 1729 $helpmenu->command(-label => 'Component Library index', 1730 -command => sub {mcdoc_components()}); 1731 $helpmenu->separator; 1732 $helpmenu->command(-label => 'McStas web page (web)', 1733 -underline => 7, 1734 -command => sub {mcdoc_web()}); 1735 $helpmenu->command(-label => 'Current instrument info', 1736 -command => sub {mcdoc_current()}); 1737 $helpmenu->separator; 1738 $helpmenu->command(-label => 'Test McStas installation (BNL_H8)', 1739 -command => sub {mcdoc_test($w)}); 1740 $helpmenu->command(-label => 'Generate component index', 1741 -command => sub {mcdoc_generate()}); 1742 $helpmenu->command(-label => 'About McStas', 1743 -command => sub {mcdoc_about($w)}); 1744 $helpmenu->pack(-side=>'right'); 1745} 1746 1747sub setup_cmdwin { 1748 my ($w) = @_; 1749 my $f2 = $w->Frame(); 1750 $b = $w->Balloon(-state => 'balloon'); 1751 $f2->pack(-fill => 'x'); 1752 my $instr_lab = $f2->Label(-text => "Instrument file: <None>", 1753 -anchor => 'w', 1754 -justify => 'left',-fg => 'red'); 1755 $instr_lab->pack(-side => 'left'); 1756 my $instr_run = $f2->Button(-text => "Run", -fg => 'blue', 1757 -command => sub { menu_run_simulation($w) }); 1758 $instr_run->pack(-side => "right", -padx => 1, -pady => 1); 1759 $b->attach($instr_run, -balloonmsg => "Compile and Run current instrument"); 1760 my $instr_but = $f2->Button(-text => "Edit/New", 1761 -command => \&menu_edit_current); 1762 $instr_but->pack(-side => "right", -padx => 1, -pady => 1); 1763 $b->attach($instr_but, -balloonmsg => "Edit current instrument description\nor create a new one from a Template"); 1764 my $f3 = $w->Frame(); 1765 $f3->pack(-fill => 'x'); 1766 my $res_lab = $f3->Label(-text => "Simulation results: <None>", 1767 -anchor => 'w', 1768 -justify => 'left'); 1769 $res_lab->pack(-side => 'left'); 1770 my $plot_but = $f3->Button(-text => "Plot", 1771 -command => sub {menu_plot_results($w);}); 1772 $plot_but->pack(-side => "right", -padx => 1, -pady => 1); 1773 $b->attach($plot_but, -balloonmsg => "Plot last simulation results"); 1774 my $sim_but = $f3->Button(-text => "Read", 1775 -command => sub { menu_read_sim_file($w) }); 1776 $sim_but->pack(-side => "right", -padx => 1, -pady => 1); 1777 $b->attach($sim_but, -balloonmsg => "Open previous simulation results"); 1778 my $f4 = $w->Frame(); 1779 my $status_lab = $f4->Label(-text => "Status: Ok", 1780 -anchor => 'w', 1781 -justify => 'left'); 1782 my $spacer = $f4->Label(-text => " in ", 1783 -anchor => 'w', 1784 -justify => 'left'); 1785 my $dir_but = $f4->Button(-text => "<-- Work dir.", 1786 -command => sub { set_run_dir($w) }); 1787 1788 $status_lab->pack(-side => 'left'); 1789 $spacer->pack(-side => 'left'); 1790 1791 my $dirbox = $f4->ROText(-relief => 'sunken', -bd => '0', 1792 -setgrid => 'true', 1793 -height => 1); 1794 $dir_but->pack(-side => 'right'); 1795 $dirbox->pack(-expand => 'yes', -fill => 'x', -side => 'right'); 1796 1797 $workdir = $dirbox; 1798 set_workdir($w, getcwd()); 1799 $f4->pack(-fill => 'x'); 1800 1801 # Add the main text field, with scroll bar 1802 my $rotext = $w->ROText(-relief => 'sunken', -bd => '2', 1803 -setgrid => 'true', 1804 -height => 24, -width => 80); 1805 my $s = $w->Scrollbar(-command => [$rotext, 'yview']); 1806 $rotext->configure(-yscrollcommand => [$s, 'set']); 1807 $s->pack(-side => 'right', -fill => 'y'); 1808 $rotext->pack(-expand => 'yes', -fill => 'both'); 1809 $rotext->mark('set', 'insert', '0.0'); 1810 $rotext->tagConfigure('msg', -foreground => 'blue'); 1811 $current_instr_label = $instr_lab; 1812 $current_results_label = $res_lab; 1813 $status_label = $status_lab; 1814 $cmdwin = $rotext; 1815 1816 # Insert "mcstas --version" message in window. Do it a line at the 1817 # time, since otherwise the tags mechanism seems to get confused. 1818 my $l; 1819 for $l (split "\n", `$MCSTAS::mcstas_config{'MCCODE'} --version`) { 1820 $cmdwin->insert('end', "$l\n", 'msg'); 1821 } 1822 # Insert contents of component lib revision file in window 1823 open(COMPREV,File::Spec->catfile($MCSTAS::sys_dir,'revision')); 1824 while (<COMPREV>) { 1825 $cmdwin->insert('end', "$_", 'msg'); 1826 } 1827 1828 my $text=""; 1829 if ($MCSTAS::mcstas_config{'MATLAB'} ne "no") { $text .= "Matlab "; } 1830 if ($MCSTAS::mcstas_config{'PGPLOT'} ne "no") { $text .= "PGPLOT/McStas "; } 1831 if ($MCSTAS::mcstas_config{'GNUPLOT'} ne "no") { $text .= "Gnuplot "; } 1832 if ($MCSTAS::mcstas_config{'BROWSER'} ne "no") { $text .= "HTML "; } 1833 if ($MCSTAS::mcstas_config{'VRMLVIEW'} ne "no") { $text .= "VRML "; } 1834 if ($MCSTAS::mcstas_config{'NEXUS'} ne "") { $text .= "NeXus "; } 1835 if ($text ne "") { $cmdwin->insert('end', "Plotters: $text\n"); } 1836 1837 if ($MCSTAS::mcstas_config{'HOSTFILE'} eq "" && 1838 ($MCSTAS::mcstas_config{'MPIRUN'} ne "no" 1839 || $MCSTAS::mcstas_config{'SSH'} ne "no") ) { 1840 $cmdwin->insert('end', 1841"Warning: No MPI/grid machine list. Running locally. 1842 Define ".$ENV{"HOME"}."/.".$MCSTAS::mcstas_config{'MCCODE'}."/hosts 1843 or $MCSTAS::sys_dir/tools/perl/hosts 1844 or use option --machines=<file>\n"); 1845 } 1846 my $text_grid="Single "; 1847 if ($MCSTAS::mcstas_config{'MPIRUN'} ne "no") { $text_grid .= "MPI "; } 1848 if ($MCSTAS::mcstas_config{'SSH'} ne "no") { $text_grid .= "Grid "; } 1849 if ($text_grid ne "") { $cmdwin->insert('end', "Clustering methods: $text_grid\n"); } 1850 if (($MCSTAS::mcstas_config{'MPIRUN'} ne "no" || $MCSTAS::mcstas_config{'SSH'} ne "no") 1851 && $Config{'osname'} ne 'MSWin32' && (not -e "$ENV{'HOME'}/.ssh/id_dsa")) { 1852 # Suggest to create DSA key for local MPI execution. 1853 putmsg($cmdwin, "Your system has MPI/SSH parallelisation available. To make use of this, \n". 1854 " please go to the Tool menu and select 'Install DSA key'.\n", 'msg'); 1855 } 1856 $w->protocol("WM_DELETE_WINDOW" => sub { editor_quit($w);}); 1857} 1858 1859# save command output into LOG file 1860sub setup_cmdwin_saveas { 1861 my ($w) = @_; 1862 my $file; 1863 my $date = localtime(time()); 1864 if($current_sim_def) { 1865 my ($inidir, $inifile); 1866 if($current_sim_def =~ m!^(.*)/([^/]*)$!) { 1867 ($inidir, $inifile) = ($1, $2); 1868 } else { 1869 ($inidir, $inifile) = ("", $current_sim_def); 1870 } 1871 $inifile =~ s/\.instr$//; 1872 $inifile.= "_${date}.log"; 1873 $inifile =~ s!\ !_!g; 1874 $file = $w->getSaveFile(-defaultextension => ".log", 1875 -title => "Select LOG output file name", 1876 -initialdir => $inidir, 1877 -initialfile => $inifile); 1878 } else { 1879 $file = $w->getSaveFile(-defaultextension => ".log", 1880 -title => "Select LOG output file name"); 1881 } 1882 return 0 unless $file; 1883 my $outputtext = $cmdwin->get('1.0', 'end'); 1884 putmsg($cmdwin, "Save log file $file\n"); 1885 open(MCLOG,">>$file"); 1886 print MCLOG "# Log file $file generated by McStas/mcgui\n"; 1887 print MCLOG "# Date: $date\n"; 1888 print MCLOG "# Current instrument: $current_sim_def\n"; 1889 print MCLOG "# Current results: $current_sim_file\n"; 1890 print MCLOG "$outputtext"; 1891 close(MCLOG); 1892 return 1; 1893} 1894 1895sub editor_quit { 1896 my ($w) = @_; 1897 if(is_erase_ok($w)) { 1898 $w->destroy; 1899 $edit_window = undef; 1900 $edit_control = undef; 1901 } 1902} 1903 1904sub Tk::CodeText::selectionModify { 1905 my ($cw, $char, $mode) = @_; 1906 my @ranges = $cw->tagRanges('sel'); 1907 my $charlength = length($char); 1908 if (@ranges >= 2) { 1909 my $start = $cw->index($ranges[0]); 1910 my $end = $cw->index($ranges[1]); 1911 my $firststart = $start; 1912 while ($cw->compare($start, "<=", $end)) { 1913 if ($mode) { 1914 if ($cw->get("$start linestart", "$start linestart + $charlength chars") eq $char) { 1915 $cw->delete("$start linestart", "$start linestart + $charlength chars"); 1916 } 1917 } else { 1918 $cw->insert("$start linestart", $char); 1919 } 1920 $start = $cw->index("$start + 1 lines"); 1921 } 1922 if (!$mode) { 1923 @ranges = $cw->tagRanges('sel'); 1924 @ranges = ($firststart, $ranges[@ranges-1]); 1925 } 1926 $cw->tagAdd('sel', @ranges); 1927 } 1928} 1929 1930sub setup_edit_1_7 { 1931 # BEWARE: The code in this sub is from McStas version 1.7, 1932 # added only for those users unable to use the CodeText 1933 # based highlighting editor below. Other features are 1934 # also missing. 1935 my ($mw, $w) = @_; 1936 # Create the editor window. 1937 my $e; 1938 # Create the editor menus. 1939 my $menu = $w->Frame(-relief => 'raised', -borderwidth => 2); 1940 $menu->pack(-fill => 'x'); 1941 my $filemenu = $menu->Menubutton(-text => 'File', -underline => 0); 1942 $filemenu->command(-label => 'New instrument', 1943 -command => [\&menu_new, $w], 1944 -underline => 0); 1945 $filemenu->command(-label => 'Save instrument', 1946 -accelerator => $shortcuts{'menusave'} , 1947 -command => [\&menu_save, $w], 1948 -underline => 0); 1949 $w->bind( $shortcuts{'menusave'} => [\&menu_save, $w]); 1950 $filemenu->command(-label => 'Save instrument as ...', 1951 -underline => 16, 1952 -command => sub {menu_saveas($w)}); 1953 $filemenu->separator; 1954 $filemenu->command(-label => 'Close', 1955 -underline => 0, 1956 -accelerator => $shortcuts{'menuclose'} , 1957 -command => sub { editor_quit($w) } ); 1958 $w->bind( $shortcuts{'menuclose'} => sub { editor_quit($w) } ); 1959 $filemenu->pack(-side=>'left'); 1960 my $editmenu = $menu->Menubutton(-text => 'Edit', -underline => 0); 1961 $editmenu->command(-label => 'Undo', 1962 -accelerator => 'Ctrl+Z', 1963 -command => [\&menu_undo, $w], -underline => 0); 1964 $w->bind('<Control-z>' => [\&menu_undo, $w]); 1965 $editmenu->separator; 1966 $editmenu->command(-label => 'Cut', 1967 -accelerator => $shortcuts{'cut'} , 1968 -command => sub { $e->clipboardCut(); }, 1969 -underline => 0); 1970 $editmenu->command(-label => 'Copy', 1971 -accelerator => $shortcuts{'copy'} , 1972 -command => sub { $e->clipboardCopy(); }, 1973 -underline => 1); 1974 $editmenu->command(-label => 'Paste', 1975 -accelerator => $shortcuts{'paste'} , 1976 -command => sub { $e->clipboardPaste(); }, 1977 -underline => 0); 1978 $editmenu->pack(-side=>'left'); 1979 my $insert_menu = $menu->Menubutton(-text => 'Insert', -underline => 0); 1980 make_insert_menu($w, $insert_menu); 1981 1982 # Create the editor text widget. 1983 $e = $w->TextUndo(-relief => 'sunken', -bd => '2', -setgrid => 'true', 1984 -height => 24); 1985 my $s = $w->Scrollbar(-command => [$e, 'yview']); 1986 $e->configure(-yscrollcommand => [$s, 'set']); 1987 $s->pack(-side => 'right', -fill => 'y'); 1988 $e->pack(-expand => 'yes', -fill => 'both'); 1989 $e->mark('set', 'insert', '0.0'); 1990 $e->Load($current_sim_def) if $current_sim_def && -r $current_sim_def; 1991 $w->protocol("WM_DELETE_WINDOW" => sub { editor_quit($w); 1992 if ( $kill_when_editor_exits == 1) { 1993 $mw->destroy(); 1994 } 1995 } ); 1996 $edit_control = $e; 1997 $edit_window = $w; 1998 if ($current_sim_def) { 1999 $w->title("Edit: $current_sim_def"); 2000 if (-r $current_sim_def) { 2001 $e->Load($current_sim_def); 2002 } 2003 } else { 2004 $w->title("Edit: Start with Insert/Instrument template"); 2005 } 2006} 2007 2008 2009sub setup_edit { 2010 my ($mw, $w) = @_; 2011 # Create the editor window. 2012 my $e; 2013 # Create the editor text widget. 2014 require Tk::CodeText; 2015 require Tk::CodeText::McStas; 2016 $e = $w->Scrolled('CodeText',-relief => 'sunken', -bd => '2', -setgrid => 'true', 2017 -height => 24, wrap => 'none', -scrollbars =>'se', 2018 -commentchar => '// ', -indentchar => " ", -updatecall => \&update_line, -syntax => 'McStas'); 2019 my $menu = $e->menu; 2020 $w->bind('<F5>' => [\&Tk::CodeText::selectionIndent]); 2021 $w->bind('<F6>' => [\&Tk::CodeText::selectionUnIndent]); 2022 $w->bind('<F7>' => [\&Tk::CodeText::selectionComment]); 2023 $w->bind('<F8>' => [\&Tk::CodeText::selectionUnComment]); 2024 $w->configure(-menu => $menu); 2025 my $insert_menu = $menu->Menubutton(-text => 'Insert', -underline => 0, -tearoff => 0); 2026 # This is only done for backward compatibility - we want to use Alt+s for saving... 2027 my $filemenu = $menu->Menubutton(-text => 'Search', -underline => 1); 2028 $w->bind( $shortcuts{'menusave'} => [\&menu_save, $w]); 2029 make_insert_menu($w, $insert_menu); 2030 my $label = $w->Label(-bd => '1', -text => 'Current line: 1'); 2031 $e->pack(-expand => 'yes', -fill => 'both'); 2032 $label->pack(-side => 'left', -expand => 'no', -fill => 'x'); 2033 $e->mark('set', 'insert', '0.0'); 2034 $w->protocol("WM_DELETE_WINDOW" => sub { editor_quit($w); 2035 if ( $kill_when_editor_exits == 1) { 2036 $mw->destroy(); 2037 } 2038 } ); 2039 $edit_control = $e; 2040 $edit_window = $w; 2041 $edit_label = $label; 2042 if ($current_sim_def) { 2043 $w->title("Edit: $current_sim_def"); 2044 if (-r $current_sim_def) { 2045 $e->Load($current_sim_def); 2046 } 2047 } else { 2048 $w->title("Edit: Start with Insert/Instrument template"); 2049 } 2050} 2051 2052sub Tk::TextUndo::FileSaveAsPopup 2053{ 2054 my ($w)=@_; 2055 menu_saveas($w); 2056} 2057 2058sub Tk::TextUndo::FileLoadPopup 2059{ 2060 my ($w)=@_; 2061 my $name = $w->CreateFileSelect('getOpenFile',-title => 'File Load'); 2062 if (defined($name) && length($name)){ 2063 open_instr_def($w, $name); 2064 return 1; 2065 } 2066 return 0; 2067} 2068 2069# GUI callback function for updating line numbers etc. 2070sub update_line { 2071 if (defined($edit_control)) { 2072 my ($line,$col) = split(/\./,$edit_control->index('insert')); 2073 my ($last_line,$last_col) = split(/\./,$edit_control->index('end')); 2074 $last_line=$last_line-1; 2075 $edit_label->configure(-text => " Line: $line of $last_line total, Column: $col"); 2076 } 2077} 2078 2079# Check if simulation needs recompiling. 2080sub check_if_need_recompile { 2081 my ($simname) = @_; 2082 my $exename; 2083 if($simname =~ /^(.*)\.(instr|ins)$/) { 2084 $exename = $1; 2085 } else { 2086 $exename = "$simname.$MCSTAS::mcstas_config{'EXE'}"; 2087 } 2088 return "not found" unless -f $exename; 2089 return "not executable" unless -x $exename; 2090 my @stat1 = stat($simname); 2091 my @stat2 = stat($exename); 2092 return "source is newer" unless $stat1[9] < $stat2[9]; 2093 return ""; 2094} 2095 2096my $win = new MainWindow; 2097 2098eval { # Try specified color palette... 2099 $win -> setPalette($MCSTAS::mcstas_config{'TKPALETTE'}); 2100}; 2101if ($@) { # or continue with system default if that failed. 2102 printf "Specified colorscheme '$MCSTAS::mcstas_config{'TKPALETTE'}' failed. Using system default.\n"; 2103} 2104 2105if (!($MCSTAS::mcstas_config{'TKFONT'} eq "")) { # Only try loading a font if non-empty string is defined 2106 eval { # Try loading specified font... 2107 $win->optionAdd("*font", $MCSTAS::mcstas_config{'TKFONT'}); 2108 $win->optionAdd("*borderWidth", 1); 2109 }; 2110 if ($@) { # or continue with system default if that failed 2111 printf "Specified font '$MCSTAS::mcstas_config{'TKFONT'}' failed. Using system default.\n"; 2112 } 2113} 2114 2115$main_window = $win; 2116setup_menu($win); 2117setup_cmdwin($win); 2118 2119my $open_editor = 0; 2120 2121if(@ARGV>0 && @ARGV<3) { 2122 # Check if one of the input arguments is '--open' 2123 # if so, start the editor of choice immediately 2124 my $j; 2125 my $filenames; 2126 for ($j=0; $j<@ARGV; $j++) { 2127 if ($ARGV[$j] eq "--help") { 2128 print "mcgui <instrument_file>\n"; 2129 print " [--help] Display command help\n"; 2130 print " [--open] Start with the editor opened\n"; 2131 print " [--edit] Edit instrument only\n"; 2132 print "SEE ALSO: mcstas, mcdoc, mcplot, mcrun, mcgui, mcresplot, mcstas2vitess, mcformat\n"; 2133 print "DOC: Please visit http://www.mcstas.org\n"; 2134 exit; 2135 } elsif ($ARGV[$j] eq "--open") { 2136 $open_editor = 1; 2137# menu_edit_current($win); 2138 } elsif ($ARGV[$j] eq "--edit") { 2139 $open_editor = 1; 2140 $win->withdraw; 2141 $kill_when_editor_exits = 1; 2142 } else { 2143 $filenames = "$ARGV[$j]"; 2144 } 2145 } 2146 2147 # Most likely, everything on the commandline is a filename... Join using 2148 # spaces, e.g. mcgui.pl My Documents\My Simulation.instr 2149 open_instr_def($win, $filenames); 2150 if ($open_editor == 1) { 2151 menu_edit_current($win); 2152 } 2153} else { 2154# menu_open($win); 2155} 2156 2157# On Unix systems - when PGPLOT/McCode format is chosen, ensure to start pgxwin_server 2158if ($Config{'osname'} ne 'MSWin32' && $MCSTAS::mcstas_config{'PLOTTER'} =~ /PGPLOT|McStas|McXtrace|Gnuplot/i) { 2159 require "mcplotlib.pl"; 2160 ensure_pgplot_xserv_started() 2161} 2162 2163MainLoop; 2164