{$DEFINE COMPRESS_TO_WORD}

(*+doc
La idea de esta unit es encapsular el empaquetado y desempaquetado de
variables desde un buffer.
-doc*)
unit ubuffrw;

interface
uses
  Classes, SysUtils, xMatDefs;

(*+doc
Esta clase es abstracta, y tiene dos descendientes TBuffReader y
TBuffWriter que debe usarse para leer o escribir de un buffer.
-doc*)
type
  TBuffAbstract= class
    pBuff: pByte; // puntero al inicio del buffer
    tamBuff: cardinal; // largo del buffer
    px: pByte; // puntero de lectura
    resto: cardinal; // lo que queda hasta el final
    constructor Create( pBuff: pointer; tamBuff: cardinal );
    procedure reset;
    procedure xCardinal( var x: cardinal );
    procedure xInteger( var x: integer );
    procedure xReal( var x: NReal );
    procedure xBloqueDeReales(var x : Pointer ; nValores : Cardinal);
    procedure xString( var x: string );virtual; abstract;
    procedure xTDAOfCardinal( var x : TDAofNCardinal);virtual; abstract;
    procedure xTDAOfNReal( var x : TDAOfNReal);virtual; abstract;
    procedure xCompressedTDAOfNReal( var x : TDAOfNReal);overload; virtual; abstract;
    procedure xStringList( var x: TStringList ); virtual; abstract;
    procedure xBytes( var x ; nBytes: cardinal ); virtual; abstract;
    procedure decResto( tamVar: cardinal );
  end;

(*+doc
Al crear un TBuffReader le pasamos un puntero desde el que leer y el número
de bytes máximos que puede leer.
Luego podemos usar las funciones xTipoVar para ir leyendo las variables.
Una llamada a reset posiciona de nuevo el puntero de lectura al inicio
del buffer. Si en cualquier momento intentamos leer más hallá del fin
del buffer se genera una excepción.
-doc*)
type
  TBuffReader= class( TBuffAbstract )
    public
      procedure xString( var x: string ); override;
      procedure xTDAOfCardinal( var x : TDAofNCardinal);override;
      procedure xTDAOfNReal( var x : TDAOfNReal);override;
      procedure xCompressedTDAOfNReal( var x : TDAOfNReal); override;
      procedure xCompressedTDAOfNReal( const x : TDAOfNReal; inicio: Integer); overload;
      procedure xStringList( var x: TStringList ); override;
      procedure xBytes( var x ; nBytes: cardinal ); override;
  end;

(*+doc
Al crear un TBuffWriter le pasamos el tamaño del buffer.
Luego podemos usar las funciones xTipoVar para ir escribiendo las variables.
Una llamada a reset posiciona de nuevo el puntero de escritura al inicio
del buffer. Si en cualquier momento intentamos escribir más hallá del fin
del buffer se genera una excepción.
Al llamar el Free se libera la memoria solicitada para el buffer.
-doc*)
  TBuffWriter= class( TBuffAbstract )
    procedure xString( var x: string ); override;
    procedure xTDAOfCardinal( var x : TDAofNCardinal);override;
    procedure xTDAOfNReal( var x : TDAOfNReal);override;
    procedure xCompressedTDAOfNReal( var x : TDAOfNReal); override;
    procedure xCompressedTDAOfNReal( const x : TDAOfNReal; inicio, fin: Integer); overload;
    procedure xStringList( var x: TStringList ); override;
    procedure xBytes( var x ; nBytes: cardinal ); override;
    constructor Create( tamBuff: cardinal );
    procedure Free;
  end;

//Comprime el arreglo x en la dirección apuntada por pBuff
//pBuff debe tener espacio asignado de tamaño xCompressedSizeOf(x) y para usar en
//un xBytes se debe utilizar pBuff^
procedure compressTDAOfNReal(const x : TDAOfNReal; const pBuff: PByte);

(*+doc
Funciones auxiliares para determinar el tamaño del buffer necesario
para escriura.
-doc*)
function xSizeOf( x: cardinal ): cardinal; overload;
function xSizeOf( x: integer ): cardinal; overload;
function xSizeOf( x: NReal ): cardinal; overload;
function xSizeOf( x: string ): cardinal; overload;
function xSizeOf( x: TDAofNCardinal ): cardinal; overload;
function xSizeOf( x: TDAOfNReal ): cardinal; overload;
function xCompressedSizeOf( x: TDAOfNReal ): cardinal; overload;
function xCompressedSizeOf( x: TDAOfNReal; inicio, fin: Integer ): cardinal; overload;
function xSizeOf( x: TStringList ): cardinal; overload;

procedure writeBytes(pBuff: PByte; NBytes: Cardinal);

procedure test;

implementation

function xSizeOf( x: cardinal ): cardinal;
begin
  result:= sizeOf( cardinal );
end;

function xSizeOf( x: integer ): cardinal;
begin
  result:= sizeOf( integer );
end;

function xSizeOf( x: NReal ): cardinal; overload;
begin
  result:= SizeOf(NReal);
end;

function xSizeOf( x: string ): cardinal;
begin
  result:= sizeOf( cardinal )+ length( x );
end;

function xSizeOf( x: TDAofNCardinal ): cardinal; overload;
begin
  result:= sizeOf( Cardinal ) + SizeOf(Cardinal) * length( x );
end;

function xSizeOf( x: TDAOfNReal ): cardinal; overload;
begin
  result:= sizeOf( cardinal )+ SizeOf(NReal) * length( x );
end;

function xCompressedSizeOf( x: TDAOfNReal ): cardinal;
begin
  //min y max, n y el arreglo
{$IFDEF COMPRESS_TO_WORD}
  result:= 2 * SizeOf(NReal) + SizeOf(Cardinal) + sizeof(Word) * length(x);
{$ELSE}
  result:= 2 * SizeOf(NReal) + SizeOf(Cardinal) + length(x);
{$ENDIF}
end;

function xCompressedSizeOf(x: TDAOfNReal; inicio, fin: Integer ): cardinal;
begin
  //min y max, n y el arreglo
{$IFDEF COMPRESS_TO_WORD}
  result:= 2 * SizeOf(NReal) + SizeOf(Cardinal) + sizeof(Word) * (fin - inicio + 1);
{$ELSE}
  result:= 2 * SizeOf(NReal) + SizeOf(Cardinal) + (fin - inicio + 1);
{$ENDIF}
end;

function xSizeOf( x: TStringList ): cardinal;
var
  res: cardinal;
  I: integer;
begin
  res:= sizeOf( cardinal ); // count
  for I := 0 to x.Count - 1 do
    res:= res + xSizeOf( x[I] );
  result:= res;
end;

constructor TBuffAbstract.Create( pBuff: pointer; tamBuff: cardinal );
begin
  inherited Create;
  self.pBuff:= pBuff;
  px:= pBuff;
  self.tamBuff:= tamBuff;
  resto:= tamBuff;
end;

procedure TBuffAbstract.reset;
begin
  px:= pBuff;
  resto:= tamBuff;
end;

procedure TBuffAbstract.decResto( tamVar: cardinal );
begin
  if resto < tamVar then
  begin
    raise Exception.Create(self.ClassName + '.decResto: Intentó acceder fuera del buffer! tamVar: ' + IntToStr(tamVar) + ', resto: ' + IntToStr(resto) );
  end
  else
    resto:= resto - tamVar;
end;

procedure TBuffAbstract.xCardinal( var x: cardinal );
begin
  xBytes( x, sizeOf( cardinal ));
end;

procedure TBuffAbstract.xInteger( var x: integer );
begin
  xBytes( x, sizeOf( integer ));
end;

procedure TBuffAbstract.xReal( var x: NReal );
begin
  xBytes( x, SizeOf(NReal));
end;

procedure TBuffAbstract.xBloqueDeReales(var x : Pointer ; nValores : Cardinal);
begin
  xBytes( x, nValores * SizeOf(NReal));
end;

(************ Métodos de TBuffReader ***************)

procedure TBuffReader.xBytes( var x ; nBytes: cardinal );
begin
  decResto( nBytes );
  move( px^, x, nBytes );
  inc( px, nBytes);
end;

procedure TBuffReader.xString( var x: string );
var
  n: cardinal;
begin
  xCardinal( n );
  setlength( x, n );
  xBytes( x[1], n );
end;

procedure TBuffReader.xTDAOfCardinal( var x: TDAofNCardinal );
var
  n: cardinal;
begin
  xCardinal( n );
  setlength( x, n );
  if n <> 0 then
    xBytes( x[0], n * SizeOf(Cardinal));
end;

procedure TBuffReader.xTDAOfNReal( var x: TDaOfNReal );
var
  n: cardinal;
begin
  xCardinal( n );
  setlength( x, n );
  if n <> 0 then
    xBytes( x[0], n * SizeOf(NReal));
end;

procedure TBuffReader.xCompressedTDAOfNReal( var x : TDAOfNReal);
var
  i: Integer;
  min, max, mult: NReal;
  n: Cardinal;
{$IFDEF COMPRESS_TO_WORD}
  pxw: PWord;
{$ENDIF}
begin
  xReal(min);
  xReal(max);
  xCardinal(n);
  SetLength(x, n);
{$IFDEF COMPRESS_TO_WORD}
  mult:= (max - min) / 65535;
  decResto(n * SizeOf(word));
  pxw:= PWord(px);
  for i:= 0 to n - 1 do
  begin
    x[i]:= min + pxw^ * mult;
    inc(pxw);
  end;
  inc(px, n * SizeOf(word));
{$ELSE}
  mult:= (max - min) / 255;
  decResto(n);
  for i:= 0 to n - 1 do
  begin
    x[i]:= min + px^ * mult;
    inc(px);
  end;
{$ENDIF}
end;

procedure TBuffReader.xCompressedTDAOfNReal( const x : TDAOfNReal; inicio: Integer);
var
  i: Integer;
  min, max, mult: NReal;
  n: Cardinal;
{$IFDEF COMPRESS_TO_WORD}
  pxw: PWord;
{$ENDIF}
begin
  xReal(min);
  xReal(max);
  xCardinal(n);
{$IFDEF COMPRESS_TO_WORD}
  mult:= (max - min) / 65535;
  decResto(n * SizeOf(word));
  pxw:= PWord(px);
  for i:= inicio to inicio + (n - 1) do
  begin
    x[i]:= min + pxw^ * mult;
    inc(pxw);
  end;
  inc(px, n * SizeOf(word));
{$ELSE}
  mult:= (max - min) / 255;
  decResto(n);
  for i:= inicio to inicio + (n - 1) do
  begin
    x[i]:= min + px^ * mult;
    inc(px);
  end;
{$ENDIF}
end;

procedure TBuffReader.xStringList( var x: TStringList );
var
  lst: TStringList;
  n: integer;
  r: string;
  k: integer;
begin
  xInteger( n ); // obtengo la cantidad de elementos
  lst:= TStringList.Create;
  lst.Capacity:= n;
  for k := 0 to n - 1 do
  begin
    xString( r );
    lst.Add( r );
  end;
  x:= lst;
end;

(************ Métodos de TBuffWriter ***************)

constructor TBuffWriter.Create( tamBuff: cardinal );
begin
  inherited Create( nil, tamBuff );
  getmem( pBuff, tamBuff );
  px:= pBuff;
end;

procedure TBuffWriter.xBytes( var x ; nBytes: cardinal );
begin
  decResto( nBytes );
  move( x, px^, nBytes );
  inc( px, nBytes);
end;

procedure TBuffWriter.xString( var x: string );
var
  n: cardinal;
begin
  n:= length( x );
  xCardinal( n );
  xBytes( x[1], n );
end;

procedure TBuffWriter.xTDAOfCardinal( var x: TDAofNCardinal );
var
  n: cardinal;
begin
  n:= length( x );
  xCardinal( n );
  if n <> 0 then
    xBytes( x[0], n * SizeOf(Cardinal) );
end;

procedure TBuffWriter.xTDAOfNReal( var x: TDaOfNReal );
var
  n: cardinal;
begin
  n:= length( x );
  xCardinal( n );
  if n <> 0 then
    xBytes( x[0], n * SizeOf(NReal));
end;

procedure TBuffWriter.xCompressedTDAOfNReal( var x : TDAOfNReal);
var
  i: Integer;
  min, max, mult: NReal;
  n: Cardinal;
{$IFDEF COMPRESS_TO_WORD}
  pxw: PWord;
{$ENDIF}
begin
  min:= x[0];
  max:= x[0];
  for i:= 1 to high(x) do
  begin
    if x[i] < min then
      min:= x[i]
    else if x[i] > max then
      max:= x[i];
  end;
  xReal(min);
  xReal(max);
  n:= length(x);
  xCardinal(n);
{$IFDEF COMPRESS_TO_WORD}
  decResto(SizeOf(word) * n);
  if (max - min) > 1E-12 then
  begin
    mult:= 65535 / (max - min);
    pxw:= PWord(px);
    for i:= 0 to high(x) do
    begin
      pxw^:= trunc(((x[i] - min) * mult));
      inc(pxw);
    end;
  end
  else
  begin
    FillChar(px^, sizeOf(word) * n, 0);
  end;
  inc(px, SizeOf(word) * n);
{$ELSE}
  decResto(n);
  if (max - min) > 1E-12 then
  begin
    mult:= 255 / (max - min);
    for i:= 0 to high(x) do
    begin
      px^:= trunc(((x[i] - min) * mult));
      inc(px);
    end;
  end
  else
  begin
    FillChar(px^, n, 0);
    inc(px, n);
  end;
{$ENDIF}
end;

procedure TBuffWriter.xCompressedTDAOfNReal( const x : TDAOfNReal; inicio, fin: Integer);
var
  i: Integer;
  min, max, mult: NReal;
  n: Cardinal;
{$IFDEF COMPRESS_TO_WORD}
  pxw: PWord;
{$ENDIF}
begin
  min:= x[inicio];
  max:= x[inicio];
  for i:= inicio + 1 to fin do
  begin
    if x[i] < min then
      min:= x[i]
    else if x[i] > max then
      max:= x[i];
  end;
  xReal(min);
  xReal(max);
  n:= fin - inicio + 1;
  xCardinal(n);
{$IFDEF COMPRESS_TO_WORD}
  decResto(SizeOf(word) * n);
  if (max - min) > 1E-12 then
  begin
    mult:= 65535 / (max - min);
    pxw:= PWord(px);
    for i:= inicio to fin do
    begin
      pxw^:= trunc(((x[i] - min) * mult));
      inc(pxw);
    end;
  end
  else
  begin
    FillChar(px^, sizeOf(word) * n, 0);
  end;
  inc(px, SizeOf(word) * n);
{$ELSE}
  decResto(n);
  if (max - min) > 1E-12 then
  begin
    mult:= 255 / (max - min);
    for i:= inicio to fin do
    begin
      px^:= trunc(((x[i] - min) * mult));
      inc(px);
    end;
  end
  else
  begin
    FillChar(px^, n, 0);
    inc(px, n);
  end;
{$ENDIF}
end;

procedure TBuffWriter.xStringList( var x: TStringList );
var
  n: integer;
  r: string;
  k: integer;
begin
  n:= x.Count;
  xInteger( n ); // Guardo la cantidad de elementos
  for k := 0 to n - 1 do
  begin
    r:= x[k];
    xString( r );
  end;
end;

procedure TBuffWriter.Free;
begin
  if pBuff <> nil then
    FreeMem( pBuff, tamBuff );
  inherited Free;
end;

procedure compressTDAOfNReal(const x : TDAOfNReal; const pBuff: PByte);
var
  i: Integer;
  min, max, mult: NReal;
  n: Cardinal;
  px: PByte;
{$IFDEF COMPRESS_TO_WORD}
  pxw: PWord;
{$ENDIF}
begin
  min:= x[0];
  max:= x[0];
  for i:= 1 to high(x) do
  begin
    if x[i] < min then
      min:= x[i]
    else if x[i] > max then
      max:= x[i];
  end;
  px:= pBuff;

  move( min, px^, xSizeOf(min) );
  inc(px, xSizeOf(min));

  move( max, px^, xSizeOf(max) );
  inc(px, xSizeOf(max));

  n:= length(x);
  move( n, px^, xSizeOf(n) );
  inc(px, xSizeOf(n));

{$IFDEF COMPRESS_TO_WORD}
  if (max - min) > 1E-12 then
  begin
    mult:= 65535 / (max - min);
    pxw:= PWord(px);
    for i:= 0 to high(x) do
    begin
      pxw^:= trunc(((x[i] - min) * mult));
      inc(pxw);
    end;
  end
  else
  begin
    FillChar(px^, sizeOf(word) * n, 0);
  end;
{$ELSE}
  if (max - min) > 1E-12 then
  begin
    mult:= 255 / (max - min);
    for i:= 0 to high(x) do
    begin
      px^:= trunc(((x[i] - min) * mult));
      inc(px);
    end;
  end
  else
  begin
    FillChar(px^, n, 0);
  end;
{$ENDIF}
end;

procedure writeBytes(pBuff: PByte; NBytes: Cardinal);
var
  i: Integer;
  px: PByte;
begin
  px:= pBuff;
  for i:= 0 to NBytes - 1 do
  begin
    write(px^, ',');
    inc(px);
  end;
  writeln(px^);
end;

procedure test;
const
  arraySize = 100;
var
  writer: TBuffWriter;
  reader: TBuffReader;
  i: Integer;
  arreglo, arregloComp: TDAofNReal;
  tIni: TDateTime;
  errCuadrado: NReal;

  pBuff: PByte;
  tamBuffComprimido: Cardinal;
begin
  SetLength(arreglo, arraySize);
  for i:= 0 to arraySize - 1 do
    if random(1) = 0 then
      arreglo[i]:= random * 1000
    else
      arreglo[i]:= - random * 1000;
  writeln('Arreglo, tam= ', xSizeOf(arreglo), ' bytes');
  for i:= 0 to arraySize - 2 do
    write(arreglo[i]:3:2, ', ');
  writeln(arreglo[arraySize-1]:3:2);

  tIni:= now;
  writer:= TBuffWriter.Create(xCompressedSizeOf(arreglo));
  writer.xCompressedTDAOfNReal(arreglo);
  reader:= TBuffReader.Create(writer.pBuff, xCompressedSizeOf(arreglo));
  reader.xCompressedTDAOfNReal(arregloComp);
  Writeln('TiempoComp: ', FloatToStrF((now - tIni) * 24 * 3600, ffFixed, 10, 3));
  writer.Free;
  reader.Free;

  writeln('ArregloComp, tam= ', xCompressedSizeOf(arreglo), ' bytes');
  for i:= 0 to arraySize - 2 do
    write(arregloComp[i]:3:2, ', ');
  writeln(arregloComp[arraySize-1]:3:2);

  errCuadrado:= 0;
  for i:= 0 to arraySize - 1 do
    errCuadrado:= errCuadrado + sqr(arreglo[i] - arregloComp[i]);
  errCuadrado:= Sqr(errCuadrado);
  Writeln('errCuadrado: ', FloatToStrF(errCuadrado, ffFixed, 10, 3));
  vclear(arregloComp);

  tamBuffComprimido:= xCompressedSizeOf(arreglo);
  GetMem(pBuff, tamBuffComprimido);
  compressTDAOfNReal(arreglo, pBuff);

  writeln('pBuff= ');
  writeBytes(pBuff, tamBuffComprimido);

  writer:= TBuffWriter.Create(tamBuffComprimido);
  writer.xBytes(pBuff^, tamBuffComprimido);
  writeln('writer.pBuff= ');
  writeBytes(writer.pBuff, tamBuffComprimido);

  reader:= TBuffReader.Create(writer.pBuff, tamBuffComprimido);
  reader.xCompressedTDAOfNReal(arregloComp);
  writeln('ArregloComp2, tam= ', tamBuffComprimido, ' bytes');
  for i:= 0 to arraySize - 2 do
    write(arregloComp[i]:3:2, ', ');
  writeln(arregloComp[arraySize-1]:3:2);
  reader.Free;
  writer.Free;
  FreeMem(pBuff, tamBuffComprimido);
end;

end.
