unit uBasculaParser;

interface

uses
  System.SysUtils, System.Classes, System.Math, System.Character;

type
  TProtocoloBascula = (
    pbAuto,           // Detección automática de números, signo y estabilidad
    pbContinuoCRLF,   // Tramas estándar delimitadas por CR/LF (Gram, Baxtran, Dibal, etc.)
    pbAgrigestModo0,  // Modo Agrigest 0 (continuo = xx.xx)
    pbAgrigestModo1,  // Modo Agrigest 1 (prefijo '=')
    pbAgrigestModo2,  // Modo Agrigest 2 (inicia con STX #2)
    pbAgrigestModo3,  // Modo Agrigest 3 (extracción dígitos y comas)
    pbAgrigestModo4   // Modo Agrigest 4 (filtro 10 caracteres)
  );

  TPesoEvent = procedure(Sender: TObject; PesoNeto, PesoBruto, Tara: Double;
    Estable: Boolean; const Unidad: string; const TramaOriginal: string) of object;
  TRawDataEvent = procedure(Sender: TObject; const RawStr, RawHex: string) of object;

  TBasculaParser = class
  private
    FProtocolo: TProtocoloBascula;
    FTaraManual: Double;
    FUltimoPesoBruto: Double;
    FUltimoPesoNeto: Double;
    FEstable: Boolean;
    FUnidad: string;
    FDecimales: Integer;
    FBuffer: string;

    // Control de estabilidad por ventana temporal
    FHistorialPesos: array of Double;
    FHistorialTiempos: array of TDateTime;
    FHistorialCount: Integer;

    FOnPeso: TPesoEvent;
    FOnRawData: TRawDataEvent;

    function StringToHex(const S: string): string;
    function ExtraerNumeroGenerico(const S: string; out APeso: Double; out AEstable: Boolean; out AUnidad: string): Boolean;
    procedure ProcesarLinea(const Linea: string);
    function ComprobarEstabilidadVentana(NuevoPeso: Double): Boolean;
  public
    constructor Create;
    procedure Reset;
    procedure FeedData(const Data: string);

    procedure HacerTara;
    procedure BorrarTara;
    procedure PonerCero;

    property Protocolo: TProtocoloBascula read FProtocolo write FProtocolo;
    property TaraManual: Double read FTaraManual write FTaraManual;
    property UltimoPesoBruto: Double read FUltimoPesoBruto;
    property UltimoPesoNeto: Double read FUltimoPesoNeto;
    property Estable: Boolean read FEstable;
    property Unidad: string read FUnidad write FUnidad;
    property Decimales: Integer read FDecimales write FDecimales;

    property OnPeso: TPesoEvent read FOnPeso write FOnPeso;
    property OnRawData: TRawDataEvent read FOnRawData write FOnRawData;
  end;

implementation

{ TBasculaParser }

constructor TBasculaParser.Create;
begin
  inherited Create;
  FProtocolo := pbAuto;
  FTaraManual := 0.0;
  FUltimoPesoBruto := 0.0;
  FUltimoPesoNeto := 0.0;
  FEstable := False;
  FUnidad := 'kg';
  FDecimales := 3;
  FBuffer := '';
  SetLength(FHistorialPesos, 10);
  SetLength(FHistorialTiempos, 10);
  FHistorialCount := 0;
end;

procedure TBasculaParser.Reset;
begin
  FBuffer := '';
  FUltimoPesoBruto := 0.0;
  FUltimoPesoNeto := 0.0;
  FEstable := False;
  FHistorialCount := 0;
end;

function TBasculaParser.StringToHex(const S: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(S) do
  begin
    Result := Result + IntToHex(Ord(S[I]), 2) + ' ';
  end;
  Result := Trim(Result);
end;

procedure TBasculaParser.HacerTara;
begin
  FTaraManual := FUltimoPesoBruto;
  FUltimoPesoNeto := FUltimoPesoBruto - FTaraManual;
  if Assigned(FOnPeso) then
    FOnPeso(Self, FUltimoPesoNeto, FUltimoPesoBruto, FTaraManual, FEstable, FUnidad, 'TARA MANUAL');
end;

procedure TBasculaParser.BorrarTara;
begin
  FTaraManual := 0.0;
  FUltimoPesoNeto := FUltimoPesoBruto;
  if Assigned(FOnPeso) then
    FOnPeso(Self, FUltimoPesoNeto, FUltimoPesoBruto, FTaraManual, FEstable, FUnidad, 'TARA BORRADA');
end;

procedure TBasculaParser.PonerCero;
begin
  FTaraManual := 0.0;
  FUltimoPesoBruto := 0.0;
  FUltimoPesoNeto := 0.0;
  FEstable := True;
  if Assigned(FOnPeso) then
    FOnPeso(Self, 0.0, 0.0, 0.0, True, FUnidad, 'PUESTA A CERO');
end;

function TBasculaParser.ComprobarEstabilidadVentana(NuevoPeso: Double): Boolean;
var
  I: Integer;
  MaxP, MinP: Double;
  Tol: Double;
begin
  Tol := Power(10, -FDecimales); // e.g. 0.001
  if Tol < 0.001 then
    Tol := 0.001;

  // Desplazar historial
  if FHistorialCount < Length(FHistorialPesos) then
    Inc(FHistorialCount);

  for I := Length(FHistorialPesos) - 1 downto 1 do
  begin
    FHistorialPesos[I] := FHistorialPesos[I - 1];
    FHistorialTiempos[I] := FHistorialTiempos[I - 1];
  end;
  FHistorialPesos[0] := NuevoPeso;
  FHistorialTiempos[0] := Now;

  if FHistorialCount < 4 then
    Exit(False);

  MaxP := FHistorialPesos[0];
  MinP := FHistorialPesos[0];
  for I := 1 to 3 do
  begin
    if FHistorialPesos[I] > MaxP then MaxP := FHistorialPesos[I];
    if FHistorialPesos[I] < MinP then MinP := FHistorialPesos[I];
  end;

  Result := (MaxP - MinP) <= (Tol * 2);
end;

function TBasculaParser.ExtraerNumeroGenerico(const S: string; out APeso: Double; out AEstable: Boolean; out AUnidad: string): Boolean;
var
  I: Integer;
  EnNumero: Boolean;
  StrNum: string;
  Signo: Double;
  ValParse: Double;
  UpperS: string;
  FS: TFormatSettings;
begin
  Result := False;
  APeso := 0.0;
  AEstable := False;
  AUnidad := FUnidad;

  UpperS := UpperCase(S);

  // Detección de estabilidad por bandera del protocolo
  if (Pos('ST', UpperS) > 0) or (Pos('S,', UpperS) > 0) or (Pos('OK', UpperS) > 0) or (Pos('ESTABLE', UpperS) > 0) then
    AEstable := True
  else if (Pos('US', UpperS) > 0) or (Pos('U,', UpperS) > 0) or (Pos('MOV', UpperS) > 0) or (Pos('DYN', UpperS) > 0) then
    AEstable := False
  else
    AEstable := False; // Se completará con ComprobarEstabilidadVentana

  // Detectar unidad
  if Pos('KG', UpperS) > 0 then AUnidad := 'kg'
  else if Pos('G', UpperS) > 0 then AUnidad := 'g'
  else if Pos('LB', UpperS) > 0 then AUnidad := 'lb';

  // Buscar bloque numérico con signo y separador decimal
  Signo := 1.0;
  StrNum := '';
  EnNumero := False;

  for I := 1 to Length(S) do
  begin
    if (S[I] = '-') and (not EnNumero) then
    begin
      Signo := -1.0;
    end
    else if (S[I] = '+') and (not EnNumero) then
    begin
      Signo := 1.0;
    end
    else if CharInSet(S[I], ['0'..'9', '.', ',']) then
    begin
      EnNumero := True;
      if S[I] = ',' then
        StrNum := StrNum + '.'
      else
        StrNum := StrNum + S[I];
    end
    else if EnNumero then
    begin
      // Terminar bloque numérico si ya encontramos dígitos
      Break;
    end;
  end;

  if StrNum <> '' then
  begin
    FS := TFormatSettings.Create('en-US');
    FS.DecimalSeparator := '.';
    if TryStrToFloat(StrNum, ValParse, FS) then
    begin
      APeso := ValParse * Signo;
      Result := True;
    end;
  end;
end;

procedure TBasculaParser.ProcesarLinea(const Linea: string);
var
  S, Cadena: string;
  PesoLeido: Double;
  EstableFlag: Boolean;
  DetUnidad: string;
  X: Integer;
begin
  if Trim(Linea) = '' then
    Exit;

  PesoLeido := 0.0;
  EstableFlag := False;
  DetUnidad := FUnidad;

  case FProtocolo of
    pbAuto, pbContinuoCRLF:
    begin
      if ExtraerNumeroGenerico(Linea, PesoLeido, EstableFlag, DetUnidad) then
      begin
        if not EstableFlag then
          EstableFlag := ComprobarEstabilidadVentana(PesoLeido);
      end
      else
        Exit;
    end;

    pbAgrigestModo0:
    begin
      S := StringReplace(Linea, '.', ',', [rfReplaceAll, rfIgnoreCase]);
      S := StringReplace(S, '= ', '', [rfReplaceAll, rfIgnoreCase]);
      if Length(S) >= 7 then
        Delete(S, 8, Length(S) - 7);
      Cadena := Trim(S);
      if TryStrToFloat(Cadena, PesoLeido) then
      begin
        PesoLeido := PesoLeido * 100;
        EstableFlag := ComprobarEstabilidadVentana(PesoLeido);
      end
      else
        Exit;
    end;

    pbAgrigestModo1:
    begin
      S := StringReplace(Linea, '.', ',', [rfReplaceAll, rfIgnoreCase]);
      S := StringReplace(S, '= ', '', [rfReplaceAll, rfIgnoreCase]);
      if Length(S) >= 7 then
        Delete(S, 8, Length(S) - 7);
      Cadena := Trim(S);
      if TryStrToFloat(Cadena, PesoLeido) then
        EstableFlag := ComprobarEstabilidadVentana(PesoLeido)
      else
        Exit;
    end;

    pbAgrigestModo2:
    begin
      S := StringReplace(Linea, '.', ',', [rfReplaceAll, rfIgnoreCase]);
      S := StringReplace(S, '=', '', [rfReplaceAll, rfIgnoreCase]);
      S := StringReplace(S, '+', '', [rfReplaceAll, rfIgnoreCase]);
      if (Length(S) >= 10) and (S[1] = #2) then
      begin
        Cadena := Copy(S, 6, 5);
        if TryStrToFloat(Cadena, PesoLeido) then
          EstableFlag := ComprobarEstabilidadVentana(PesoLeido)
        else
          Exit;
      end
      else
        Exit;
    end;

    pbAgrigestModo3:
    begin
      S := StringReplace(Linea, '.', ',', [rfReplaceAll, rfIgnoreCase]);
      Cadena := '';
      for X := 1 to Min(Length(S), 12) do
      begin
        if CharInSet(S[X], ['0'..'9', ',']) then
          Cadena := Cadena + S[X];
      end;
      if TryStrToFloat(Cadena, PesoLeido) then
        EstableFlag := ComprobarEstabilidadVentana(PesoLeido)
      else
        Exit;
    end;

    pbAgrigestModo4:
    begin
      S := StringReplace(Linea, '.', ',', [rfReplaceAll, rfIgnoreCase]);
      Cadena := '';
      for X := 1 to Min(Length(S), 9) do
      begin
        if CharInSet(S[X], ['0'..'9', ',']) then
          Cadena := Cadena + S[X];
      end;
      if TryStrToFloat(Cadena, PesoLeido) then
        EstableFlag := ComprobarEstabilidadVentana(PesoLeido)
      else
        Exit;
    end;
  end;

  FUltimoPesoBruto := PesoLeido;
  FUltimoPesoNeto := FUltimoPesoBruto - FTaraManual;
  FEstable := EstableFlag;
  FUnidad := DetUnidad;

  if Assigned(FOnPeso) then
    FOnPeso(Self, FUltimoPesoNeto, FUltimoPesoBruto, FTaraManual, FEstable, FUnidad, Linea);
end;

procedure TBasculaParser.FeedData(const Data: string);
var
  IdxCR, IdxLF, PosDelim: Integer;
  Linea: string;
begin
  if Data = '' then
    Exit;

  // Notificar datos brutos (ASCII y Hexadecimal)
  if Assigned(FOnRawData) then
    FOnRawData(Self, Data, StringToHex(Data));

  FBuffer := FBuffer + Data;

  // Extraer tramas delimitadas por CR o LF o ambos
  while True do
  begin
    IdxCR := Pos(#13, FBuffer);
    IdxLF := Pos(#10, FBuffer);

    if (IdxCR = 0) and (IdxLF = 0) then
    begin
      // Si el buffer es muy largo y no tiene delimitadores, procesar por longitud fija
      if Length(FBuffer) > 64 then
      begin
        Linea := FBuffer;
        FBuffer := '';
        ProcesarLinea(Linea);
      end;
      Break;
    end;

    if (IdxCR > 0) and (IdxLF > 0) then
      PosDelim := Min(IdxCR, IdxLF)
    else if IdxCR > 0 then
      PosDelim := IdxCR
    else
      PosDelim := IdxLF;

    Linea := Copy(FBuffer, 1, PosDelim - 1);
    Delete(FBuffer, 1, PosDelim);

    // Si había un par CRLF consecutivo, consumir también el siguiente caracter si es LF/CR
    if (Length(FBuffer) > 0) and CharInSet(FBuffer[1], [#13, #10]) then
      Delete(FBuffer, 1, 1);

    if Trim(Linea) <> '' then
      ProcesarLinea(Linea);
  end;
end;

end.