File : lattice.ads

with Ints, Reps, Lin, Lin.Ops;
use Ints, Reps, Lin, Lin.Ops;
with Ada.Unchecked_Deallocation, QSort;

package Lattice is

  subtype IPoint is Ivec(1 .. 3);
  subtype RPoint is RVec(1 .. 3);
  type IPointVec is array(Integer range <>) of aliased IPoint;
  type IPointVecPtr is access all IPointVec;

  procedure Free is new Ada.Unchecked_Deallocation(IPointVec,IPointVecPtr);

  function Pt(I1,I2,I3: Integer) return IPoint;
  function Coord(L: IPoint) return RPoint;
  function RDist(L1,L2: IPoint) return Rep;
  function "*"(P,Q: IPoint) return Rep;
  procedure Translate(L: in IPoint; K: in out Int);
  procedure Translate(L: in IPoint; B: in out IntVec);

  subtype IMap is QMat(3);
  type IMapVec is array(Integer range <>) of aliased IMap;
  type IMapVecPtr is access all IMapVec;

  procedure Free is new Ada.Unchecked_Deallocation(IMapVec,IMapVecPtr);

  type Ball;
  type BallPtr is access all Ball;
  type Balls is array(Integer range <>) of BallPtr;
  subtype Nbors is Balls(1 .. 12);

  type Ball is
    record
      ID:  Integer;    -- identificatin number for movable balls
      M:   Integer;    -- mark
      IP:  IPoint;     -- lattice coordinates
      Nb:  Nbors;      -- pointers to neighboring balls
    end record;

  procedure CountNbors(B: in BallPtr; N,Nfix: out Integer);

  type Blob(Dim: Positive) is
    record
      L: Natural := 0;     -- number of elements stored in V
      M: Natural := 0;     -- additional info
      V: Balls(1 .. Dim);  -- pointers to balls
    end record;

  type Poly(Dim: Positive) is
    record
      L: Natural := 0;     -- number of elements stored in V
      M: Natural := 1;     -- multiplicity
      R: Rep := Zero;      -- some value
      V: IntVec(1 .. Dim); -- coordinates of balls
    end record;

  type PolyPtr is access all Poly;
  type Polys is array(Integer range <>) of PolyPtr;
  type PolysPtr is access all Polys;

  procedure Free is new Ada.Unchecked_Deallocation(Poly,PolyPtr);
  procedure FreeAll(B: in out PolysPtr);

  procedure ResetParam(B: in PolyPtr);
  procedure CopyParam(B: in Poly; C: in out Poly);
  procedure CopyParam(B,C: in PolyPtr);
  function NumMovable(B: PolyPtr) return Natural;
  function RDist(K: Int; B: PolyPtr) return Rep;
  procedure Translate(L: in IPoint; B: in Poly; C: out Poly);
  procedure Trim(B: in out PolysPtr; Size: in Natural);

  procedure SetDim(N1,N2,N3: in Positive);
  function Pack(L: IPoint) return Int;
  procedure Pack(L: in IPoint; L4: in Natural; K: out Int);
  function UnPack(K: Int) return IPoint;
  procedure UnPack(K: in Int; L: out IPoint; L4: out Natural);
  procedure Copy(B: in Blob; P: in out PolyPtr);
  procedure AddBallPlus(A: in Ball; B: in out PolyPtr);

  function ">"(A,B: PolyPtr) return Boolean;
  function IDiff(A,B: PolyPtr) return Integer;
  procedure SortPolyPtr is new QSort (Item => PolyPtr, ItemVec => Polys);
  procedure Find(P: in PolysPtr; B: in PolyPtr; Pos: out Integer; OK: out Boolean);

  type PExp is array(Integer range <>) of PolysPtr;
  type PExpPtr is access all PExp;

  procedure FreeAll(E: in out PExpPtr);

  pragma Inline (Pt,"*",CopyParam,Pack,UnPack);

private

  Dim1,Dim2,Dim3,LayerPeriod: Integer := 0;
  IZero: Int := 0;

  Fac1: constant Int := 2**10;
  Fac2: constant Int := 2**20;
  Fac3: constant Int := 2**30;
  Mask1: constant Int := Fac1-Int(1);
  Mask2: constant Int := Fac2-Int(1);
  Mask3: constant Int := Fac3-Int(1);

  procedure Free is new Ada.Unchecked_Deallocation(Ball,BallPtr);
  procedure Free is new Ada.Unchecked_Deallocation(Polys,PolysPtr);
  procedure Free is new Ada.Unchecked_Deallocation(PExp,PExpPtr);

  procedure AddSpace(N: in Positive; B: in out PolyPtr);
  procedure SortInt is new QSort (Item => Int, ItemVec => IntVec);

  function InPatch(L: IPoint) return Boolean;
  function FitsType(L: IPoint) return Boolean;
  function Check(I: Int) return Boolean;

  procedure GetR(B: in PolyPtr; P: in PolysPtr; R: out Rep);
  procedure PutR(B: in PolyPtr; P: in PolysPtr; R: in Rep);

  pragma Inline (InPatch,FitsType);

end Lattice;