/*               Write Matrix to LaTeX (Isaac,May95)
**
**   wrilatex is a keyword written by Alan G. Isaac
**   for public non-commercial use. Some of the code
**   derives from Mellows' wriasc keyword.
**   There are no performance guarantees for this code.
**   Last update: 05/20/1995
**
**   Alan G. Isaac
**   Mail:         Department of Economics
**                 The American University
**                 Washington, DC 20016
**                 USA
**   Internet:     aisaac@american.edu
**
**
**    Documentation
**    -------------
**
**    Keyword: wrilatex
**
**    Purpose: Writes a GAUSS matrix or string array to a LaTeX table.
**
**    Format: wrilatex x c:\example.tex [dcolumn]
**
**    Input: x, (nxm)-matrix, the matrix to be written to a LaTeX input file.
**           example.tex, name of the (new!) LaTex file to which x will be
**                          written.
**           dcolumn, optional parameter specifying the availability
**                    of the dcolumn package for decimal point
**                    centered columns
**     Remarks: If example.tex exists already, it will be overwritten.
**              It is up to the user to edit the resulting
**               file for conformity to LaTeX.
**              Do not double any backslashes in the file name.
**              To print a character matrix, called say charmat,
**               first convert it to the string array ""$+charmat.
*/

keyword wrilatex(str);
  local mat,f,answer,opt,errmsg,oldwidth,typ,myct,oldstate,oldout,newmat,
        amper,bckslsh2,mask,oldcvfmt,oldnvfmt,success,oldscr,r,c;

  {mat,f} = token(str);
  {f,opt} = token(f);
  typ = typecv(mat);
  if typ /= 6 and typ /= 15;
    goto errout("There is no GAUSS matrix or string array called "$+mat$+".");
  endif;
  mat = varget(mat);
  r=rows(mat); c = cols(mat);


  answer="Y";
  if cols(files(f,0))==2;
    answer="";
    do until answer$=="Y" or answer$=="N";
      printdos "File `"$+f$+"' already exists; overwrite? (y/n)";
      answer=upper(cons);
      "";
    endo;
  endif;
  if answer$=="Y";
   { oldstate,oldout } = sysstate(18,1);
    output file = ^f reset;
  else;
    goto errout("User abort; do not overwrite existing file.");
  endif;

 oldwidth = sysstate(11,256);
 oldscr = sysstate(15,0);

 print "% CAREFUL! This is a self-contained LaTeX document.";
 print "% EDIT appropriately if inserting in another document.";
 if upper(opt) $== "DCOLUMN";
   print "\\documentstyle[dcolumn]{article}";
   print "\\newcolumntype{.}{D{.}{.}{5}}"; @can change number of decimal places
here@
   print "\\begin{document}";
   print "\\begin{tabular}{|"$+chrs(ones(1,c)*46)$+"|}";
 else;
   print "\\documentstyle{article}";
   print "\\begin{document}";
   print "\\begin{tabular}{|"$+chrs(ones(1,c)*99)$+"|}";
 endif;
 print "\\hline";;

 newmat = mat[.,1];
 amper = ones(r,1)*chrs(38);
 bckslsh2 = ones(r,1)*"\\\\";
 myct = 1;
 do while myct < c;
   if typ == 15;
     newmat = newmat $~(""$+amper) $~mat[.,myct+1];
   else;
     newmat = newmat ~amper ~mat[.,myct+1];
   endif;
   myct = myct+1;
 endo;

 if typ == 15;
   newmat = newmat $~(""$+bckslsh2);
   format /sa /rds 1,-1;
   print /sa newmat;
 else;
   print;
   newmat = newmat ~bckslsh2;
   mask = vecr(ones(c,1)~zeros(c,1))';

   oldcvfmt = formatcv("*.*s"~1~2);
   oldnvfmt = formatnv("*.*lf"~8~4);
   if not printfmt(newmat,mask);
     oldcvfmt = formatcv(oldcvfmt);
     oldnvfmt = formatnv(oldnvfmt);
     gosub oldsys;
     goto errout("Print fails; may be out of disk space.");
   endif;
   oldcvfmt = formatcv(oldcvfmt);
   oldnvfmt = formatnv(oldnvfmt);
 endif;
 print "\\hline";
 print "\\end{tabular}";
 print "\\end{document}";


 gosub oldsys;
retp;

  oldsys:
    outwidth oldwidth;
    output file = ^oldout;
    if oldstate; output on; else; output off; endif;
    if oldscr; screen on; endif;
  return;

  errout:
    pop errmsg;
    print "\g";
    errorlog "Error: "$+errmsg;
endp;