#!/bin/usr/perl;
# GAUSS TO MATLAB PERL SCRIPT
# This version translates body of code only
# you need to set up functions, delcarations etc. on your own
   
###################################################################
# START OF MAIN PROCEDURE IS HERE - GO THROUGH COMMENTS AND CODE ONE
# LINE AT A TIME, SEPERATING CODE AND COMMENT FRAGMENTS
# CALLING TRANSCODE TO TRANSLATE CODE TO GAUSS ETC.

$comflag=0; # open comment flag
$rlcomflag=0;
$nlcom=0; $nrcom=0; $comdum=0;
$curcom=""; $curcode="";
while (<>){
 if ($curcode eq "\n"){
    #print "\n";
    $curcode="";}
 $ipos=0;
 if ($comdum==1){
    $curcom=$curcom."\%";} # begin continuations of comments with %
 while ($ipos <= length($_)){
   if (substr($_,$ipos,2) eq "\/\*"){
      if ($nlcom==0){
        $nlcom=$nlcom+1;
        $curcom="\%"; # start constructing comment
        $ipos=$ipos+2;
        $comdum=1;}  # turn comment dummy on
      else{
        $nlcom=$nlcom+1;
        $curcom=$curcom."\%"; # use % comment % for nested
        $ipos=$ipos+2;}
   }
   elsif (substr($_,$ipos,2) eq "\*\/"){
      $nrcom=$nrcom+1;
      if ($nrcom==$nlcom){
         print $curcom."\n"; # closing comment
         $ipos=$ipos+2;
         $nlcom=0; $nrcom=0;
         $comdum=0; $curcom="";} # turn comment dummy off
      else{$curcom=$curcom.substr($_,$ipos,2);
           $curcom=$curcom."\%"; # use % comment % for nested
           $ipos=$ipos+2;}
   }
   elsif (substr($_,$ipos,1) eq "\;"){
      if ($comdum==0){
         $curcode=~ s/local.*\;//;
         $curcode=$curcode."\;";
         $curcode=~ s/\n//;
         ###########################################################
         # have a complete code fragment now scan it for Gauss info
         ###########################################################
          if ($nuke1proc==1 && $newdum==0)
          {
           if ($curcode =~ /proc.*\;/)
            {
             $curcode =~s/proc\(.*\)\=(.*\(.*\))\;//;
             $curcode =~s/proc (.*\(.*\))\;//;
             $curcode =~s/proc\(.*\)\=(\w*)\;//;
             $curcode =~s/proc\s*(\w*)\;//;
             $nuke1proc=0;}
           } # ends if nuke1proc
          else{
            if ($curcode =~/proc\W.*\;/)
              {
              print "function ".$mainret[$procind]."=".$proc[$procind]."\n";
              if ($prfnames[$procind] ne ""){
                 if ($nfnames[$procind]>1){
                   print "% Note:  ".$prfnames[$procind]." are function names and must be passed as strings\n";
                  }else{
                  $prfnames[$procind]=~ s/and//;
                  print "% Note:  ".$prfnames[$procind]." is a function name and must be passed as strings\n";
                  }
               }
             print $gdecline;
             $curcode =~s/proc\(.*\)\=(.*\(.*\))\;//;
             $curcode =~s/proc (.*\(.*\))\;//;
             $curcode =~s/proc\(.*\)\=(\w*)\;//;
             $curcode =~s/proc\s*(\w*)\;//;
             $procind=$procind+1;
             }
          }
          if ($curcode =~/retp/)
           {
           print $spec[$retind];
           $curcode =~s/\s?retp\(.*\).*//;
           $curcode =~s/\s?retp\;//;
           $retind=$retind+1;
           }
          $curcode =~s/\s?endp\s?\;/\n/;
        ######################################################
        # completes scan for gauss function info now pad & translate
        ######################################################
        $initspace="";
        if ($curcode =~ /^\s/==1){
           $initspace=$curcode;
           $initspace =~ /(\s*)(\S*)(.*)/;
           $initspace =$1;}
        else{
           $initspace="";
         }
         #$initspace=s/\w//;

         $curcode =~ s/(^\s*)(\S*)/\2/g;
         while ($curcode =~/\W\s/){ $curcode =~ s/(\W)(\s)/\1/;}
         while ($curcode =~/\s\W/){ $curcode =~ s/\s(\W)/\1/;}
         $initspace =~ s/\n//g;
         $initspace =~ s/\S*//g;

         $newcode=&transproc($curcode);  # translate code fragment
         $ipos=$ipos+1;
         # print code fragment
         if (length($newcode)<70){
            if ($newcode =~ /\n/){print $initspace.$newcode;}
            else{print $initspace.$newcode."\n";}
         } # print short code frag's outright
         else{ #chop line up
         $contfl=1;
         $restcode=$newcode;
         $newcode2=$initspace;
         #$newcode2="";
         while ($contfl==1){
            $cpos=0;  $lastnw=0;
            if (length($restcode)<75){
               $contfl=0;
               $newcode2=$newcode2.$restcode;
               }
            else{
              while ($cpos<=70){
               if (substr($restcode,$cpos,1)=~ /\W/){
                 $lastnw=$cpos;
                 $cpos=$cpos+1;}
               else{ $cpos=$cpos+1;}
              } # ends whle cpos<=70
            if ((substr($restcode,$lastnw,1) eq "\=") ||
               (substr($restcode,$lastnw,1) eq "\>") ||
               (substr($restcode,$lastnw,1) eq "\<") ||
               (substr($restcode,$lastnw,1) eq "\'") ||
               (substr($restcode,$lastnw,1) eq "\:"))
               {$lastnw=$lastnw+1;}; # bring it back up
            if (substr($restcode,$lastnw-1,1) eq "\.")
               {$lastnw=$lastnw-1;}
            $newcode2=$newcode2.substr($restcode,0,$lastnw)." \.\.\.\n   ";
            $restcode=substr($restcode,$lastnw);
            }
         } # ends while contfl=1
         print $newcode2."\n";
         } # ends chop line up
         $curcode="";}
      else{$curcom=$curcom.substr($_,i,1);
           $ipos=$ipos+1;}
    }
    else{
      if ($comdum==0){$curcode=$curcode.substr($_,$ipos,1);}
      else{$curcom=$curcom.substr($_,$ipos,1);}
      $ipos=$ipos+1;
    }
 } #ends while i <length ($_)
} # ends main line-by-line loop
close(ARGV); # close standard input file
exit;

################################################################
# MAIN ENGINE TO TRANSLATE GAUSS CODE TO MATLAB
# SEVERAL SIMPLE SEARCH AND REPLACES
# FOLLOWED BY AN UGLY SECTION WHICH DEALS WITH VERT. AND HORIZ.
# CONCATINATION

sub transproc{
    #purge extraneous spaces
    $thiscode=@_[0];
    #if ($thiscode =~ /\n/){ $cretdum=1; } # carriage return dummy
    #else{$cretdum=0;};
    $origcode=$thiscode;
    #if ($thiscode =~ /^\s/==1){
    # $initspace=$thiscode;
    # $initspace =~ s/(^\s*)(\S*)/\1/g;}
    #else{
    # $initspace="";
    # }
    $thiscode =~ s/(^\s*)(\S*)/\2/g;
    while ($thiscode =~/\W\s/){
         $thiscode =~ s/(\W)(\s)/\1/;
         }
    while ($thiscode =~/\s\W/){
         $thiscode =~ s/\s(\W)/\1/;
         }
    #$initspace =~ s/\n//g;
    #$initspace =~ s/\S*//g;
    # convert code fragments not in quotes to lower case
    $cpos=0;  $qdum=0;
    $newthis="";
    while ($cpos <= length($thiscode)){
      if (substr($thiscode,$cpos,1) eq "\""){
         if ($qdum==0){
             $qdum=1;}  # turn quote dummy on
         else{ $qdum=0; } # turn quote dummy off 
         $newthis=$newthis.(substr($thiscode,$cpos,1));
      }
      else{
       if ($qdum==0){
          $newchar=substr($thiscode,$cpos,1);
          $newchar =~ tr/A-Z/a-z/;
          $newthis=$newthis.$newchar;}
       else{$newthis=$newthis.(substr($thiscode,$cpos,1))};
       }
      $cpos=$cpos+1;
    }
    $thiscode=$newthis;
    # change globals beginning in _ to upper case words with
    # _ dropped
    while ($thiscode =~ /(.*)(\_)(\w*)(.*)/){
       $initstr=$1;
       $thisword=$3;
       $reststr=$4.$5;
       $thisword =~ tr/a-z/A-Z/;
       $thiscode= $initstr.$thisword.$reststr;
       }
    #if ($cretdum==1){$thiscode = $thiscode."\n";}
    #nuke local declarations with and without carriage returns
    $thiscode =~ s/local .*;\n//ig;
    $thiscode =~ s/local .*;//ig;
    # search for any include (global declaration) files
    if (/\#include/){
        $thiscode="% include directive skipped";
        }
    if ($fni>0)
     {
     $i=0;
     while ($i <= $fni-1){
      $thiscode =~s/($fnamestr[$i])\(/feval\(\1\,/;
      $i=$i+1;
      }
    }
    # change function names passed to functions to strings
    if ($thiscode =~ /\w\(.*\&\w*\W?/){
       $thiscode =~ s/(\w\(.*)(\&)(\w*)(\W?)/\1\'\3\'\4/;
     }
    if ($thiscode =~ /\w\(\&\w*\W/){
        $thiscode =~ s/(\w\()(\&)(\w*)(\W?)/\1\'\3\'\4/;
     }
    $thiscode =~ s/\[\.\,/\[\:\,/ig;
    $thiscode =~ s/\,\.\]/\,\:\]/ig;
    # change square brackets to round for matrix indexing
    # do this before {'s changed to ]
    $thiscode =~ s/\[/\(/g;
    $thiscode =~ s/\]/\)/g;
    #change notation for matrix assignments
    $thiscode =~ s/\{(.*)\}\s?\=/\[\1\]\=/;
    if ($thiscode =~ /\=\s?\{(.*)\}/){
       $lbind=index($thiscode,"{");
       $rbind=index($thiscode,"}");
       $argum=substr($thiscode,$lbind+1,$rbind-$lbind);
       $argum =~ s/\,/\;/;
       $thiscode=substr($thiscode,0,$lbind)."[".$argum."]".
                 substr($thiscode,$rbind+1);
       }
    #simple search and replacements
    # FEEL FREE TO ADD YOUR OWN REPLACEMENTS IN THIS SECTION
    #replace open fh=fname for append; with fh=openfa('fname')
    $thiscode =~ s/(open)\s(\w*)\s?(\=)(\^)(.*)\sfor\sappend\s?(\;)/\2\=openfa\(\5\)\;/;
    $thiscode =~ s/(open)\s(\w*)\s?(\=)(.*)\sfor\sappend\s?(\;)/\2\=openfa\(\'\4\'\)\;/;
    #replace open fh=fname; with fh=open('fname')
    # note the Gauss file handling m-files must be used for these
    # translations to be valid
    $thiscode =~ s/(open)\s(.*)\s?(\=)(\^)(.*)\s?(\;)/\2\=open\(\5\)\;/;
    $thiscode =~ s/(open)\s(.*)\s?(\=)\s?(.*)\s?(\;)/\2\=open\(\'\4\'\)\;/;
    $thiscode =~ s/(create)\s(.*)\s?(\=)\s?(\^)(.*)\s(with)\s*(.*)\,(.*)\,(.*)\s?\;/\2\=\1\(\5\,\8,\9\,\7\)\;/;
    $thiscode =~ s/(create)\s(.*)\s?(\=)\s?(.*)\s(with)\s*(.*)\,(.*)\,(.*)\s?\;/\2\=\1\(\4\,\7\,\8\,\6\)\;/;
    $thiscode =~ s/print/disp /; # nuke any and all print statements
    $thiscode =~ s/disable\;//;
    $thiscode =~ s/enable\;//;
    $thiscode =~ s/disable\s*\;//;
    $thiscode =~ s/enable\s*\;//;
    $thiscode =~ s/cls\s*\;//;
    $thiscode =~ s/cls\;//;
    $thiscode =~ s/new\s*\;//;
    $thiscode =~ s/new\;//;
    $thiscode =~ s/library.*\;//;
    $thiscode =~ s/ln\(/log\(/ig;
    #use custom m-files for these as matlab returns row not column vectors
    #$thiscode =~ s/sumc/sum/ig;
    #$thiscode =~ s/prodc/prod/ig;
    $thiscode =~ s/iscplx\((.*)\)/\(isreal\(\1\)\-1\)/;
    $thiscode =~ s/errorlog\s?(".*\")/error\(\1\)/;
    #$thiscode =~ s/meanc/mean/ig;
    $thiscode =~ s/dos\s?\^(\w*)\;/dos\(\1\)\;/ig;
    $thiscode =~ s/dos\s?\"(.*)\"\;/dos \(\'\1\'\)\;/ig;
    # use custom m-file for seqa, or code manually
    # too many poss's to consider
    # $thiscode =~ s/seqa\((.*)\,(.*)\,(.*)\)/\(\1\:\2:\3\)/ig;
    #$thiscode =~ s/cumsumc/cumsum/ig;
    #$thiscode =~ s/cumprodc/cumprod/ig;
    $thiscode =~ s/stop\;/dbstop\;/ig;
    $thiscode =~ s/stdc/std/ig;
    $thiscode =~ s/minc/min/ig;
    $thiscode =~ s/maxc/max/ig;
    $thiscode =~ s/sortc/sortrows/ig;
    $thiscode =~ s/rndu/rand/ig;
    $thiscode =~ s/eigv/eig/ig;
    $thiscode =~ s/maxc/max/ig;
    $thiscode =~ s/title\(\"(.*)\"\)/title\(\'\1\')/ig;
    $thiscode =~ s/xlabel\(\"(.*)\"\)/xtitle\(\'\1\')/ig;
    $thiscode =~ s/ylabel\(\"(.*)\"\)/ytitle\(\'\1\')/ig;
    $thiscode =~ s/zlabel\(\"(.*)\"\)/ztitle\(\'\1\')/ig;
    $thiscode =~ s/title\((.*)\)/title\(\1\)/ig;
    $thiscode =~ s/xlabel\((.*)\)/xtitle\(\1\)/ig;
    $thiscode =~ s/ylabel\((.*)\)/ytitle\(\1\)/ig;
    $thiscode =~ s/zlabel\((.*)\)/ztitle\(\1\)/ig;
    $thiscode =~ s/(\s*)(xy)(\(.*)/plot\3/ig;
    $thiscode =~ s/(\s*)(xyz)(\(.*)/plot3\3/ig;
    $thiscode =~ s/^(xy)(\(.*)/plot\2/ig;
    $thiscode =~ s/^(xyz)(\(.*)/plot3\2/ig;
    $thiscode =~ s/(surface)(\(.*)/surf\2/ig;
    $thiscode =~ s/zlabel\((.*)\)/ztitle\(\1\)/ig;
    $thiscode =~ s/endif/end/ig;
    $thiscode =~ s/endo/end/ig;
    $thiscode =~ s/do while/while/ig;
    $thiscode =~ s/\.</</ig;
    $thiscode =~ s/\.>/>/ig;
    $thiscode =~ s/\.\=\=/\=\=/ig;
    $thiscode =~ s/(\.le)(\W)/\<\=\2/ig;
    $thiscode =~ s/(\.ge)(\W)/\>\=\2/ig;
    $thiscode =~ s/(\W)(le)(\W)/\1\<\=\3/ig;
    $thiscode =~ s/(\W)(ge)(\W)/\1\>\=\3/ig;
    ###################################################
    # THIS SECTION TAKES CARE OF $+ ###################
    # replace (expr1)$+(expr2) with strcat(expr1,expr2)
    while (index($thiscode,"\$\+") != -1)
    {
        $catind=index($thiscode,"\$\+");
        $lbpos=$catind-1; #
        if (substr($thiscode,$lbpos,1) eq ")")
        {
           $nrb=1; $nlb=0;
           $lbpos=$lbpos-1;
           $cont=1;
           while ($nlb != $nrb)
           {
             if (substr($thiscode,$lbpos,1) eq ")"){
                $nrb=$nrb+1;
                $lbpos=$lbpos-1;}
             elsif (substr($thiscode,$lbpos,1) eq "("){
                $nlb=$nlb+1;
                $lbpos=$lbpos-1;}
             else{
                $lbpos=$lbpos-1;}
             if ($lbpos<0){
                print "bracket error the following line was not translated:\n";
                print $_;
                $nlb=$nrb;}
           }# ends while nlb != nrb
           $lexpr=substr($thiscode,$lbpos+1,$catind-$lbpos-1);
           $newcode=substr($thiscode,0,$lbpos+1)."strcat\(".$lexpr.",";
           if (substr($thiscode,$lbpos-5,6) eq "strcat")
              {$lexpr="strca".$lexpr;
               $lbpos=$lbpos-5;}
         } #ends ) encountered
         elsif (substr($thiscode,$lbpos,1) eq "\"")
         {
            $lbpos=$lbpos-1;
            while (substr($thiscode,$lbpos,1) ne "\""){
               $lbpos=$lbpos-1;}
            $lexpr=substr($thiscode,$lbpos,$catind-$lbpos);
            $newcode=substr($thiscode,0,$lbpos)."strcat\(".$lexpr.",";
          } #check this
         elsif (substr($thiscode,$lbpos,1) =~ /\w/)
         {
            while (substr($thiscode,$lbpos,1) =~ /\w/){
               $lbpos=$lbpos-1;}
            $lexpr=substr($thiscode,$lbpos+1,$catind-$lbpos-1);
            $newcode=substr($thiscode,0,$lbpos+1)."strcat\(".$lexpr.",";
         } #check this
         else
         {    print "could not translate code around \$\+\n";
              print "associated with this line:\n";
              print $_;
          }
        $rbpos=$catind+2; 
        if (substr($thiscode,$rbpos,1) eq "(")
        {
           $nlb=1; $nrb=0;
           $rbpos=$rbpos+1;
           $cont=1;
           while ($nlb != $nrb)
           {
             if (substr($thiscode,$rbpos,1) eq ")"){
                $nrb=$nrb+1;
                $rbpos=$rbpos+1;}
             elsif (substr($thiscode,$rbpos,1) eq "("){
                $nlb=$nlb+1;
                $rbpos=$rbpos+1;}
             else{
                $rbpos=$rbpos+1;}
             if ($rbpos>200){
                print "bracket error the following line was not translated:\n";
                print $_;
                $nlb=$nrb;}
            } # ends while nlb != nrb
            $rexpr=substr($thiscode,$catind+2,$rbpos-$catind-2);
            $thiscode=$newcode.$rexpr."\)".substr($thiscode,$rbpos);
         } #check this
         elsif (substr($thiscode,$rbpos,1) eq "\"")
         {
            $rbpos=$rbpos+1;
            while (substr($thiscode,$rbpos,1) ne "\""){
               $rbpos=$rbpos+1;}
            $rexpr=substr($thiscode,$catind+2,$rbpos-$catind-1); #check this
            $thiscode=$newcode.$rexpr."\)".substr($thiscode,$rbpos+1);

         }
         elsif (substr($thiscode,$rbpos,1) =~ /\w/)
         {
            while (substr($thiscode,$rbpos,1) =~ /\w/){
               $rbpos=$rbpos+1;}
            $rexpr=substr($thiscode,$catind+2,$rbpos-$catind-2); #check this
            $thiscode=$newcode.$rexpr."\)".substr($thiscode,$rbpos);
         }
         else{print "could not translate code around \$\+\n";
              print "associated with this line:\n";
              print $_;}

         #$thiscode=substr($thiscode,0,$lbpos)."strcat(".$lexpr.",".$rexpr.")".substr($thiscode,$rbpos+1);
       } # ends search for more $+ 's


    ###################################################
    # THIS SECTION TAKES CARE OF $== ###################
    # replace (expr1)$==(expr2) with strmatch(expr1,expr2)
    $thiscode =~ s/\.\$\=\=/\$\=\=/g; # treat .$== and $== the same
    while (index($thiscode,"\$\=\=") != -1)
    {
        $catind=index($thiscode,"\$\=\=");
        $lbpos=$catind-1; #
        if (substr($thiscode,$lbpos,1) eq ")")
        {
           $nrb=1; $nlb=0;
           $lbpos=$lbpos-1;
           $cont=1;
           while ($nlb != $nrb)
           {
             if (substr($thiscode,$lbpos,1) eq ")"){
                $nrb=$nrb+1;
                $lbpos=$lbpos-1;}
             elsif (substr($thiscode,$lbpos,1) eq "("){
                $nlb=$nlb+1;
                $lbpos=$lbpos-1;}
             else{
                $lbpos=$lbpos-1;}
             if ($lbpos<0){
                print "bracket error the following line was not translated:\n";
                print $_;
                $nlb=$nrb;}
           }# ends while nlb != nrb
           $lexpr=substr($thiscode,$lbpos+1,$catind-$lbpos-1);
           $newcode=substr($thiscode,0,$lbpos+1)."strmatch\(".$lexpr.",";
           $lbpos=$lbpos+1;
           #if (substr($thiscode,$lbpos-5,6) eq "strcat")
           #   {$lexpr="strca".$lexpr;
           #    $lbpos=$lbpos-5;
           #}
         } #ends ) encountered
         elsif (substr($thiscode,$lbpos,1) eq "\"")
         {
            $lbpos=$lbpos-1;
            while (substr($thiscode,$lbpos,1) ne "\""){
               $lbpos=$lbpos-1;}
            $lexpr=substr($thiscode,$lbpos,$catind-$lbpos);
           $newcode=substr($thiscode,0,$lbpos)."strmatch\(".$lexpr.",";
         } #check this
         elsif (substr($thiscode,$lbpos,1) =~ /\w/)
         {
            while (substr($thiscode,$lbpos,1) =~ /\w/){
               $lbpos=$lbpos-1;}
            $lexpr=substr($thiscode,$lbpos+1,$catind-$lbpos-1);
            $newcode=substr($thiscode,0,$lbpos+1)."strmatch\(".$lexpr.",";
         } #check this
         else
         {    print "could not translate code around \$\+\n";
              print "associated with this line:\n";
              print $_;
          }
        $rbpos=$catind+3; 
        if (substr($thiscode,$rbpos,1) eq "(")
        {
           $nlb=1; $nrb=0;
           $rbpos=$rbpos+1;
           $cont=1;
           while ($nlb != $nrb)
           {
             if (substr($thiscode,$rbpos,1) eq ")"){
                $nrb=$nrb+1;
                $rbpos=$rbpos+1;}
             elsif (substr($thiscode,$rbpos,1) eq "("){
                $nlb=$nlb+1;
                $rbpos=$rbpos+1;}
             else{
                $rbpos=$rbpos+1;}
             if ($rbpos>200){
                print "bracket error the following line was not translated:\n";
                print $_;
                $nlb=$nrb;}
            } # ends while nlb != nrb
            $rexpr=substr($thiscode,$catind+3,$rbpos-$catind-3);
            $thiscode=$newcode.$rexpr."\)".substr($thiscode,$rbpos);
         } #check this
         elsif (substr($thiscode,$rbpos,1) eq "\"")
         {
            $rbpos=$rbpos+1;
            while (substr($thiscode,$rbpos,1) ne "\""){
               $rbpos=$rbpos+1;}
            $rexpr=substr($thiscode,$catind+3,$rbpos-$catind-2); #check this
            $thiscode=$newcode.$rexpr."\)".substr($thiscode,$rbpos+1);
         }
         elsif (substr($thiscode,$rbpos,1) =~ /\w/)
         {
            while (substr($thiscode,$rbpos,1) =~ /\w/){
               $rbpos=$rbpos+1;}
               $rexpr=substr($thiscode,$catind+3,$rbpos-$catind-3); #check this
               $thiscode=$newcode.$rexpr."\)".substr($thiscode,$rbpos);
         }
         else{print "could not translate code around \$\+\n";
              print "associated with this line:\n";
              print $_;}

         #$thiscode=substr($thiscode,0,$lbpos)."strmatch\(".$lexpr.",".$rexpr."\)".substr($thiscode,$rbpos+1);
       } # ends search for more $== 's



    ###################################################
    # THIS SECTION TAKES CARE OF "string"|"string" ####
    # replace "expr1"|"expr2" with strvcat("expr1","expr2")
    while (index($thiscode,"\"\|\"") != -1)
    {
        $catind=index($thiscode,"\"\|\"");
        $lbpos=$catind-1; #
         while (substr($thiscode,$lbpos,1) ne "\""){
            $lbpos=$lbpos-1;}
         $lexpr=substr($thiscode,$lbpos,$catind-$lbpos+1);
         $rbpos=$catind+3; 
            while (substr($thiscode,$rbpos,1) ne "\""){
               $rbpos=$rbpos+1;}
            $rexpr=substr($thiscode,$catind+2,$rbpos-$catind-1); #check this
         $thiscode=substr($thiscode,0,$lbpos)."strvcat(".$lexpr.",".$rexpr.")".substr($thiscode,$rbpos+1);
       } # ends search for more "|"


#### CONCATINATION SECTION
# find the index of any |'s if they exist
$vercdone=0; # dummy for being done with vert. concat's
$pos=index($thiscode,"|");
while ($pos != -1){ # if |'s exist continue
   $lbpos=$pos-1; # initialize left [ bracket to fall to left of |
   # if position to immed. left of | is a ) or ")'" start counting L&R )'s
   if ( (substr($thiscode,$lbpos,1) eq ")") ||
        (substr($thiscode,$lbpos-1,2) eq ")'")){
        if (substr($thiscode,$lbpos,1) eq ")"){
           $nrb=1;
           $lbpos=$lbpos-1;}
        elsif (substr($thiscode,$lbpos,1) eq "'"  &&
               substr($thiscode,$lbpos-1,1) eq ")"){
           $nrb=1;
           $lbpos=$lbpos-2;
           }
        else{$lbpos=$lbpos-1;}
        $nlb=0;
        while ($nrb>$nlb){
           if (substr($thiscode,$lbpos,1) eq ")"){
              $nrb=$nrb+1; }
           if (substr($thiscode,$lbpos,1) eq "("){
              $nlb=$nlb+1; }
           $lbpos=$lbpos-1;
           if ($lbpos<0){
              print "Bracket error in original code, could not translate\n";
              print "the following code:".$origcode."\n";
              print $_; $nlb=$nrb;}              
         } # ends while for nrb>nlb
    } # ends if on ) and )' to left of first |
    # once [ position pushed beyond last bracket match start looking for
    # first non-word to the left eg want: [sin(..)| or [-(..)| or
    # [-x|..  or [-sin(x)|... 
    $cont=1;
    while ($cont==1){
         if (substr($thiscode,$lbpos,1) =~/\W/ &&
            substr($thiscode,$lbpos,1) ne "-"
            && substr($thiscode,$lbpos,1) ne "."){
             if (($lbpos==$pos-1) && (substr($thiscode,$lbpos,1) eq "'"))
                   {$lbpos=$lbpos-1;}
             else  {$cont=0;}
             #$cont=0;
         }
         elsif (substr($thiscode,$lbpos,1) eq "-")
              {$cont=0; $lbpos=$lbpos-1;}
         else
              {$lbpos=$lbpos-1;}
         if ($lbpos<0){
            print "Bracket error in original code, could not translate\n";
            print "the following code:".$origcode."\n";
            print $_;$cont=0;}              
    } #ends while statement on $cont==1
  # insert left bracket at appropriate position, truncate "newstring" to
  # first |
  # create reststring which consists of what follows
    if (substr($thiscode,$lbpos,1) eq "("){
       #start counting brackets and drop ] immediately before match
       $newstring=substr($thiscode,0,$lbpos+1)."[";
       $reststring=substr($thiscode,$lbpos+1);
       $nlb=1; $nrb=0;
       $cont=1;
       while ($cont==1){
          if (substr($reststring,0,1) eq ")"){$nrb=$nrb+1;}
          if (substr($reststring,0,1) eq "("){$nlb=$nlb+1;}
          if (substr($reststring,0,1) eq "|"){
             $newstring=$newstring.";";
             $reststring=substr($reststring,1);}
          else{
             $newstring=$newstring.substr($reststring,0,1);
             $reststring=substr($reststring,1);}
          if ($nlb==$nrb){
            $thiscode=substr($newstring,0,length($newstring)-1)
             ."]".substr($newstring,length($newstring)-1,1).$reststring;
                $cont=0;
            $vercdone=1;  }
        } #ends while for cont==1
    }  # ends initial check for ) left of |
    else{
    $newstring=substr($thiscode,0,$lbpos+1)."[".substr($thiscode,$lbpos+1,$pos-$lbpos-1).";";
    $reststring=substr($thiscode,$pos+1);
         }  # ends else on initial check for ) left of |
    $cont=1;
    $rbpos=0;
    while ($cont==1)
    {
    # check to see if any more |'s exist before next ~ or terminating ;
    $pos=index($reststring,"|");
    # if not, & vercdone=0 initialize right bracket position for ]
    # to immed. right last |
    if ($pos==-1){$cont=0;}
    else{
       # if more |'s exist, check to see if ~ exist
       if ( (index($reststring,"~")<index($reststring,"|"))
        && index($reststring,"~") != -1)
        {$cont=0;}
       else{
       # if not keep adding chunks to "newstring"
       $newstring=$newstring.substr($reststring,0,$pos).";";
       $reststring=substr($reststring,$pos+1);}
     } #ends else statement
     } #ends while statement
   $rbpos=0;
   $nrb=0; $nlb=0;
   # ] position is currently to immediate right of last | unless vercdone=1
   # check to see if this position is a left bracket
   if ($vercdone==0){
    if (substr($reststring,$rbpos,1) eq "("){
      # if it is, count brackets and push ] position to right
      $nrb=0; $nlb=1; $rbpos=$rbpos+1;
      while ($nlb>$nrb){
         if (substr($reststring,$rbpos,1) eq ")"){
            $nrb=$nrb+1; 
            }
         if (substr($reststring,$rbpos,1) eq "("){
            $nlb=$nlb+1; 
            }
         $rbpos=$rbpos+1;

         if ($rbpos>200){
              print "Bracket error in original code, could not translate\n";
              print "the following code:".$origcode."\n";
              print $_; $nlb=$nrb;}              
       }  # ends while nlb>nrb
       if (substr($reststring,$rbpos,1) eq "'"){
         $rbpos=$rbpos+1;}
     }
    
     $cont=1;
     while ($cont==1){
            # if non-word hit piece everything together
         if (substr($reststring,$rbpos,1) =~ /\(/){
             $rbpos=$rbpos+1;
             $nlb=$nlb+1;}
         if (substr($reststring,$rbpos,1) =~ /\)/){
             if ($nlb>0){
                $rbpos=$rbpos+1;
                $nrb=$nrb+1;}
             else{
                $cont=0;
                 $thiscode=$newstring.substr($reststring,0,$rbpos).
                "]".substr($reststring,$rbpos);}
             } 
         if (substr($reststring,$rbpos,1) =~/\W/  &&
             substr($reststring,$rbpos,1) ne "."){
               if ($nlb==$nrb){
                 $cont=0;
                 if (substr($reststring,$rbpos,1) eq "'"){
                    $rbpos=$rbpos+1;}
                 $thiscode=$newstring.substr($reststring,0,$rbpos).
                "]".substr($reststring,$rbpos);
                }
               else{$rbpos=$rbpos+1;}
             }
            # else keep sliding right
         else{
            $rbpos=$rbpos+1;}
         if ($rbpos>200){
              print "Bracket error in original code, could not translate\n";
              print "the following code:".$origcode."\n";
              print $_; 
              $cont=0; $thiscode="";}              
     } # this ends while cont=1 (bracket searching branch)
    } #this ends if vercdone=1
    $pos=index($thiscode,"|"); # check for more | left off by ~
} #this ends vert. concat section

##################################################
# now do horizontal concatination
# may have to count square brackets as well
# find the index of any ~'s if they exist
$horcdone=0;
$pos=index($thiscode,"~");
while ($pos != -1) # if ~'s exist continue
{
     $lbpos=$pos-1; # initialize left [ bracket to fall to left of ~
     # if position to immed. left of ~ is a ) start counting L&R )'s
   if ( (substr($thiscode,$lbpos,1) eq ")") ||
        (substr($thiscode,$lbpos-1,2) eq ")'")){
        if (substr($thiscode,$lbpos,1) eq ")"){
           $nrb=1;
           $lbpos=$lbpos-1;}
        elsif (substr($thiscode,$lbpos,1) eq "'"  &&
               substr($thiscode,$lbpos-1,1) eq ")"){
           $nrb=1;
           $lbpos=$lbpos-2;
           }
         else{$lbpos=$lbpos-1;}
         $nlb=0;
       while ($nrb>$nlb){
         if (substr($thiscode,$lbpos,1) eq ")"){
            $nrb=$nrb+1; }
         if (substr($thiscode,$lbpos,1) eq "("){
            $nlb=$nlb+1; }
         $lbpos=$lbpos-1;
         if ($lbpos<0){
              print "Bracket error in original code, could not translate\n";
              print "the following code:".$origcode."\n";
              print $_; $nlb=$nrb;}              

       } # ends while
    }  # ends if ) to left of ~
     # once [ position pushed beyond last bracket match start looking for
     # first non-word to the left
   $cont=1;
   while ($cont==1){
       if ((substr($thiscode,$lbpos,1) =~/\W/) &&
           (substr($thiscode,$lbpos,1) ne "-") &&
           (substr($thiscode,$lbpos,1) ne ".")){
           if ($lbpos==$pos-1 && substr($thiscode,$lbpos,1) eq "'")
                 {$lbpos=$lbpos-1;}
           else  {$cont=0;}
       }
       elsif (substr($thiscode,$lbpos,1) eq "-"){$cont=0;
                                                 $lbpos=$lbpos-1;}
       else{
            $lbpos=$lbpos-1;}
       if ($lbpos<0){
           print "Bracket error in original code, could not translate\n";
           print "the following code:".$origcode."\n";