#! /usr/bin/perl -w
#
# Converts McStas instruments to Vitess equivalents. Has not been tested
# with current versions of Vitess (20031128)
#
# This file is part of the McStas neutron ray-trace simulation package
# Copyright (C) 1997-2004, All rights reserved
# Risoe National Laborartory, Roskilde, Denmark
# Institut Laue Langevin, Grenoble, France
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# Determine the path to the McStas system directory. This must be done
# in the BEGIN block so that it can be used in a "use lib" statement
# afterwards.
BEGIN {
if($ENV{"MCSTAS"}) {
$MCSTAS::sys_dir = $ENV{"MCSTAS"};
} else {
$MCSTAS::sys_dir = "/usr/local/lib/mcstas";
}
$MCSTAS::perl_dir = "$MCSTAS::sys_dir/tools/perl"
}
use lib $MCSTAS::perl_dir;
use FileHandle;
require "mcstas_config.perl";
require "mcrunlib.pl";
sub make_instr_file {
my ($F, $par, $d) = @_;
my $double_decl = "";
my $str_decl = "";
my $double_adr = "";
my $str_adr = "";
my $double_letters = "";
my $str_letters = "";
my $comp_name = $d->{'name'};
my $comp_actuals = "";
for (@$par) {
my ($p, $let, $typ) = @$_;
$comp_actuals = $comp_actuals ? "$comp_actuals, $p=$p" : "$p=$p";
if($typ eq 'double') {
$double_decl = $double_decl ? "$double_decl, $p" : "double $p";
$double_adr = $double_adr ? "$double_adr &$p," : "&$p,";
$double_letters = $double_letters ? "$double_letters '$let'," : "'$let',";
} elsif($typ eq 'string') {
$str_decl = $str_decl ? "$str_decl, *$p" : "char *$p";
$str_adr = $str_adr ? "$str_adr &$p," : "&$p,";
$str_letters = $str_letters ? "$str_letters '$let'," : "'$let',";
} else {
die "Internal: make_instr_file()";
}
}
print $F <<INSTR_END;
DEFINE INSTRUMENT McStas_$comp_name()
/*
* This file has been automatically generated using the mcstas2vitess tool.
* See http://www.mcstas.org
* Component $comp_name converted into an instrument with Vitess I/O functions
*/
DECLARE
%{
/* Component parameters. */
$double_decl;
$str_decl;
double pos_x, pos_y, pos_z;
double *dptr[] =
{
$double_adr
&pos_x, &pos_y, &pos_z,
0
};
char **sptr[] =
{
$str_adr
0
};
char dchr[] =
{
$double_letters
'x', 'y', 'z', 0
};
char schr[] =
{
$str_letters
0
};
/* vitess-lib will be included when embedding Vitess_input component */
/* Pointer to check whether all neutrons have been read. */
int *check_finished;
/* Our main() function. */
int main(int argc, char *argv[])
{
vitess_main(argc, argv, &check_finished, dptr, dchr, sptr, schr);
exit(0);
}
%}
INITIALIZE
%{
%include "vitess-lib.h"
/* This double-indirection is necessary here since MC_GETPAR is not
available in the DECLARE section. */
check_finished = &MC_GETPAR(vitess_in, finished);
%}
TRACE
COMPONENT vitess_in = Vitess_input(
file = vitess_infile, repeat_count = vitess_repcnt,
bufsize = vitess_bufsize)
AT (0, 0, 0) ABSOLUTE
COMPONENT comp = $comp_name(
$comp_actuals)
AT (pos_x, pos_y, pos_z) ABSOLUTE
ROTATED (0, 0, 0) ABSOLUTE
COMPONENT vitess_out = Vitess_output(
file = vitess_outfile, bufsize = vitess_bufsize,
progress = vitess_tracepoints)
AT (0, 0, 0) ABSOLUTE
END
INSTR_END
}
sub make_tcl_file {
my ($F, $par, $d) = @_;
print $F "### $d->{'name'}\n###\n";
print $F "gSet mcstas_", lc($d->{'name'}), "ESET {\n";
my $dsc = $d->{'identification'}{'short'};
chomp $dsc;
$dsc =~ s/\n/\\n/g;
print $F " {\"$dsc\" header}\n";
for (@$par) {
my ($p, $let, $typ) = @$_;
print $F " {$p ";
if($typ eq 'double') {
print $F "float";
if($d->{'parhelp'}{$p}{'default'}) {
print $F " $d->{'parhelp'}{$p}{'default'}";
} else {
print $F " \"\"";
}
} elsif($typ eq 'string') {
print $F "string";
if($d->{'parhelp'}{$p}{'default'}) {
print $F " \"$d->{'parhelp'}{$p}{'default'}\"";
} else {
print $F " \"\"";
}
} else {
die "Internal: make_tcl_file()";
}
print $F " {\"$p";
print $F " [$d->{'parhelp'}{$p}{'unit'}]" if $d->{'parhelp'}{$p}{'unit'};
print $F "\" ";
print $F "\"";
if($d->{'parhelp'}{$p}{'text'}) {
my $txt = $d->{'parhelp'}{$p}{'text'};
$txt =~ s/\s+$//;
$txt =~ s/\n/\\n/g;
print $F $txt;
}
print $F "\" ";
print $F "\"\" $let}";
if($typ eq 'double') {
print $F " 1" unless $d->{'parhelp'}{$p}{'default'};
} elsif($typ eq 'string') {
print $F " \"\" \"\" 1" unless $d->{'parhelp'}{$p}{'default'};
} else {
die "Internal: make_tcl_file()";
}
print $F "}\n";
}
print $F " {xpos float 0 {\"X position [m]\" \"X position of module\" \"\" x}}\n";
print $F " {ypos float 0 {\"Y position [m]\" \"Y position of module\" \"\" y}}\n";
print $F " {zpos float 0 {\"Z position [m]\" \"Z position of module\" \"\" z}}\n";
print $F "}\n";
}
if(@ARGV != 1) {
print STDERR "Usage: mcstas2vitess component\n";
print STDERR " This tool enables to convert a single McStas component into\n";
print STDERR " a Vitess module. Component string parameters should be declared\n";
print STDERR " as 'char*' setting parameters. Default values are allowed.\n";
print STDERR "SEE ALSO: mcstas, mcdoc, mcplot, mcrun, mcgui, mcresplot, mcstas2vitess\n";
print STDERR "DOC: Please visit http://www.mcstas.org\n";
exit 1;
}
my $compfile = $ARGV[0];
my $compname = $compfile;
$compname = $1 if $compname =~ /^(.*)\.(comp|cmp|com)$/;
my $data = component_information($compfile);
die "Failed to get information for component '$compfile'"
unless defined($data);
# Read the corresponding .vif file if available.
my %vif = ();
my %vifletters = ();
my $VIF = new FileHandle;
my $vifname = "$compname.vif";
if(open($VIF, $vifname)) {
while(<$VIF>) {
if(/^\s*([a-zA-Z���0-9_]+)\s+-([a-zA-Z0-9])\s+(string|double)\s*$/) {
$vif{$1} = [$2, $3];
$vifletters{$2} = $1;
} elsif(/^\s*([a-zA-Z���0-9_]+)\s+-([a-zA-Z0-9])\s*$/) {
$vif{$1} = [$2, 'double'];
$vifletters{$2} = $1;
} else {
die "Invalid line:\n$_\nin VITESS information file '$vifname'";
}
}
close $VIF;
} else {
print "Note: No VITESS information file (.vif) found.\n";
}
# Now decide on how the name and type of each component parameter.
# The following option letters are not available: fFJLZABxyz
my @optletter = ('a', 'b', 'c', 'd', 'e', 'g', 'h', 'i',
'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q',
'r', 's', 't', 'u', 'v', 'w', 'C', 'D',
'E', 'G', 'H', 'I', 'K', 'M', 'N', 'O',
'P', 'Q', 'R', 'S', 'T', 'Y', 'V', 'W',
'X', 'Y');
my @param = ();
my $p;
for $p (@{$data->{'inputpar'}}) {
# First look for an option letter from the .vif.
my ($let, $typ) = $vif{$p} ? @{$vif{$p}} : (undef, undef);
unless($let) {
# Pick a default option letter not mentioned in the .vif.
do {
$let = shift @optletter;
} while($let && $vifletters{$let});
die "Too many component parameters!" unless $let;
}
if($p =~ /(char\s*\*|string)\s+([a-zA-Z���0-9_]+)/i)
{ $typ = 'string'; $p=$2; }
$typ = 'double' unless $typ;
push @param, [$p, $let, $typ];
}
print "mcstas2vitess: Converting McStas component ${compname} into Vitess Module 'McStas_${compname}'\n";
# Output the .instr file.
my $INSTR = new FileHandle;
my $instr_name = "McStas_${compname}.instr";
my $c_name = "McStas_${compname}.c";
open($INSTR, ">$instr_name") ||
die "Could not open output Vitess Module instrument file '$instr_name'.";
make_instr_file($INSTR, \@param, $data);
close($INSTR);
print "Wrote Vitess Module instrument file '$instr_name'.\n";
my @mcstas_cmd = ("mcstas", "--no-main", "-o", $c_name, $instr_name);
print join(" ", @mcstas_cmd), "\n";
if(system(@mcstas_cmd)) {
print "*** Error exit ***\n";
print STDERR "McStas compilation failed.\n";
exit 1;
}
print "Wrote C file '$c_name'.\n";
my $out_name = "McStas_${compname}";
my $cc = $ENV{'MCSTAS_CC'} || $MCSTAS::mcstas_config{CC};
my $cflags = $ENV{'MCSTAS_CFLAGS'} || $MCSTAS::mcstas_config{CFLAGS};
my $vitess_lib_name = "vitess-lib.c";
$vitess_lib_name = $MCSTAS::sys_dir . "/share/" . $vitess_lib_name
unless -r $vitess_lib_name;
die "Cannot find VITESS library file '$vitess_lib_name'"
unless -r $vitess_lib_name;
my @cc_cmd = ($cc, split(' ', $cflags), "-o", $out_name,
"-I$MCSTAS::sys_dir", $c_name, "-lm");
print join(" ", @cc_cmd), "\n";
if(system(@cc_cmd)) {
print "*** Error exit ***\n";
print STDERR "C compilation failed.\n";
exit 1;
}
print "Wrote executable Vitess Module file '$out_name'.\n";
# Output the .tcl file for the VITESS gui.
my $TCL = new FileHandle;
my $tcl_name = "McStas_${compname}.tcl";
open($TCL, ">$tcl_name") ||
die "Could not open output Vitess Module Tcl file '$tcl_name'.";
make_tcl_file($TCL, \@param, $data);
close($TCL);
print "Wrote Vitess Module Tcl GUI file '$tcl_name'.\n";
print "mcstas2vitess: Convertion has been performed\n";
exit 0;
syntax highlighted by Code2HTML, v. 0.9.1