# ----> filledcontourplot := proc(FF,r1,r2) 
# 
# Computes the implicit curves at the heights specified by h of the 
# functions specified in FF over the ranges specified by r1 and r2. 
#

macro( `plot3d/surface`   = readlib('`plot3d/surface`'),
       `plot3d/cylinder`  = readlib('`plot3d/cylinder`'),
       `plot3d/makefunc`  = readlib('`plot3d/makefunc`'),
       `plot/options2d`   = readlib('`plot/options2d`'),
       `plot/color`       = readlib('`plot/color`'));

filledcontourplot := proc(FF,r1,r2) 
    local i,xa,ya,za,ha,a,b,c,d,f,g,points,F,s,t,x,y,m,n,features,dcoords,
          j,zaa,defined,wa,dlabels,num_points,dcolor,defoptions,nu,numpts,
          filledc,haa,nuu,polys,arrayindex,dlevels,Mi,Min,h,inc,colorrange,
          binc, colorrgb, ginc,rinc,huecolors, Wa, mnarray, nuuu;
    global _plotDigits;

    option `Copyright 1992 by George Labahn`;

    if nargs < 3 then ERROR(`at least three arguments are required`) fi;

    if type(FF,'set') then g:= [op(FF)]; else g:=[FF] fi;

    if not type(g,list({algebraic,procedure})) then 
       ERROR(`invalid 1st argument (the function)`,FF)
    fi;

    dcoords:='cartesian'; features:= NULL; dcolor := 'NONE'; 
    dlabels := NULL; filledc := true; huecolors := false; 
    colorrange := [[1,0,0],[1,1,0]]:  # from red to yellow

    _plotDigits := Digits;
    if type(r1,name=constant..constant) and
       type(r2,name=constant..constant) then
	x := op(1,r1); t := op(2,r1); a := op(1,t); b := op(2,t);
	y := op(1,r2); t := op(2,r2); c := op(1,t); d := op(2,t);
    elif type(r1,constant..constant) and type(r2,constant..constant) then
	a := op(1,r1); b := op(2,r1); c := op(1,r2); d := op(2,r2);
    else ERROR(`bad range arguments`,r1,r2)
    fi;

    f := proc(x) local y;
	option `Copyright 1992 by the University of Waterloo`;
	y := traperror(evalf(x,15));
	if type(y,numeric) then RETURN(y) fi;
	ERROR(`real constants expected in ranges`,x)
    end;

    a := f(a); b := f(b); c := f(c); d := f(d);
    if b <= a or d <= c then
       ERROR(`ranges must be non-empty`)
    fi;

    m  := plots['setoptions3d'](grid)[1] - 4; # intervals along the x-axis
    n  := plots['setoptions3d'](grid)[2] - 4; # intervals along the y-axis
    dlevels := 5;

    for t in [args[4..nargs]] do
	if not type(t,equation) then ERROR(`bad optional argument`,t) fi;
	s := op(1,t); t := op(2,t);
	if s = 'labels' and type(t,['string','string']) then
	    dlabels := AXESLABELS(op(t))
	elif s = 'numpoints' then
	    if type(t,integer) and t > 0 then
		t := isqrt(t+3);
		m := t; n := t;
	    else ERROR(`numpoints must be a positive integer`,t)
	    fi
	elif s = 'grid' then
	    if type(t,[integer,integer]) then
		m := t[1]-1; n := t[2]-1;
		if m < 1 or n < 1 then ERROR(`grid dimensions must be > 1`) fi
	    else ERROR(`bad grid option`,t)
	    fi
	elif s = 'coords' then
	    if member(t,{'spherical','cartesian'})
		then dcoords:=t
	    else ERROR(`bad coords value`,t)
	    fi
	elif s = 'levels' then
            dlevels := t;
	elif s = 'contours' then
            dlevels := t;
	elif s = 'coloring' and type(t,list) then
            `plot/color`;
            colorrange := [`plot/colortable`[t[1]],
		           `plot/colortable`[t[2]]];
	elif s = 'colortype' and member(t,{'hue','HUE'}) then
            huecolors := true;
	elif s = 'filled' then
            filledc := t;
        elif s = 'color' or s = 'colour' then
          dcolor := `plot/color`(t);
	else features := features,s=t; 
	fi
od;

features := `plot/options2d`(features);

if dlabels = NULL and dcoords='cartesian'
    and assigned(x) and assigned(y) 
    and type(x,'string') and type(y,'string') then
    dlabels := AXESLABELS(x,y);
fi;

features := features,dlabels;

if not type(dlevels, integer) then
   nuuu := nops(dlevels) + 1; 
else
   nuuu := dlevels + 1;
fi;

if huecolors then
   ginc := evalf(sqrt(colorrange[1][1]^2 + colorrange[1][2]^2 + 
                      colorrange[1][2]^2)/ sqrt(3));
   rinc := evalf(sqrt(colorrange[2][1]^2 + colorrange[2][2]^2 + 
		      colorrange[2][2]^2)/ sqrt(3));
   if rinc > ginc then
      rinc := (rinc-ginc)/(nuuu - 1);
      colorrgb := [seq( COLOUR('HUE', ginc + i*rinc),i=0..nuuu-1)];
   else
      rinc := (ginc-rinc)/(nuuu - 1);
      ginc := sqrt(colorrange[2][1]^2 + colorrange[2][2]^2 + 
		   colorrange[2][2]^2);
      colorrgb := [seq( COLOUR('HUE', ginc + i*rinc),i=0..nuuu-1)];
   fi;
else
   rinc := (colorrange[2][1] - colorrange[1][1])/(nuuu - 1);
   ginc := (colorrange[2][2] - colorrange[1][2])/(nuuu - 1);
   binc := (colorrange[2][3] - colorrange[1][3])/(nuuu - 1);
   colorrgb := [seq( COLOUR('RGB', colorrange[1][1] + i*rinc,
		       colorrange[1][2] + i*ginc,
		       colorrange[1][3] + i*binc),i=0..nuuu-1)];
fi;
#
readlib(plot):
arrayindex := 0;	
#
points:=NULL; polys := NULL:

for  F in  g do
   if  type(r1,equation) and type(r2,equation) then
	if type(F,procedure) and not type(F,name) then
	   ERROR(`invalid arguments`) fi;
	f := `plot3d/makefunc`(F,[x,y]);
   elif type(r1,range) and type(r2,range) then
	f := F;
   else ERROR(`invalid ranges`,r1,r2);
   fi;
   if dcoords = 'spherical' then
      xa := array(0..m,0..n); ya := array(0..m,0..n); 
      zaa := array(0..n); defined := array(0..m,0..n);
      `plot3d/cylinder`( f,xa,ya,zaa,a,b,c,d,m,n);
      za := array(0..m,0..n);
      for i from 0 to m do for j from 0 to n do za[i,j]:= -zaa[j] od od:
      
      defined := map(proc(x) if x = -undefined or x = undefined 
                             then 0 else 1 fi end,eval(za));
      za := map(proc(x) if x = -undefined or x = undefined 
                        then 0 else x fi end,eval(za));
      Mi := seq(seq(za[i,j],i=0..m),j=0..n);
      Min := min(Mi);
      if type( dlevels, integer) then
          Mi := max(Mi);
          inc := (Mi - Min)/(dlevels);
          h  := [seq(Min + i*inc,i=1..dlevels-1)]; 
      else
          h := dlevels;
      fi;
      ha := array(evalf(h));
      nu := nops(h);
      haa := array(evalf([Min,op(h)]));
      nuu := nops(h) + 1;

      i := 2*m*n*nu;
      if (i > 1000) then i := 1000 fi;
      wa := array(1..nu,0..i,1..4);
      numpts := array(1..nu);
      i := 'i';
      num_points:=traperror(evalhf(`plot/iplot2d/levelcurves` 
		 (xa,ya,za,ha,var(wa),var(numpts),defined,m,n,nu)));
      userinfo(5,'plot',`Output from evalhf of curves`,num_points);

      if num_points = lasterror then
             wa := array(1..nu,0..2*m*n,1..4);
	     num_points:= evalf(`plot/iplot2d/levelcurves`
			 (xa,ya,za,ha,wa,numpts,defined,m,n,nu));
      fi;
      points := points,seq(CURVES(seq([[wa[j,i,1],wa[j,i,2]],[wa[j,i,3],
		   wa[j,i,4]]],i=0..trunc(numpts[j])),COLOUR('RGB',
                    op(colorrgb[modp(arrayindex+j - 1,nu)+1]))),j=1..nu);
      if filledc then
	points := op(eval(subs('COLOUR'=(x->NULL), [points])));
        i := 2*m*n*nu; 
	if (i > 1000) then i := 1000 fi;
      	wa := array(1..nuu,0..i,1..4);
      	Wa := array(1..nuu,0..i,5..8);
      	numpts := array(1..nuu);
      	i := 'i';
        mnarray := array([m,n,nuu]);
        `plot/filledcon`(xa,ya,za,haa,wa,Wa,numpts,defined,mnarray);
        polys := polys,seq(POLYGONS(seq([[wa[j,i,1],wa[j,i,2]],
                	[wa[j,i,3],wa[j,i,4]],[Wa[j,i,5],Wa[j,i,6]],
                	[Wa[j,i,7],Wa[j,i,8]]], i=0..trunc(numpts[j])),
		        colorrgb[modp(arrayindex+j-1,nuu)+1],
                        STYLE('PATCHNOGRID')),j=1..nuu);
      fi;
      arrayindex := arrayindex + j - 1;
   else
      # Case of a function  z = f(x,y)
      xa := array(0..m,0..n); ya := array(0..m,0..n); 
      za := array(0..m,0..n); defined := array(0..m,0..n);
      `plot3d/surface`(proc(x,y) x end,xa,a,b,c,d,m,n);
      `plot3d/surface`(proc(x,y) y end,ya,a,b,c,d,m,n);
      `plot3d/surface`(f,za,a,b,c,d,m,n);
      defined := map(proc(x) if x = undefined then 0 else 1 fi end,eval(za));
      za := map(proc(x) if x = undefined then 0 else x fi end,eval(za));
     
      Mi := seq(seq(za[i,j],i=0..m),j=0..n);
      Min := min(Mi);
      if type(dlevels,integer) then
          Mi := max(Mi);
          inc := (Mi - Min)/(dlevels);
          h  := [seq(Min + i*inc,i=1..dlevels-1)]; 
          nu := dlevels-1;
      else
          nu := nops(dlevels);
          h := evalf(dlevels);
      fi;
      ha := array(evalf(h));
      haa := array(evalf([Min,op(h)]));
      nuu := nops(h) + 1;

      i := 2*m*n*nu;
      if (i > 1000) then i := 1000 fi;
      wa := array(1..nu,0..i,1..4);
      numpts := array(1..nu);
      i := 'i';
      num_points:= traperror(evalhf(`plot/iplot2d/levelcurves`
		 (xa,ya,za,ha,var(wa),var(numpts),defined,m,n,nu)));
      userinfo(5,'plot',`Output from evalhf of curves`,num_points);
      if num_points = lasterror then
             wa := array(1..nu,0..2*m*n,1..4);
	     num_points:= evalf(`plot/iplot2d/levelcurves`
			   (xa,ya,za,ha,wa,numpts,defined,m,n,nu));
      fi;
      points := points,seq(CURVES(seq([[wa[j,i,1],wa[j,i,2]],
                 [wa[j,i,3],wa[j,i,4]]],i=0..trunc(numpts[j])),COLOUR('RGB',
                 op(colorrgb[modp(arrayindex+j-1,nu)+1]))),j=1..nu);

      if filledc then
	points := op(eval(subs('COLOUR'=(x->NULL), [points])));
        i := 2*m*n*nu;
	if (i > 1000) then i := 1000 fi;
      	wa := array(1..nuu,0..i,1..4);
      	Wa := array(1..nuu,0..i,5..8);
      	numpts := array(1..nuu);
      	i := 'i';
        mnarray := array([m,n,nuu]);
        `plot/filledcon`(xa,ya,za,haa,wa,Wa,numpts,defined,mnarray);
        polys := polys,seq(POLYGONS(seq([[wa[j,i,1],wa[j,i,2]],
                	[wa[j,i,3],wa[j,i,4]],[Wa[j,i,5],Wa[j,i,6]],
                	[Wa[j,i,7],Wa[j,i,8]]], i=0..trunc(numpts[j])),
		        colorrgb[modp(arrayindex+j-1,nuu)+1],
                        STYLE('PATCHNOGRID')),j=1..nuu);
      fi;
      arrayindex := arrayindex + j - 1;
   fi;

od;

if dcolor <> 'NONE' then 
   # get rid of all the color options in the curve sequence
   if has([points],'COLOUR') then
	points := op(eval(subs('COLOUR'=(x->NULL), [points])));
   fi;
   features := features, dcolor;
fi;

#
# output the graph so iris will catch it
# convert features to internal data structure and attach to features.

readlib(`plots/setoptions`);
defoptions := `plots/getoptions`([features]);
PLOT(points,polys, defoptions );

end:

# --> `plot/iplot2d/levelcurves` := proc(xa,ya,za,ha,wa,numpts,defined,m,n,nu)
#
# numeric routine that computes the level curve specified by the grid of 
# points given in the arrays xa and ya with the heights in the array za. 
# The resulting set of lines are specified in the array wa. For a given 
# level j each entry is a 4-tuple giving a # starting point and an ending 
# point of a line segment in the level curve at ha[j]. The array defined 
# contains the information about if a z coordinate is defined (==1) or 
# undefined (== 0). The variables m and n specify the grid sizes, while nu 
# defines the number of levels. 
# 

`plot/iplot2d/levelcurves` := proc(xa,ya,za,ha,wa,numpts,defined,m,n,nu)
   local i,j,k,level,eps,alpha,x,y,h,d,x1,x2,y1,y2,c,flag,u;

  option `Copyright 1992 by George Labahn`;

 k := 0; 
 for i from 0 to m do
     for j from 0 to n do
        if defined[i,j] = 1 then
           if k = 0 then x1 := za[i,j]; x2 := za[i,j]; k := 1;
           elif za[i,j] > x2 then x2 := za[i,j];
           elif za[i,j] < x1 then x1 := za[i,j];
           fi;
        fi;
     od;
 od;

 if (k = 0) then
	ERROR(`could not evaluate expression`);
 fi;

 eps := 10.0^(-Digits)*(x2-x1);

 x := array(1..3);
 y := array(1..3);
 h := array(1..3);
 d := array(1..3);
  
 for u from 1 to nu do 
   level:= ha[u];
   k := 0;
   for i from 0 to m-1 do
     for j from 0 to n-1 do
       for c to 2 do
	  if (c = 1) then
	     d[1] := defined[i,j];
	     d[2] := defined[i+1,j];
	     d[3] := defined[i,j+1];
	     x[1] := xa[i,j];
	     x[2] := xa[i+1,j];
	     x[3] := xa[i,j+1];
	     y[1] := ya[i,j];
	     y[2] := ya[i+1,j];
	     y[3] := ya[i,j+1];
	     h[1] := za[i,j]   - level;
	     h[2] := za[i+1,j] - level;
	     h[3] := za[i,j+1] - level;
	  else
	     d[1] := defined[i+1,j+1];
	     x[1] := xa[i+1,j+1];
	     y[1] := ya[i+1,j+1];
	     h[1] := za[i+1,j+1] - level;
          fi;
#
# Make sure the points are defined
#
         if (d[1] * d[2] *d[3] = 0) then next fi;
	 flag := 1;

	 if (h[1] < - eps) then
	    if (h[2] < - eps) then
	       if (h[3] > eps) then
		  alpha := -h[1] / (h[3] - h[1]);
		  x1 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y1 := y[3] * alpha + (1.0 - alpha) * y[1];
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
	       else
		  flag := 0;#next;
	       fi;
	    elif (h[2] > eps) then
	       alpha := -h[1] / (h[2] - h[1]);
	       x1 := x[2] * alpha + (1.0 - alpha) * x[1];
	       y1 := y[2] * alpha + (1.0 - alpha) * y[1];
	       if (h[3] < - eps) then
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
	       elif (h[3] > eps) then
		  alpha := -h[1] / (h[3] - h[1]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[1];
	       else 
		  x2 := x[3];
		  y2 := y[3];
	       fi;
	    else 
	       x1 := x[2];
	       y1 := y[2];
	       if (h[3] < - eps) then
		  flag := 0;#next;
	       elif (h[3] > eps) then
		  alpha := -h[1] / (h[3] - h[1]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[1];
	       else 
		  x2 := x[3];
		  y2 := y[3];
	       fi;
	    fi;
	 elif (h[1] >  eps) then
	    if (h[2] < - eps) then
	       alpha := -h[1] / (h[2] - h[1]);
	       x1 := x[2] * alpha + (1.0 - alpha) * x[1];
	       y1 := y[2] * alpha + (1.0 - alpha) * y[1];
	       if (h[3] < - eps) then
		  alpha := -h[1] / (h[3] - h[1]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[1];
	       elif (h[3] > eps) then
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
	       else 
		  x2 := x[3];
		  y2 := y[3];
	       fi;
	    elif (h[2] > eps) then
	       if (h[3] < - eps) then
		  alpha := -h[1] / (h[3] - h[1]);
		  x1 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y1 := y[3] * alpha + (1.0 - alpha) * y[1];
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
	       else
		  flag := 0;#next;
	       fi;
	    else 		# 2 is on the contour 
	       x1 := x[2];
	       y1 := y[2];
	       if (h[3] < - eps) then
		  alpha := -h[1] / (h[3] - h[1]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[1];
	       elif (h[3] > eps) then
		  flag := 0;#next;
	       else 
		  x2 := x[2];
		  y2 := y[2];
	       fi;
	    fi;
	 else 			# 1 is on the contour 
	    x1 := x[1];
	    y1 := y[1];
	    if (h[2] < - eps) then
	       if (h[3] < - eps) then
		  flag := 0;#next;
	       elif (h[3] > eps) then
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
	       else 
		  x2 := x[3];
		  y2 := y[3];
	       fi;
	    elif (h[2] > eps) then
	       if (h[3] < - eps) then
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
	       elif (h[3] > eps) then
		  flag := 0;#next;
	       else 
		  x2 := x[3];
		  y2 := y[3];
	       fi;
	    else 
	       if ((h[3] < eps) and (h[3] > - eps)) then
		  # we have a flat against the contour 
	          wa[u,k,1] := x[1];
	          wa[u,k,2] := y[1];
	          wa[u,k,3] := x[2];
	          wa[u,k,4] := y[2];
	          k := k + 1;
	          wa[u,k,1] := x[2];
	          wa[u,k,2] := y[2];
	          wa[u,k,3] := x[3];
	          wa[u,k,4] := y[3];
	          k := k + 1;
	          wa[u,k,1] := x[1];
	          wa[u,k,2] := y[1];
	          wa[u,k,3] := x[3];
	          wa[u,k,4] := y[3];
	          k := k + 1;
		  flag := 0;#next;
	       else 
		  x2 := x[2];
		  y2 := y[2];
	       fi;
	    fi;
	 fi;
	 if (flag <> 0) then
	 wa[u,k,1] := x1;
	 wa[u,k,2] := y1;
	 wa[u,k,3] := x2;
	 wa[u,k,4] := y2;
	 k := k + 1;
	 fi;
       od;
     od;
   od;
   numpts[u] := k-1;
 od;
k-1;
end:


# color_array :='maroon','plum','violet','blue','cyan','turquoise',
#               'aquamarine','green','khaki','wheat','gold','sienna',
#               'coral','red','orange','yellow';
# this sequence has a one-to-one correspondence with  color_array
_CCOLORRGB := [0.00000000, 1.00000000, 0.00000000],
	     [0.62352941, 0.62352941, 0.37254902],
	     [0.84705882, 0.84705882, 0.74901961],
	     [0.80000000, 0.49803922, 0.19607843],
	     [0.55686275, 0.41960784, 0.13725490],
	     [1.00000000, 0.49803922, 0.00000000],
	     [1.00000000, 0.00000000, 0.00000000],
	     [0.80000000, 0.19607843, 0.19607843],
	     [1.00000000, 1.00000000, 0.00000000],
             [0.55686275, 0.13725490, 0.41960784],
             [0.91764706, 0.67843137, 0.91764706],
             [0.30980392, 0.18431373, 0.30980392],
             [0.00000000, 0.00000000, 1.00000000],
             [0.00000000, 1.00000000, 1.00000000],
             [0.67843137, 0.91764706, 0.91764706],
             [0.43921569, 0.85882353, 0.57647059]:


# -> `plot/filledcon`:=proc(xa,ya,za,ha,wa,Wa,numpts,defined,mnarray)
#
# numeric routine that computes the level curve specified by the grid of 
# points given in the arrays xa and ya with the heights in the array za. 
# The resulting set of lines are specified in the array wa. For a given 
# level j each entry is a 4-tuple giving a starting point and an ending 
# point of a line segment in the level curve at ha[j]. The array defined 
# contains the information about if a z coordinate is defined (==1) or 
# undefined (== 0). The variables m and n specify the grid sizes, while nu 
# defines the number of levels. 
# 

`plot/filledcon` := proc(xa,ya,za,haa,wa,Wa,numpts,defined,mnarray)
    local num_points;

    num_points:=traperror(evalhf(`plot/filledcon/regions`
                (xa,ya,za,haa,var(wa),var(Wa),var(numpts),defined,mnarray)));
        userinfo(5,'plot',`Output from evalhf of regions`,num_points);
        if num_points = lasterror then
             num_points:= evalf(`plot/filledcon/regions`
                (xa,ya,za,haa,wa,Wa,numpts,defined,mnarray));
        fi;

end:

`plot/filledcon/regions` := proc(xa,ya,za,ha,wa,Wa,numpts,defined,mnarray)
   local i,j,k,level,eps,alpha,x,y,h,d,x1,x2,x3,x4,y1,y2,y3,y4,c,flag,
         m,n,nu,u;

  option `Copyright 1992 by George Labahn`;

 m := mnarray[1]; n := mnarray[2]; nu := mnarray[3];
 k := 0; 
 for i from 0 to m do
     for j from 0 to n do
        if defined[i,j] = 1 then
           if k = 0 then x1 := za[i,j]; x2 := za[i,j]; k := 1;
           elif za[i,j] > x2 then x2 := za[i,j];
           elif za[i,j] < x1 then x1 := za[i,j];
           fi;
        fi;
     od;
 od;

 if (k = 0) then
	ERROR(`could not evaluate expression`);
 fi;

 eps := 10.0^(-Digits)*(x2-x1);

 x := array(1..3);
 y := array(1..3);
 h := array(1..3);
 d := array(1..3);
  
 ha[1] := x1;
 for u from 1 to nu do
   level:= ha[u];
   k := 0;
   for i from 0 to m-1 do
     for j from 0 to n-1 do
       for c to 2 do
	  if (c = 1) then
	     d[1] := defined[i,j];
	     d[2] := defined[i+1,j];
	     d[3] := defined[i,j+1];
	     x[1] := xa[i,j];
	     x[2] := xa[i+1,j];
	     x[3] := xa[i,j+1];
	     y[1] := ya[i,j];
	     y[2] := ya[i+1,j];
	     y[3] := ya[i,j+1];
	     h[1] := za[i,j]   - level;
	     h[2] := za[i+1,j] - level;
	     h[3] := za[i,j+1] - level;
	  else
	     d[1] := defined[i+1,j+1];
	     x[1] := xa[i+1,j+1];
	     y[1] := ya[i+1,j+1];
	     h[1] := za[i+1,j+1] - level;
	     h[2] := za[i+1,j] - level;
	     h[3] := za[i,j+1] - level;
          fi;
#
# Make sure the points are defined
#

#if i = 3 and j = 1 and c = 2 then
#print(h[1],h[2],h[3]);
#if u <> nu then print(level,ha[u+1]-level);
#else print(level);
#fi;
#fi;

         if (d[1] * d[2] *d[3] = 0) then next fi;
	 flag := 1;

	 if (h[1] < - eps) then
            # - *
	    if (h[2] < - eps) then
               # - - *
	       if (h[3] > eps) then
                  #  - - +
		  alpha := -h[1] / (h[3] - h[1]);
		  x1 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y1 := y[3] * alpha + (1.0 - alpha) * y[1];
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
                  if (u = nu or h[3] <=  eps + ha[u+1] - level) then
                     x3 := x[3]; x4 := x[3]; y3 := y[3]; y4 := y[3];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[2] / (h[3] - h[2]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[2];
		     alpha := -h[1] / (h[3] - h[1]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[1];
                  fi;
	       else
                  #  - - - or - - 0
                  flag := 0;  # next
	       fi;
	    elif (h[2] > eps) then
               #  - + *
	       alpha := -h[1] / (h[2] - h[1]);
	       x1 := x[2] * alpha + (1.0 - alpha) * x[1];
	       y1 := y[2] * alpha + (1.0 - alpha) * y[1];
	       if (h[3] < - eps) then
                  #  - + -
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
                  if (u = nu or h[2] <= eps + ha[u+1] - level) then
                     x3 := x[2]; x4 := x[2]; y3 := y[2]; y4 := y[2];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[2] / (h[3] - h[2]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[2];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
                  fi;
	       elif (h[3] > eps) then
                  #  - + +
		  alpha := -h[1] / (h[3] - h[1]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[1];
                  if (u = nu or (h[2] <= eps + ha[u+1] - level and 
                                 h[3] <= eps + ha[u+1] - level)) then
                     x3 := x[3]; x4 := x[2]; y3 := y[3]; y4 := y[2];
                  elif (h[2] <= eps + ha[u+1] - level and 
			h[3] > eps + ha[u+1] - level) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[2] / (h[3] - h[2]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[2];
	             wa[u,k,1] := x1;
             	     wa[u,k,2] := y1;
             	     wa[u,k,3] := x2;
             	     wa[u,k,4] := y2;
             	     Wa[u,k,5] := x3;
             	     Wa[u,k,6] := y3;
             	     Wa[u,k,7] := x4;
             	     Wa[u,k,8] := y4;
                     k := k + 1;
                     x3 := x4; y3 := y4; x2 := x[2]; y2 := y[2];
                  elif (h[2] > eps + ha[u+1] - level and 
			h[3] <= eps + ha[u+1] - level) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[3] / (h[2] - h[3]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
	             wa[u,k,1] := x1;
             	     wa[u,k,2] := y1;
             	     wa[u,k,3] := x2;
             	     wa[u,k,4] := y2;
             	     Wa[u,k,5] := x3;
             	     Wa[u,k,6] := y3;
             	     Wa[u,k,7] := x4;
             	     Wa[u,k,8] := y4;
                     k := k + 1;
                     x1 := x2; y1 := y2; x4 := x[3]; y4 := y[3];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
                  fi;
	       else 
                  #  - + 0
                  x2 := x[3]; y2 := y[3];
                  if (u = nu or h[2] <= eps + ha[u+1] - level) then
                     x3 := x[2]; x4 := x[2]; y3 := y[2]; y4 := y[2];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[2] / (h[3] - h[2]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[2];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
                  fi;
	       fi;
	    else 
   	       # - 0 *
              # Case h[2] ~= 0
	       x1 := x[2];
	       y1 := y[2];
	       if (h[3] < - eps) then
   	          # - 0 -
                  flag := 0;  # next
	       elif (h[3] > eps) then
   	          # - 0 +
		  alpha := -h[1] / (h[3] - h[1]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[1];
                  if (u = nu or h[3] <= eps + ha[u+1] - level) then
                     x3 := x[3]; x4 := x[3]; y3 := y[3]; y4 := y[3];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
 		     alpha := -h[1] / (h[3] - h[1]);
                     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
                     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
                     alpha := -h[2] / (h[3] - h[2]);
                     x4 := x[3] * alpha + (1.0 - alpha) * x[2];
                     y4 := y[3] * alpha + (1.0 - alpha) * y[2];
                  fi;
	       else 
   	          # - 0 0
                  flag := 0; # next
	       fi;
	    fi;
	 elif (h[1] >  eps) then
            # + *
	    if (h[2] < - eps) then
               # + - *
	       alpha := -h[1] / (h[2] - h[1]);
	       x1 := x[2] * alpha + (1.0 - alpha) * x[1];
	       y1 := y[2] * alpha + (1.0 - alpha) * y[1];
	       if (h[3] < - eps) then
                  # + - -
		  alpha := -h[1] / (h[3] - h[1]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[1];
                  if (u = nu or h[1] <= eps + ha[u+1] -level) then
                     x3 := x[1]; y3 := y[1]; x4 := x[1]; y4 := y[1];
                  elif h[1] > eps + ha[u+1] - level then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
                  fi;
	       elif (h[3] > eps) then
                  # + - +
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
                  if (u = nu or (h[1] <= eps + ha[u+1] - level and
              			 h[3] <= eps + ha[u+1] - level)) then
                     x3 := x[3]; y3 := y[3]; x4 := x[1]; y4 := y[1];
                  elif (h[1] > eps + ha[u+1] - level and
		        h[3] <= eps + ha[u+1] - level) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
	             wa[u,k,1] := x1;
             	     wa[u,k,2] := y1;
             	     wa[u,k,3] := x2;
             	     wa[u,k,4] := y2;
             	     Wa[u,k,5] := x3;
             	     Wa[u,k,6] := y3;
             	     Wa[u,k,7] := x4;
             	     Wa[u,k,8] := y4;
                     k := k + 1;
                     x1 := x2; y1 := y2; x4 := x[3]; y4 := y[3];
		  elif ( h[3] > eps + ha[u+1] - level and
			 h[1] <= eps + ha[u+1] - level ) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[3] / (h[2] - h[3]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[3] / (h[1] - h[3]);
		     x4 := x[1] * alpha + (1.0 - alpha) * x[3];
		     y4 := y[1] * alpha + (1.0 - alpha) * y[3];
	             wa[u,k,1] := x1;
             	     wa[u,k,2] := y1;
             	     wa[u,k,3] := x2;
             	     wa[u,k,4] := y2;
             	     Wa[u,k,5] := x3;
             	     Wa[u,k,6] := y3;
             	     Wa[u,k,7] := x4;
             	     Wa[u,k,8] := y4;
                     k := k + 1;
                     x2 := x[1]; y2 := y[1]; x3 := x2; y3 := y2;
		  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[3] / (h[2] - h[3]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
		  fi; 
	       else 
                  # + - 0
		  x2 := x[3];
		  y2 := y[3];
                  if ( u = nu or h[1] <= eps + ha[u+1] - level) then
                     x3 := x[1]; y3:= y[1]; x4 := x[1]; y4:= y[1]; 
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[3] / (h[1] - h[3]);
		     x3 := x[1] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[1] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
		  fi; 
	       fi;
	    elif (h[2] > eps) then
               # + + *
	       if (h[3] < - eps) then
                  # + + -
		  alpha := -h[1] / (h[3] - h[1]);
		  x1 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y1 := y[3] * alpha + (1.0 - alpha) * y[1];
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
                  if (u = nu or (h[1] <= eps + ha[u+1] - level and
              			 h[2] <= eps + ha[u+1] - level)) then
                     x3 := x[2]; y3 := y[2]; x4 := x[1]; y4 := y[1];
                  elif ( h[1] > eps + ha[u+1] - level and
			  h[2] <= eps + ha[u+1] - level) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[2] - h[1]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[1] / (h[3] - h[1]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[1];
	             wa[u,k,1] := x1;
             	     wa[u,k,2] := y1;
             	     wa[u,k,3] := x2;
             	     wa[u,k,4] := y2;
             	     Wa[u,k,5] := x3;
             	     Wa[u,k,6] := y3;
             	     Wa[u,k,7] := x4;
             	     Wa[u,k,8] := y4;
                     k := k + 1;
                     x1 := x2; y1 := y2; x4 := x[2]; y4 := y[2];
		  elif ( h[2] > eps + ha[u+1] - level and
			 h[1] <= eps + ha[u+1] - level ) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[3] / (h[2] - h[3]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
	             wa[u,k,1] := x1;
             	     wa[u,k,2] := y1;
             	     wa[u,k,3] := x2;
             	     wa[u,k,4] := y2;
             	     Wa[u,k,5] := x3;
             	     Wa[u,k,6] := y3;
             	     Wa[u,k,7] := x4;
             	     Wa[u,k,8] := y4;
                     k := k + 1;
                     x2 := x1; y2 := y1; x3 := x[1]; y3 := y[1];
		  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[3] / (h[2] - h[3]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[1] / (h[3] - h[1]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[1];
  		  fi;
               elif h[3] > eps then
                  # + + + 
                  if (u = nu) or (h[1] <= eps + ha[u+1] - level and
              			  h[2] <= eps + ha[u+1] - level and 
              			  h[3] <= eps + ha[u+1] - level) then
                     x1 := x[3]; y1 := y[3]; x2 := x[3]; y2 := y[3];
                     x3 := x[2]; y3 := y[2]; x4 := x[1]; y4 := y[1];
                  elif ( h[3] > eps + ha[u+1] - level and
			 h[1] <= eps + ha[u+1] - level and
			 h[2] <= eps + ha[u+1] - level) then
                     x1 := x[2]; y1 := y[2]; x2 := x[1]; y2 := y[1];
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
	             alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[2] / (h[3] - h[2]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[2];
                  elif ( h[1] > eps + ha[u+1] - level and
			 h[2] <= eps + ha[u+1] - level and
			 h[3] <= eps + ha[u+1] - level) then
                     x1 := x[2]; y1 := y[2]; x2 := x[3]; y2 := y[3];
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
	             alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
                  elif ( h[2] > eps + ha[u+1] - level and
			 h[1] <= eps + ha[u+1] - level and
			 h[3] <= eps + ha[u+1] - level) then
                     x1 := x[3]; y1 := y[3]; x2 := x[1]; y2 := y[1];
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[2] - h[1]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[2] / (h[3] - h[2]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[2];
                  elif ( h[3] > eps + ha[u+1] - level and
			 h[1] > eps + ha[u+1] - level and
			 h[2] <= eps + ha[u+1] - level) then
                     x1 := x[2]; y1 := y[2]; x2 := x[2]; y2 := y[2];
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[2] / (h[3] - h[2]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[2];
		     alpha := -h[2] / (h[1] - h[2]);
		     x4 := x[1] * alpha + (1.0 - alpha) * x[2];
		     y4 := y[1] * alpha + (1.0 - alpha) * y[2];
                  elif ( h[3] > eps + ha[u+1] - level and
			 h[2] > eps + ha[u+1] - level and
			 h[1] <= eps + ha[u+1] - level) then
                     x1 := x[1]; y1 := y[1]; x2 := x[1]; y2 := y[1];
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[2] / (h[1] - h[2]);
		     x4 := x[1] * alpha + (1.0 - alpha) * x[2];
		     y4 := y[1] * alpha + (1.0 - alpha) * y[2];
                  elif ( h[1] > eps + ha[u+1] - level and
			 h[2] > eps + ha[u+1] - level and
			 h[3] <= eps + ha[u+1] - level) then
                     x1 := x[3]; y1 := y[3]; x2 := x[3]; y2 := y[3];
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[2] / (h[3] - h[2]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[2];
                  fi;
               else
                  # + + 0
                  # 3 is on contour
                  x1 := x[3]; y1 := y[3]; x2 := x[3]; y2 := y[3];
                  if (u = nu or (h[1] <= eps + ha[u+1] - level and
              			 h[2] <= eps + ha[u+1] - level)) then
                     x3 := x[2]; y3 := y[2]; x4 := x[1]; y4 := y[1];
                  elif ( h[1] > eps + ha[u+1] - level and
			 h[2] <= eps + ha[u+1] - level) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
   	             x3 := x[2]; y3 := y[2];	
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[1] / (h[3] - h[1]);
		     x1 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y1 := y[3] * alpha + (1.0 - alpha) * y[1];
		  elif ( h[2] > eps + ha[u+1] - level and
			 h[1] <= eps + ha[u+1] - level) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[3] / (h[2] - h[3]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
   	             x1 := x[1]; y1 := y[1];	
		  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[3] / (h[2] - h[3]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[1] / (h[3] - h[1]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[1];
  		  fi;
	       fi;
	    else 		# 2 is on the contour 
               # + 0 *
	       x1 := x[2];
	       y1 := y[2];
	       if (h[3] < - eps) then
                  # + 0 -
		  alpha := -h[1] / (h[3] - h[1]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[1];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[1];
                  if ( u = nu or h[1] <= eps + ha[u+1] - level) then
                     x3 := x[1]; y3 := y[1]; x4 := x[1]; y4 := y[1];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
                  fi;
	       elif (h[3] > eps) then
                  # + 0 +
                  x2 := x[2]; y2 := y[2];
                  if (u = nu or (h[1] <= eps + ha[u+1] - level and
              			 h[3] <= eps + ha[u+1] - level)) then
                     x3 := x[3]; y3 := y[3]; x4 := x[1]; y4 := y[1];
                  elif ( h[1] > eps + ha[u+1] - level and
			 h[3] <= eps + ha[u+1] - level) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
   	             x2 := x[3]; y2 := y[3];	
		     alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
		  elif ( h[3] > eps + ha[u+1] - level and 
			 h[1] <= eps + ha[u+1] - level ) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[3] / (h[2] - h[3]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[3] / (h[1] - h[3]);
		     x4 := x[1] * alpha + (1.0 - alpha) * x[3];
		     y4 := y[1] * alpha + (1.0 - alpha) * y[3];
                     x1 := x[1]; y1 := y[1];
		  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[3] / (h[2] - h[3]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
  		  fi;
	       else 
                  # + 0 0
		  x2 := x[3]; y2 := y[3];
                  if (u = nu or h[1] <= eps + ha[u+1] - level) then
                     x3 := x[1]; y3 := y[1]; x4 := x[1]; y4 := y[1];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[3] - h[1]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
                  fi;
	       fi;
	    fi;
	 else 			# 1 is on the contour 
            # 0 *
	    x1 := x[1];
	    y1 := y[1];
	    if (h[2] < - eps) then
               # 0 - *
	       if (h[3] < - eps) then
                 # 0 - -
                 flag := 0; # next
	       elif (h[3] > eps) then
                  # 0 - +
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
                  if ( u = nu or h[3] <= eps + ha[u+1] - level) then
                     x3 := x[3]; y3 := y[3]; x4 := x[1]; y4 := y[1];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[2] / (h[3] - h[2]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[2];
		     alpha := -h[1] / (h[3] - h[1]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[1];
                  fi;
	       else 
                  # 0 - 0
                  flag := 0; # next
	       fi;
	    elif (h[2] > eps) then
               # 0 + *
	       if (h[3] < - eps) then
                  # 0 + -
		  alpha := -h[2] / (h[3] - h[2]);
		  x2 := x[3] * alpha + (1.0 - alpha) * x[2];
		  y2 := y[3] * alpha + (1.0 - alpha) * y[2];
                  if (u = nu or h[2] <=  eps + ha[u+1] - level) then
                     x3 := x[2]; y3 := y[2]; x4 := x[1]; y4 := y[1];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[2] / (h[3] - h[2]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[2];
		     alpha := -h[1] / (h[2] - h[1]);
		     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
                  fi;
	       elif (h[3] > eps) then
                  # 0 + +
                  x2 := x[1]; y2 := y[1];
                  if (u = nu or (h[2] <= eps + ha[u+1] - level and
              			 h[3] <= eps + ha[u+1] - level)) then
                     x3 := x[3]; y3 := y[3]; x4 := x[2]; y4 := y[2];
                  elif (h[2] > eps + ha[u+1] - level and 
			h[3] <= eps + ha[u+1] - level) then
                     x2 := x[3]; y2 := y[3];
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[2] / (h[3] - h[2]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[2];
		     alpha := -h[2] / (h[1] - h[2]);
		     x4 := x[1] * alpha + (1.0 - alpha) * x[2];
		     y4 := y[1] * alpha + (1.0 - alpha) * y[2];
		  elif (h[3] > eps + ha[u+1] - level and
		 	h[2] <= eps + ha[u+1] - level ) then
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
   	             x2 := x[2]; y2 := y[2];	
		     alpha := -h[3] / (h[2] - h[3]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[3];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[3];
		     alpha := -h[1] / (h[3] - h[1]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[1];
		  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[1] / (h[2] - h[1]);
		     x3 := x[2] * alpha + (1.0 - alpha) * x[1];
		     y3 := y[2] * alpha + (1.0 - alpha) * y[1];
		     alpha := -h[1] / (h[3] - h[1]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[1];
  		  fi;
	       else 
                  # 0 + 0
		  # both 1 and 3 are on contour
		  x2 := x[3];
		  y2 := y[3];
                  if ( u = nu or h[2] <= eps + ha[u+1] - level) then
                     x3 := x[2]; y3 := y[2]; x4 := x[2]; y4 := y[2];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[2] / (h[3] - h[2]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[2];
		     x4 := x[1]; y4:= y[1];
	#	     alpha := -h[1] / (h[2] - h[1]);
	#	     x4 := x[2] * alpha + (1.0 - alpha) * x[1];
	#	     y4 := y[2] * alpha + (1.0 - alpha) * y[1];
                  fi;
	       fi;
	    else 
              # 0 0 *
	       if ((h[3] < eps) and (h[3] > - eps)) then
                  # 0 0 0
		  # we have a flat against the contour 
                  x1 := x[1]; y1:=y[1]; x2 := x[2]; y2:=y[2];
                  x3 := x[3]; y3:=y[3]; x4 := x[3]; y4:=y[3];
               elif h[3] > eps then
                  # 0 0 +
                  # + 0 0
                  x1 := x[1]; y1 := y[1]; x2 := x[2]; y2 := y[2];
                  if (u = nu or h[3] <= eps + ha[u+1] - level) then
                     x3 := x[3]; y3 := y[3]; x4 := x[1]; y4 := y[1];
                  else
                     h[1] := h[1] - ha[u+1] + level;
                     h[2] := h[2] - ha[u+1] + level;
                     h[3] := h[3] - ha[u+1] + level;
		     alpha := -h[2] / (h[3] - h[2]);
		     x3 := x[3] * alpha + (1.0 - alpha) * x[2];
		     y3 := y[3] * alpha + (1.0 - alpha) * y[2];
		     alpha := -h[1] / (h[3] - h[1]);
		     x4 := x[3] * alpha + (1.0 - alpha) * x[1];
		     y4 := y[3] * alpha + (1.0 - alpha) * y[1];
                  fi;
               else
                  # 0 0 -
                  flag := 0; # next
	       fi;
	    fi;
	 fi;
         if (flag <> 0) and not( y1 = y2 and y1 = y3 and y1 = y4)
                        and not( x1 = x2 and x1 = x3 and x1 = x4) then
	 wa[u,k,1] := x1;
	 wa[u,k,2] := y1;
	 wa[u,k,3] := x2;
	 wa[u,k,4] := y2;
	 Wa[u,k,5] := x3;
	 Wa[u,k,6] := y3;
	 Wa[u,k,7] := x4;
	 Wa[u,k,8] := y4;
	 k := k + 1;
	 fi;
       od;
     od;
   od;
   numpts[u] := k-1;
 od;
k-1;
end:

#savelib( '_CCOLORRGB',\
         '`plot/iplot2d/levelcurves`',\
         '`plot/filledcon/regions`',\
         '`plot/filledcon`',\
         'filledcontourplot', `filledcontourplot.m`):


`help/text/filledcontourplot` := TEXT(
`   `,
`FUNCTION: filledcontourplot - filled contour plotting`,
`   `,
`CALLING SEQUENCE:`,
`   filledcontourplot(expr1,x=a..b,y=c..d)`,
`   filledcontourplot(f,a..b,c..d)`,
`   filledcontourplot([ exprf,exprg,exprh ],s=a..b,t=c..d)`,
`   filledcontourplot([ f,g,h ],a..b,c..d)`,
`   `,
`PARAMETERS:`,
`   f,g,h             - function(s) to be plotted`,
`   expr1             - expression in x and y.`,
`   exprf,exprg,exprh - expressions in s and t.`,
`   a,b               - real constants.`,
`   c,d               - real constants, procedures or expressions in x`,
`   x,y,s,t           - names`,
`   `,
`SYNOPSIS:   `,
`- The four different calling sequences to the filledcontourplot function above`,
`  all define a filled contour plot. The first two calling sequences describe`,
`  filled contour plots in Cartesian co-ordinates while the second two describe`,
`  filled contour parametric plots.`,
`   `,
`- In the first call, filledcontourplot(expr1,x=a..b,y=c..d), the expression`,
`  expr1 must be a Maple expression in the names x and y.  The range a..b must`,
`  evaluate to real constants.  The range c..d also must evaluate to real con-`,
`  stants.  They specify the range over which expr1 which will be plotted.  In`,
`  the second call, filledcontourplot(f,a..b,c..d), f must be a Maple procedure`,
`  or operator which takes two arguments.  Operator notation must be used, i.e.`,
`  the procedure name is given without parameters specified, and the ranges must`,
`  be given simply in the form a..b, rather than as an equation. The second`,
`  range c..d can have arguments evaluating to real constants or procedures of`,
`  one-variable.`,
`   `,
`- A filled contour parametric plot can be defined by three expressions expr1,`,
`  expr2, expr3  in two variables.  In the third call,`,
`  filledcontourplot([ expr1,expr2,expr3 ],s=a..b,t=c..d), expr1, expr2, and`,
`  expr3 must be Maple expressions in the names s and t. Finally, in the fourth`,
`  call, filledcontourplot([ f,g,h ],a..b,c..d), f, g and h must be Maple pro-`,
`  cedures or operators taking two arguments.  Here again, operator notation`,
`  must be used.`,
`   `,
`- Any additional arguments are interpreted as options which are specified as`,
`  equations of the form option = value.  For example, the option grid = [m,n]`,
`  where m and n are positive integers specifies that the filledcontourplot is`,
`  to be constructed on an m by n grid at equally spaced points in the ranges`,
`  a..b and c..d respectively.  By default a 20 by 20 grid is used, thus 400`,
`  points are generated. By default there are also 10 levels. The number of lev-`,
`  els may be reassigned by using the levels = value option. The contour levels`,
`  may be reassigned by using the contours = value option, where in this case`,
`  value is a list of number.  The coloring ranges from equal gradations of red`,
`  to yellow. This may be changed by the coloring = value option, where the`,
`  value is a list of two colors available to 2d plots. See plot[color] for more`,
`  information on the list of available colors that can be used.`,
`   `,
`- The result of a call to filledcontourplot is a PLOT data structure containing`,
`  enough information to render the plot.  The user may assign a PLOT value to a`,
`  variable, save it in a file, then read it back in for redisplay.  See the`,
`  help page for plot[structure].`,
`   `,
`EXAMPLES:   `,
`filledcontourplot(sin(x*y),x=-3..3,y=-3..3);`,
`filledcontourplot(sin(x*y),x=-3..3,y=-3..3, levels= 4);`,
`filledcontourplot(sin(x*y),x=-3..3,y=-3..3, contours= [-1/2,1/4,1/2]);`,
`filledcontourplot(sin(x*y),x=-3..3,y=-3..3,coloring=[blue,white]);`,
`filledcontourplot(-5*x/(x^2 + y^2 + 1),x=-3..3,y=-3..3,coloring=[white,blue]);`,
`filledcontourplot(binomial,0..5,0..5,grid=[10,10]);`,
`filledcontourplot((1.3)^x * sin(y),x=-1..2*Pi,y=0..Pi,coords=spherical);`,
`z := x*exp(-x^2-y^2);`,
`filledcontourplot(z,x=-2..2,y=-2..2);`,
`   `,
`SEE ALSO: plot[options], plot[structure], plot[coords], plot[colors]`
):

#savelib(  '`help/text/filledcontourplot`' , \
'`help/text/filledcontourplot.m`' ):
#save `fconplot.m`;
#quit
