##
## This is file `putfile.',
## generated with the docstrip utility.
##
## The original source files were:
##
## coordsys.dtx  (with options: `putfile')
## 
## 
##  This is the coordsys and logsys packages
##  Copyright 2000-04 by Mogens Lemvig Hansen,
##                       mlhansen@uniserve.com
## 
## This program may be distributed and/or modified under the
## conditions of the LaTeX Project Public License, either version 1.3
## of this license or (at your option) any later version. The latest
## version of this license is in
##   http://www.latex-project.org/lppl.txt
## and version 1.2 or later is part of all distributions of LaTeX
## version 2003/12/01 or later.
## 
## This program consists of the files coordsys.dtx and coordsys.ins
## 
putfile := proc(fn::{string, list(string), set(string)},
                 P::specfunc(anything, PLOT) )
   option `Copyright 2000-04 by Mogens Lemvig Hansen`;
   description "version 1.0";
   local L, fns, i, V, scl, FH, ttl, pt, path, ext;
   global StringTools;
   L := [args[3..-1]];
   if hasoption(L, 'scale', scl, 'L') then
      scl := evalf(scl);
      if not type(scl, ['numeric', 'numeric']) then
         error "the scale option must be [numeric, numeric] but got %1",
               scl;
      fi;
   else
      scl := [1,1];
   fi;
   if L <> [] then
      error "unknown options: %1", L;
   fi;
   L := map( `putfile/grabcurves`, [op(P)] );
   if type(fn, 'string') then
      path := map(StringTools:-FirstFromRight, ["\\", "/", ":"], fn);
      path := max(op(path));
      ext := StringTools:-FirstFromRight(".", fn[path+1..-1]);
      if ext = 0 then
         ext := ".tex";
         fns := fn;
      else
         ext := fn[path+ext..-1];
         fns := fn[1..-length(ext)-1]
      fi;
      if nops(L) = 1 then
         fns := [fns];
      else
         fns := [ seq(cat(fns, i), i=1..nops(L)) ];
      fi;
      fns := map(cat, fns, ext);
   else
      fns := fn;
      if nops(fns) <> nops(L) then
         error "the number of filenames must match "
               "the number of curves, "
               "received %1 names but %2 curves.",
               nops(fns), nops(L);
      fi;
   fi;
   V := select(type, [op(P)], 'specfunc'('anything', 'VIEW'));
   if nops(V) <> 1 then
      V := ['DEFAULT', 'DEFAULT'];
   else
      V := [ op([1,1], V), op([1,2], V) ];
   fi;
   V := subs('DEFAULT'=Float(-infinity)..Float(infinity), V);
   ttl := select(type, [op(P)], 'specfunc'('anything', 'TITLE'));
   if nops(ttl) = 1 then
      ttl := op([1,1], ttl);
      ttl := StringTools:-SubstituteAll(ttl, "\n", "\n%%  ");
   fi;
   L := map( `putfile/cleancurve`, L, V);
   L := map2( map, u->[scl[1]*u[1], scl[2]*u[2]], L );
   for i from 1 to nops(L) do try
      FH := fopen(fns[i], 'WRITE', 'TEXT');
      if type(ttl, 'string') then fprintf(FH, "%%%%  %s\n", ttl) fi;
      if scl <> [1,1] then fprintf(FH, "%% scaled %a\n", scl) fi;
      V := [ map2(op, 1, L[i]), map2(op, 2, L[i]) ];
      V := map( u-> min(op(u))..max(op(u)), V );
      fprintf(FH, "%% horizontal range: %f..%f\n", op(V[1]));
      fprintf(FH, "%% vertical range:   %f..%f\n", op(V[2]));
      for pt in L[i] do
         fprintf(FH, "%f \t%f\n", op(pt));
      od;
      finally fclose(FH);
   end try end do;
end;
`putfile/grabcurves` := proc(x)
   option `Copyright 2000-04 by Mogens Lemvig Hansen`;
   description "version 1.0";
   local L;
   if op(0, x) = 'CURVES' then
      L := [ op(x) ];
      L := select(type, L, 'list');
      RETURN(op(L));
   else
      RETURN(NULL);
   fi;
end;
`putfile/cleancurve` := proc(CC::list, V::list)
   local C, B, pts, pt, m, i;
   option `Copyright 2004 by Mogens Lemvig Hansen`;
   description "version 1.0";
   C := select(type, CC, ['numeric', 'numeric']);
   if nops(C) < 1 then error "no numeric points in %1", C fi;
   B := C[1];
   for i from 2 to nops(C) do
      if C[i] = C[i-1] then next fi;
      pts := NULL;
      if ( C[i-1][1] < lhs(V[1]) and C[i][1] > lhs(V[1]) )
      or ( C[i-1][1] > lhs(V[1]) and C[i][1] < lhs(V[1]) ) then
         m := ( C[i-1][2] - C[i][2] ) / ( C[i-1][1] - C[i][1] );
         pt := lhs(V[1]);
         pt := [ pt, m*(pt-C[i][1]) + C[i][2] ];
         pts := pts, pt;
      fi;
      if ( C[i-1][1] < rhs(V[1]) and C[i][1] > rhs(V[1]) )
      or ( C[i-1][1] > rhs(V[1]) and C[i][1] < rhs(V[1]) ) then
         m := ( C[i-1][2] - C[i][2] ) / ( C[i-1][1] - C[i][1] );
         pt := rhs(V[1]);
         pt := [ pt, m*(pt-C[i][1]) + C[i][2] ];
         pts := pts, pt;
      fi;
      if ( C[i-1][2] < lhs(V[2]) and C[i][2] > lhs(V[2]) )
      or ( C[i-1][2] > lhs(V[2]) and C[i][2] < lhs(V[2]) ) then
         m := ( C[i-1][1] - C[i][1] ) / ( C[i-1][2] - C[i][2] );
         pt := lhs(V[2]);
         pt := [ m*(pt-C[i][2]) + C[i][1], pt ];
         pts := pts, pt;
      fi;
      if ( C[i-1][2] < rhs(V[2]) and C[i][2] > rhs(V[2]) )
      or ( C[i-1][2] > rhs(V[2]) and C[i][2] < rhs(V[2]) ) then
         m := ( C[i-1][1] - C[i][1] ) / ( C[i-1][2] - C[i][2] );
         pt := rhs(V[2]);
         pt := [ m*(pt-C[i][2]) + C[i][1], pt ];
         pts := pts, pt;
      fi;
      pts := [pts];
      if C[i-1][1] < C[i][1] then
         pts := sort(pts, (u,v)->evab(u[1]<v[1]));
      elif C[i-1][1] > C[i][1] then
         pts := sort(pts, (u,v)->evab(u[1]>v[1]));
      elif C[i-1][2] < C[i][2] then
         pts := sort(pts, (u,v)->evab(u[2]<v[2]));
      elif C[i-1][2] > C[i][2] then
         pts := sort(pts, (u,v)->evab(u[2]>v[2]));
      else
         error "cannot happen";
      fi;
      B := B, op(pts), C[i];
   od;
   C := [B];
   C := select( u->evalb(lhs(V[1])<=u[1] and u[1] <= rhs(V[1])), C);
   C := select( u->evalb(lhs(V[2])<=u[2] and u[2] <= rhs(V[2])), C);
   C;
end;