with unchecked_deallocation;
with Float_Matrices;                  use Float_Matrices;
with Float_Support_Functions;         use Float_Support_Functions;

package body Float_Mixed_Subdivisions is

-- CREATORS :

  function Create ( pts : Array_of_Lists; nor : Vector; tol : double_float )
                  return Mixed_Cell is

    res : Mixed_Cell;
    sup : double_float;

  begin
    res.nor := new Vector'(nor);
    res.pts := new Array_of_Lists(pts'range);
    for k in pts'range loop
      sup := Minimal_Support(pts(k),nor);
      res.pts(k) := Face(pts(k),nor,sup,tol);
    end loop;
    return res;
  end Create;

  function Create ( pts : Array_of_Lists; nors : List; tol : double_float )
                  return Mixed_Subdivision is

    res,res_last : Mixed_Subdivision;
    tmp : List := nors;

  begin
    while not Is_Null(tmp) loop
      Append(res,res_last,Create(pts,Head_Of(tmp).all,tol));
      tmp := Tail_Of(tmp);
    end loop;
    return res;
  end Create;

  function Create ( pts : Array_of_Lists; mixsub : Mixed_Subdivision;
                    tol : double_float ) return Mixed_Subdivision is

    tmp,res,res_last : Mixed_Subdivision;

  begin
    tmp := mixsub;
    while not Is_Null(tmp) loop
      Append(res,res_last,Create(pts,Head_Of(tmp).nor.all,tol));
      tmp := Tail_Of(tmp);
    end loop;
    return res;
  end Create;

  procedure Update ( pts : in Array_of_Lists; nor : in Vector;
                     mixsub,mixsub_last : in out Mixed_Subdivision ) is

  -- DESCRIPTION :
  --   Given a tuple of point sets and a normal,
  --   the mixed subdivision will be updated.

    tmp : Mixed_Subdivision := mixsub;
    done : boolean := false;

  begin
    while not Is_Null(tmp) and not done loop
      declare
        mic : Mixed_Cell := Head_Of(tmp);
        last : List;
      begin
        if Equal(mic.nor.all,nor)
         then for k in mic.pts'range loop
                last := mic.pts(k);
                while not Is_Null(Tail_Of(last)) loop
                  last := Tail_Of(last);
                end loop;
                Deep_Concat_Diff(mic.pts(k),last,pts(k));
              end loop;
              Set_Head(tmp,mic);
              done := true;
         else tmp := Tail_Of(tmp);
        end if;
      end;
    end loop;
    if not done
     then declare
            mic : Mixed_Cell;
          begin
            mic.pts := new Array_of_Lists(pts'range);
            Copy(pts,mic.pts.all);
            mic.nor := new Float_Vectors.Vector'(nor);
            mic.sub := null;
            Append(mixsub,mixsub_last,mic);
          end;
    end if;
  end Update;

-- CONSTRUCTORS :

  procedure Copy ( mic1 : in Mixed_Cell; mic2 : in out Mixed_Cell ) is
  begin
    Deep_Clear(mic2);
    if mic1.nor /= null
     then mic2.nor := new Float_Vectors.Vector'(mic1.nor.all);
    end if;
    if mic1.pts /= null
     then mic2.pts := new Array_of_Lists(mic1.pts'range);
          Copy(mic1.pts.all,mic2.pts.all);
    end if;
    if mic1.sub /= null
     then mic2.sub := new Mixed_Subdivision;
          Copy(mic1.sub.all,mic2.sub.all);
    end if;
  end Copy;

  procedure Copy ( mixsub1 : in Mixed_Subdivision; 
                   mixsub2 : in out Mixed_Subdivision ) is

    tmp : Mixed_Subdivision := mixsub1;
    mixsub2_last : Mixed_Subdivision;

  begin
    Deep_Clear(mixsub2);
    while not Is_Null(tmp) loop
      declare
        mic1,mic2 : Mixed_Cell;
      begin
        mic1 := Head_Of(tmp);
        Copy(mic1,mic2);
        Append(mixsub2,mixsub2_last,mic2);
      end;
      tmp := Tail_Of(tmp);
    end loop;
  end Copy;

  procedure Append_Diff ( first,last : in out Mixed_Subdivision;
                          mic : in Mixed_Cell ) is
  begin
    if not Is_In(first,mic)
     then Append(first,last,mic);
    end if;
  end Append_Diff;

  procedure Concat_Diff ( first,last : in out Mixed_Subdivision;
                          mixsub : in Mixed_Subdivision ) is

    tmp : Mixed_Subdivision := mixsub;

  begin
    while not Is_Null(tmp) loop
      declare
        mic : Mixed_Cell := Head_Of(tmp);
      begin
        if not Is_In(first,mic)
         then Append_Diff(first,last,mic);
        end if;
      end;
      tmp := Tail_Of(tmp);
    end loop;
  end Concat_Diff;

  procedure Construct ( mixsub : in Mixed_Subdivision;
                        first : in out Mixed_Subdivision ) is

    tmp : Mixed_Subdivision := mixsub;

  begin
    while not Is_Null(tmp) loop
      declare
        mic : Mixed_Cell := Head_Of(tmp);
      begin
        Construct(mic,first);
      end;
      tmp := Tail_Of(tmp);
    end loop;
  end Construct;

  procedure Construct_Diff ( mixsub : in Mixed_Subdivision; 
                             first : in out Mixed_Subdivision ) is

    tmp : Mixed_Subdivision := mixsub;

  begin
    while not Is_Null(tmp) loop
      declare
        mic : Mixed_Cell := Head_Of(tmp);
      begin
        if not Is_In(first,mic)
         then Construct(mic,first);
        end if;
      end;
      tmp := Tail_Of(tmp);
    end loop;
  end Construct_Diff;

-- SELECTORS :

  function Is_Equal ( mic1,mic2 : Mixed_Cell ) return boolean is
  begin
    if not Equal(mic1.nor,mic2.nor)
     then return false;
     elsif Is_Equal(mic1.pts,mic2.pts)
         then return Is_Equal(mic1.sub,mic2.sub);
         else return false;
    end if;
  end Is_Equal;

  function Is_Sub ( mixsub1,mixsub2 : Mixed_Subdivision ) return boolean is

  -- DESCRIPTION :
  --   Returns true when every cell in mixsub1 also belongs to mixsub2.

    tmp : Mixed_Subdivision := mixsub1;

  begin
    while not Is_Null(tmp) loop
      if not Is_In(mixsub2,Head_Of(tmp))
       then return false;
       else tmp := Tail_Of(tmp);
      end if;
    end loop;
    return true;
  end Is_Sub;

  function Is_Equal ( mixsub1,mixsub2 : Mixed_Subdivision ) return boolean is
  begin
    if Is_Sub(mixsub1,mixsub2)
     then return Is_Sub(mixsub2,mixsub1);
     else return false;
    end if;
  end Is_Equal;

  function Is_Equal ( mixsub1,mixsub2 : Link_to_Mixed_Subdivision )
                    return boolean is
  begin
    if mixsub1 = null and then mixsub2 /= null
     then return false;
     elsif mixsub2 = null
         then return true;
         else return Is_Equal(mixsub1.all,mixsub2.all);
    end if;
  end Is_Equal;

  function Is_In ( mixsub : Mixed_Subdivision; normal : Vector )
                 return boolean is

    tmp : Mixed_Subdivision := mixsub;
    c : Mixed_Cell;

  begin
    while not Is_Null(tmp) loop
      c := Head_Of(tmp);
      if Equal(c.nor.all,normal)
       then return true;
      end if;
      tmp := Tail_Of(tmp);
    end loop;
    return false;
  end Is_In;

  function Is_In ( mixsub : Mixed_Subdivision; mic : Mixed_Cell )
                 return boolean is

    tmp : Mixed_Subdivision := mixsub;
    mic1 : Mixed_Cell;

  begin
    while not Is_Null(tmp) loop
      mic1 := Head_Of(tmp);
      if Is_Equal(mic1,mic)
       then return true;
       else tmp := Tail_Of(tmp);
      end if;
    end loop;
    return false;
  end Is_In;

-- DESTRUCTORS :

  procedure free is new unchecked_deallocation
      (Mixed_Subdivision,Link_to_Mixed_Subdivision);

  procedure Deep_Clear ( mic : in out Mixed_Cell ) is
  begin
    Clear(mic.nor); Deep_Clear(mic.pts); Deep_Clear(mic.sub);
  end Deep_Clear;

  procedure Shallow_Clear ( mic : in out Mixed_Cell ) is
  begin
    Clear(mic.nor); Shallow_Clear(mic.pts); Shallow_Clear(mic.sub);
  end Shallow_Clear;

  procedure Deep_Clear ( mixsub : in out Mixed_Subdivision ) is

    tmp : Mixed_Subdivision;

  begin
    tmp := mixsub;
    while not Is_Null(tmp) loop
      declare
	mic : Mixed_Cell := Head_Of(tmp);
      begin
	Deep_Clear(mic);
      end;
      tmp := Tail_Of(tmp);
    end loop;
    Shallow_Clear(mixsub);
  end Deep_Clear;

  procedure Deep_Clear ( mixsub : in out Link_to_Mixed_Subdivision ) is
  begin
    if mixsub /= null
     then Deep_Clear(mixsub.all);
          free(mixsub);
    end if;
  end Deep_Clear;

  procedure Shallow_Clear ( mixsub : in out Mixed_Subdivision ) is
  begin
    Lists_of_Mixed_Cells.Clear(Lists_of_Mixed_Cells.List(mixsub));
  end Shallow_Clear;

  procedure Shallow_Clear ( mixsub : in out Link_to_Mixed_Subdivision ) is
  begin
    if mixsub /= null
     then Shallow_Clear(mixsub.all);
          free(mixsub);
    end if;
  end Shallow_Clear;

end Float_Mixed_Subdivisions;
