File : lattice-io.adb

package body Lattice.IO is

  package Txt_Mod_IO is new Ada.Text_IO.Modular_IO(Int);
  package Txt_Int_IO is new Ada.Text_IO.Integer_IO(Integer);
  use Txt_Mod_IO, Txt_Int_IO;

  function MP(I: Integer) return String is
    S: String := I'Img;
  begin
    if I >= 0 then S(1) := '+'; end if;
    return S;
  end MP;

  function MyImg(V: IntVec; Size: Positive) return String is
    P: constant IPoint := UnPack(V(Size));
    S: constant String := MP(P(1)) & MP(P(2)) & MP(P(3));
  begin
    if Size=1 then
      return S;
    else
      return MyImg(V,Size-1) & ':' & S;
    end if;
  end MyImg;

  function MyImg(B: PolyPtr) return String is
    L: constant Natural := NumMovable(B);
  begin
    if LayerPeriod=2 then
      return "HCP" & MyImg(L) & ':' & MyImg(B.V,L);
    elsif LayerPeriod=3 then
      return "FCC" & MyImg(L) & ':' & MyImg(B.V,L);
    end if;
    return "foo";
  end MyImg;

  procedure ShowPts(B: in Balls; BLast: in Natural := 99; NewLine: in Boolean := True) is
  begin
    for K in B'First .. Integer'Min(B'Last,BLast) loop
      if K>B'First then Put(" "); end if;
      Show(B(K).IP,False);
    end loop;
    if NewLine then New_Line; end if;
  end ShowPts;

  procedure Show(B: in Blob; BLast: in Integer := 99) is
  begin
    ShowPts(B.V,Integer'Min(B.L,BLast));
  end Show;

  procedure ShowPts(B: in IntVec; BLast: in Integer := 99; NewLine: in Boolean := True) is
  begin
    for K in B'First .. Integer'Min(B'Last,BLast) loop
      if K>B'First then Put(" "); end if;
      Show(UnPack(B(K)),False);
    end loop;
    if NewLine then New_Line; end if;
  end ShowPts;

  procedure Show(B: in PolyPtr; BLast: in Integer := 99) is
  begin
    Put(MyImg(B.M) & "  ");
    ShowPts(B.V,Integer'Min(B.L,BLast),False);
    if B.R /= Zero then
      Put("  V:");
      Txt_Put(Current_Output,B.R);
    end if;
    New_Line;
  end Show;

  procedure Show(P: in PolysPtr; PLast,BLast: in Integer) is
  begin
    for N in P'First .. Integer'Min(P'Last,Plast) loop
      Show(P(N),BLast);
    end loop;
  end Show;

  procedure Put(F: in File_Type; B: in PolyPtr) is
    P: IPoint;
  begin
    Put(F,LayerPeriod);
    New_Line(F);
    Put(F,B.L);
    New_Line(F);
    for K in 1 .. B.L loop
      P := UnPack(B.V(K));
      Put(F,P(1));
      Put(F,P(2));
      Put(F,P(3));
      New_Line(F);
    end loop;
    Put(F,B.M);
    New_Line(F);
    Txt_Put(F,B.R);
    New_Line(F);
  end Put;

  procedure Write(Name: in String; B: in PolyPtr) is
    F: File_Type;
  begin
    Put_Line("writing " & Name);
    Create(F,Out_File,Name);
    Put(F,B);
    Close(F);
  end Write;

  procedure Write(Name: in String; P: in PolysPtr) is
    F: File_Type;
  begin
    Put_Line("writing " & Name);
    Create(F,Out_File,Name);
    Put(F,P'Last-P'First+1);
    New_Line(F);
    for N in P'Range loop
      Put(F,P(N));
    end loop;
    Close(F);
  end Write;

  procedure Get(F: in File_Type; B: in out PolyPtr; LP: out Positive) is
    L: Integer;
    P: IPoint;
  begin
    if B /= null then Free(B); end if;
    Get(F,LP);
    Get(F,L);
    B := new Poly(L);
    B.L := L;
    for K in 1 .. B.L loop
      Get(F,P(1));
      Get(F,P(2));
      Get(F,P(3));
      Pack(P,1,B.V(K));
    end loop;
    Get(F,B.M);
    Txt_Get(F,B.R);
  end Get;

  procedure Read(Name: in String; B: in out PolyPtr; LP: out Positive) is
    F: File_Type;
  begin
    Put_Line("Reading " & Name);
    Open(F,In_File,Name);
    Get(F,B,LP);
    Close(F);
  end Read;

  procedure Read(Name: in String; P: in out PolysPtr; LP: out Positive) is
    L,LPn: Integer;
    F: File_Type;
  begin
    Put_Line("Reading " & Name);
    if P /= null then FreeAll(P); end if;
    Open(F,In_File,Name);
    Get(F,L);
    P := new Polys(1 .. L);
    Get(F,P(1),LP);
    for N in 2 .. L loop
      Get(F,P(N),LPn);
      if LPn /= LP then raise Constraint_Error; end if;
    end loop;
    Close(F);
  end Read;

  procedure AdaPut(F: in File_Type; B: in PolyPtr) is
  begin
    Put_Line(F,"  New_Polymer(" & MyImg(LayerPeriod) & ");");
    for K in 1 .. B.L loop
      Put(F,"  Add_Ball");
      Put(F,UnPack(B.V(K)));
      Put_Line(F,";");
    end loop;
    Put_Line(F,"  Add_Multiplicity(" & MyImg(B.M) & ");");
    Put(F,"  Add_Value(");
    Txt_Put(F,B.R);
    Put_Line(F,");");
  end AdaPut;

  procedure AdaWrite(Name: in String; B: in PolyPtr) is
    F: File_Type;
  begin
    Put_Line("writing " & Name);
    Create(F,Out_File,Name);
    AdaPut(F,B);
    Close(F);
  end AdaWrite;

  procedure AdaWrite(Name: in String; P: in PolysPtr) is
    F: File_Type;
  begin
    Put_Line("writing " & Name);
    Create(F,Out_File,Name);
    for K in P'Range loop
      AdaPut(F,P(K));
    end loop;
    Close(F);
  end AdaWrite;

end Lattice.IO;