KhorosToMatLab.old | searchcode

/matlab_tools/KhorosToMatLab.old

http://github.com/aludnam/MATLAB
Perl | 451 lines | 428 code | 3 blank | 20 comment | 32 complexity | 922604cf7d371f68376f26a0ea737d99 MD5 | raw file
Possible License(s): BSD-3-Clause

#!/usr/bin/perl
#  first argument is the .pane file, which is used to generate a matlab script
# second (optional) argument is the corresponding help-file

@lines = `cat $ARGV[0]`;
@fname = split /[\/\.]/,$ARGV[0];
$fname = @fname[-2];
$rname = $fname;
@paramtype = (); @paramtags = (); @paramname = (); @paramdesc = (); @defaults = (); @optional = (); @minval = (); @maxval = ();
@inputtags = (); @inputname = (); @inputdesc = (); @inputdef = (); 
@outputtags = (); @outputname = (); @outputdesc = (); @outputdef = (); 
$inMultiToggle=0;
$NumReqOutputs=0;
foreach (@lines) {
# print "separating: $_\n";
 @fields = split;
 @jfields = ();
 $instring=0;
 $astring="";
# rejoin fields that were protected by '
 foreach (@fields) {
   if ($instring == 0)
      {
# Expression starts with whitespace and a ', but not a protected whitespace
        if (/^\s*'/ && !/^\s*\\'/)
        {
           $instring=1;
           $astring=$_;
# same expression also ends with a non-protected ' and trailing whitespace
           if (/^\s*'.+'\s*$/ && !/^\s*'.+\\'\s*$/)
           {
              $instring=0;
              push @jfields,$astring;
           }
        }
        else
        {
           push @jfields,$_;
        }
      }
   else
      {
        $astring= "$astring $_";
# This is a non-protected ending ' with maybe whitespace
        if (/'\s*/ && !/\\'\s*/)
        {
           $instring=0;
           push @jfields,$astring;
        }
      }
 }
if (@jfields[0] eq '-M')
  {
    $progdescr = @jfields[5];
  }
if (@jfields[0] eq '-T')
  {
   push @paramtype, 'MultiChoice';
   push @paramtags, @jfields[-1];
   push @paramname, @jfields[-3];
# paramdesc will follow at end
   $choices = "@jfields[-2]\n%    Choices are:";
   push @minval, 0;
   push @maxval, 0;
   push @defaults, @jfields[-4];
   $inMultiToggle=1;
  }
if (@jfields[0] eq '-E')
  {
   if ($inMultiToggle != 0)
   {
   $inMultiToggle=0;
   push @paramdesc, $choices;
   }
  }
if (@jfields[0] eq '-t')
  {
   if ($inMultiToggle == 0)
   {
   push @paramtype, 'Toggle';
   push @paramtags, @jfields[-1];
   push @paramname, @jfields[-3];
   push @paramdesc, @jfields[-2];
   push @minval, 0;
   push @maxval, 0;
   push @defaults, @jfields[-5];
   }
   else
   {
   $choices = "$choices\n%   $inMultiToggle: @jfields[-3]";
   $inMultiToggle += 1;
   }
 }
if (@jfields[0] eq '-s')
  {
   push @paramtype, 'String';
   push @paramtags, @jfields[-1];
   push @paramname, @jfields[-3];
   push @paramdesc, @jfields[-2];
   push @minval, 0;
   push @maxval, 0;
   push @defaults, @jfields[-4];
 }
if (@jfields[0] eq '-i')
  {
   push @paramtype, 'Integer';
   push @paramtags, @jfields[-1];
   push @paramname, @jfields[-3];
   push @paramdesc, @jfields[-2];
   push @minval, @jfields[-8];
   push @maxval, @jfields[-7];
   push @defaults, @jfields[-6];
 }
if (@jfields[0] eq '-f')
  {
   push @paramtype, 'Double';
   push @paramtags, @jfields[-1];
   push @paramname, @jfields[-3];
   push @paramdesc, @jfields[-2];
   push @minval, @jfields[-9];
   push @maxval, @jfields[-8];
   push @defaults, @jfields[-7];
 }
if (@jfields[0] eq '-I')
  {
   push @inputtags, @jfields[-1];
   push @inputname, @jfields[-3];
   push @inputdesc, @jfields[-2];
   push @inputdef, @jfields[-4];
   push @paramtype, 'InputFile';
   push @paramtags, @jfields[-1];
   push @paramname, @jfields[-3];
   push @paramdesc, @jfields[-2];
   push @minval, @jfields[3];
   push @maxval, @jfields[3];
   push @defaults, '\'__input\'';
 }
if (@jfields[0] eq '-O')
  {
   push @outputtags, @jfields[-1];
   push @outputname, @jfields[-3];
   push @outputdesc, @jfields[-2];
   push @outputdef, @jfields[-4];
   push @paramtype, 'OutputFile';
   push @paramtags, @jfields[-1];
   push @paramname, @jfields[-3];
   push @paramdesc, @jfields[-2];
   push @minval, @jfields[3];
   push @maxval, @jfields[3];
   push @defaults, '\'__output\'';
   if (@jfields[3] == 0) # required output
     {$NumReqOutputs += 1;}
 }
if (@jfields[0] eq '-R')
  {
   $requiredParams = "$requiredParams @jfields[8]";
   @myfields = split /\//,@jfields[7];
   $rname = @myfields[-1];
  }

# $j=0; foreach (@jfields) { print "item $j: $_\n"; $j += 1; }
}

# now it's time to generate the MatLab program
print "%k$fname $progdescr\n";
print "% This MatLab function was automatically generated by a converter (KhorosToMatLab) from the Khoros $fname.pane file\n";
print "%\n% Parameters: \n";
$i=0;
foreach (@paramtags) {
   $mydefault=@defaults[$i];
   if ($mydefault eq '\'__input\'' || $mydefault eq '\'__output\'') 
     {
       if (@minval[$i] > 0) {$mydefault= "optional";} 
       else {$mydefault="required";}
     }
   else {$mydefault="default: $mydefault";}
print "% @paramtype[$i]: $_ @paramname[$i], $mydefault: @paramdesc[$i]\n";
$i += 1;
}
# $i=0;
# print "% Ordered Inputs (can be omitted from the trailing end)\n";
# foreach (@inputtags) {
# print "% @inputname[$i] $_, default: @inputdef[$i]: @inputdesc[$i]\n";
# $i += 1;
# }
# $i=0;
# print "% Ordered Outputs (can be omitted from the trailing end)\n";
# foreach (@outputtags) {
# print "% @outputname[$i] $_, default: @outputdef[$i]: @outputdesc[$i]\n";
# $i += 1;
# }

print "%\n% Example: ";
if ($#outputtags >= 1) {print "[";}
$i=0;
foreach (@outputtags)
{
if ($#outputtags >= 0) {print "$_";}
   if ($i < $#outputtags)
      {print ", ";}
   $i += 1;
}
if ($#outputtags >= 1) {print "]";}
if ($#outputtags >= 0) {print " = ";}
print "k$fname(";
$i=0;
if ($#inputtags >= 1) {print "{";}
foreach (@inputtags)
{
   print "$_";
   if ($i < $#inputtags)
      {print ", ";}
   $i += 1;
}
if ($#inputtags >= 1) {print "}";}
if ($i > 0) {print ",";}
print " {";
$i=0;
foreach (@paramtags) {
   $mydefault=@defaults[$i];
   if ($mydefault eq '\'__input\'' || $mydefault eq '\'__output\'') { print "\'$_\',\'\'"; }
   else {print "\'$_\',$mydefault";}
   if ($i < $#paramtags)
      {print ";";}
   $i += 1;
}
print "})\n%\n";

# Parse the helpfile and append it to the description
$helpfile=$ARGV[1];
if ($helpfile)
  {
    print "% Khoros helpfile follows below:\n";
    @lines = `cat $helpfile`;
    $indent = "";
    foreach (@lines) {
# Expression starts with whitespace and a ', but not a protected whitespace
      s/\\-/-/;  # correct protected "-"
      if (s/\\\(bu/* /) { $_=""; $bullet="true";}
      if (s/\.br//) { $_="";}
      if (s/\.sp//) { $_="";}
      if (s/\.LP//) { $_="\n";}
      if (s/\.IP//) { $_="\n% $_";}
      if (s/\.RS//) { $indent="$indent\t";}
      if (s/\.RE//) { $indent=substr($indent,0,-1);}
      s/\\fH/\"/; 
      s/\\fP/\"/; 
      s/\\fI/\"/; 
      s/\.nf//; 
      s/\.fi//; 
      s/\.paragraph//; 
      s/\"PANE ARGUMENTS\"//; 
      if (s/.section 1//)
	{
	  print "%\n";
	}
      if (/^\s*.onlineHelp/)
	{$_=""}  # ignore
      if (/^\s*.syntax/)
	{$_=""}  # ignore
      if ($_ ne "")
	{
	  if ($bullet eq "true")
	    {print "% $indent- $_";$bullet=""}
	  else
	    {print "% $indent$_";}
	}
    }
  }
print "\n\n";
    

print "function varargout = k$fname(varargin)\n";
if ($#inputtags >= 0) 
  {
    print "if nargin ==0\n  Inputs={};arglist={'',''};\n";
    print "elseif nargin ==1\n  Inputs=varargin{1};arglist={'',''};\n";
    print "elseif nargin ==2\n  Inputs=varargin{1}; arglist=varargin{2};\n";
    print "else error('Usage: [out1,..] = k$fname(Inputs,arglist).');\nend\n";
  }
else
  {
    print "Inputs={};\n";
    print "if nargin ==0\n  arglist={'',''};\n";
    print "elseif nargin ==1\n  arglist=varargin{1};\n";
    print "else error('Usage: [out1,..] = k$fname(arglist).');\nend\n";
  }
print "if size(arglist,2)~=2\n  error('arglist must be of form {''ParameterTag1'',value1;''ParameterTag2'',value2}')\n end\n";

print "narglist={";
$i=0;
foreach (@paramtags) {
   print "\'$_\', @defaults[$i]";
   if ($i < $#paramtags)
      {print ";";}
   $i += 1;
}
print "};\n";

print "maxval={";
$i=0;
foreach (@maxval) {
   print "$_";
   if ($i < $#maxval)
      {print ",";}
   $i += 1;
}
print "};\n";

print "minval={";
$i=0;
foreach (@minval) {
   print "$_";
   if ($i < $#minval)
      {print ",";}
   $i += 1;
}
print "};\n";

print "paramtype={";
$i=0;
foreach (@paramtype) {
   print "\'$_\'";
   if ($i < $#paramtype)
      {print ",";}
   $i += 1;
}
print "};\n";

print "% identify the input arrays and assign them to the arguments as stated by the user\n";
print "if ~iscell(Inputs)
Inputs = {Inputs};
end\n";

print "NumReqOutputs=$NumReqOutputs; nextinput=1; nextoutput=1;
  for ii=1:size(arglist,1)
  wasmatched=0;
  for jj=1:size(narglist,1)
   if strcmp(arglist{ii,1},narglist{jj,1})  % a given argument was matched to the possible arguments
     wasmatched = 1;
     if strcmp(narglist{jj,2}, '__input')
      if (nextinput > length(Inputs)) 
        error(['Input ' narglist{jj,1} ' has no corresponding input!']); 
      end
      narglist{jj,2} = 'OK_in';
      nextinput = nextinput + 1;
     elseif strcmp(narglist{jj,2}, '__output')
      if (nextoutput > nargout) 
        error(['Output nr. ' narglist{jj,1} ' is not present in the assignment list of outputs !']); 
      end
      narglist{jj,2} = 'OK_out';
      nextoutput = nextoutput + 1;
      if (minval{jj} == 0)  
         NumReqOutputs = NumReqOutputs - 1;
      end
     elseif isstr(arglist{ii,2})
      narglist{jj,2} = arglist{ii,2};
     else
        if strcmp(paramtype{jj}, 'Integer') & (round(arglist{ii,2}) ~= arglist{ii,2})
            error(['Argument ' arglist{ii,1} ' is of integer type but non-integer number ' arglist{ii,2} ' was supplied']);
        end
        if (minval{jj} ~= 0 | maxval{jj} ~= 0)
          if (minval{jj} == 1 & maxval{jj} == 1 & arglist{ii,2} < 0)
            error(['Argument ' arglist{ii,1} ' must be bigger or equal to zero!']);
          elseif (minval{jj} == -1 & maxval{jj} == -1 & arglist{ii,2} > 0)
            error(['Argument ' arglist{ii,1} ' must be smaller or equal to zero!']);
          elseif (minval{jj} == 2 & maxval{jj} == 2 & arglist{ii,2} <= 0)
            error(['Argument ' arglist{ii,1} ' must be bigger than zero!']);
          elseif (minval{jj} == -2 & maxval{jj} == -2 & arglist{ii,2} >= 0)
            error(['Argument ' arglist{ii,1} ' must be smaller than zero!']);
          elseif (minval{jj} ~= maxval{jj} & arglist{ii,2} < minval{jj})
            error(['Argument ' arglist{ii,1} ' must be bigger than ' num2str(minval{jj})]);
          elseif (minval{jj} ~= maxval{jj} & arglist{ii,2} > maxval{jj})
            error(['Argument ' arglist{ii,1} ' must be smaller than ' num2str(maxval{jj})]);
          end
        end
     end
     if ~strcmp(narglist{jj,2},'OK_out') &  ~strcmp(narglist{jj,2},'OK_in') 
       narglist{jj,2} = arglist{ii,2};
     end
   end
   end
   if (wasmatched == 0 & ~strcmp(arglist{ii,1},''))
        error(['Argument ' arglist{ii,1} ' is not a valid argument for this function']);
   end
end\n";
# print "if (nextoutput > 1 & (nextoutput-1) ~= nargout)
#           error('Number of outputs does not correspond to number of output tags in argument list!');
#end\n";
#print "narglist\nInputs";
print "% match the remaining inputs/outputs to the unused arguments and test for missing required inputs
 for jj=1:size(narglist,1)
     if  strcmp(paramtype{jj}, 'Toggle')
        if (narglist{jj,2} ==0)
          narglist{jj,1} = ''; 
        end;
        narglist{jj,2} = ''; 
     end;
     if strcmp(narglist{jj,2}, '__input')
      if (minval{jj} == 0)  % meaning this input is required
        if (nextinput > size(Inputs)) 
           error(['Required input ' narglist{jj,1} ' has no corresponding input in the list!']); 
        else
          narglist{jj,2} = 'OK_in';
          nextinput = nextinput + 1;
        end
      else  % this is an optional input
        if (nextinput <= length(Inputs)) 
          narglist{jj,2} = 'OK_in';
          nextinput = nextinput + 1;
        else 
          narglist{jj,1} = '';
          narglist{jj,2} = '';
        end;
      end;
     else 
     if strcmp(narglist{jj,2}, '__output')
      if (minval{jj} == 0) % this is a required output
        if (nextoutput > nargout & nargout > 1) 
           error(['Required output ' narglist{jj,1} ' is not stated in the assignment list!']); 
        else
          narglist{jj,2} = 'OK_out';
          nextoutput = nextoutput + 1;
          NumReqOutputs = NumReqOutputs-1;
        end
      else % this is an optional output
        if (nargout - nextoutput >= NumReqOutputs) 
          narglist{jj,2} = 'OK_out';
          nextoutput = nextoutput + 1;
        else 
          narglist{jj,1} = '';
          narglist{jj,2} = '';
        end;
      end
     end
  end
end\n";

# print "Inputs\nnarglist\narglist\nminval\nmaxval\nparamtype\n";
# print "narglist\n";

print "if nargout
   varargout = cell(1,nargout);
else\n";
if ($#outputtags >= 0) {print "  varargout = cell(1,1);\n"}
else {print "  varargout = cell(0);\n"}
print "end\n";
print "[s,w] = system('which cantata');\nw=w(1:end-8);";
# print "\[w \'$rname $requiredParams\'\]\n";
if ($#outputtags >= 0) { print "[varargout{:}]=callKhoros(\[w '$rname $requiredParams\'],Inputs,narglist);\n";}
else { print "callKhoros(\[w \'$rname $requiredParams\'\],Inputs,narglist);\n";}