unit ByteBuf;

interface
uses
  SysUtils,
  IdGlobal,
  SZCRC32,
  Tags;


type

  TByteBuf = class(TObject)
  private
    size: integer;
    writeUpperBound: Integer;
    strLenMax: Integer;
    bufswp: TIdBytes;

    procedure swapBuf(len: integer);
    function writeValueShortFormInt(value: Integer): boolean;
  public
    buf: TIdBytes;
    readIndex: Integer;
    writeIndex: Integer;

    Constructor Create(size: integer);
    destructor Destroy; override;

    function canWrite(): Boolean;
    procedure clear();

    function getByte(index: integer): byte;
    function getWord(index: integer): word;
    function getMedium(index: integer): integer;
    function getInt(index: integer): integer;
    function getLong(index: integer): int64;
    function getDouble(index: integer): double;
    function getString(index, len: integer): string;

    function readByte: byte;
    function readWord: word;
    function readMedium: integer;
    function readInt: integer;
    function readLong: int64;
    function readDouble: double;
    function readString(len: integer): string;

    procedure setByte(index: integer; value: byte);
    procedure setWord(index: integer; value: word);
    procedure setMedium(index: integer; value: integer);
    procedure setInt(index: integer; value: integer);
    procedure setLong(index: integer; value: int64);
    procedure setDouble(index: integer; value: double);
    function setString(index: integer; const value: string): integer;

    procedure writeByte(value: byte);
    procedure writeWord(value: word);
    procedure writeMedium(value: integer);
    procedure writeInt(value: integer);
    procedure writeLong(value: int64);
    procedure writeDouble(value: double);
    function writeString(const value: string): integer;

    function readSmallSizeString: string;
    function readBigString: string;
    procedure writeSmallSizeString(const value: string);

    procedure readValueStatus(tag: TTagRW);
    procedure writeValue(tag: TTagRW);
    procedure writeValueBool(value: boolean);
    procedure writeValueInt(value: integer);
    procedure writeValueLong(value: int64);
    procedure writeValueDouble(value: double);
    procedure writeValueString(const value: string);
    procedure writeBigString(const value: string);

    function calcCrc32(first, len: integer): integer;
    function dump: string;

  end;


implementation

const
  FLAG_STATUS = $10;

  VAL_ZERO    = $F0;
  VAL_ONE     = $F1;
  VAL_BYTE    = $F2;
  VAL_WORD    = $F3;
  VAL_INT     = $F8;
  VAL_LONG    = $F9;
  VAL_DOUBLE  = $FA;
  VAL_STRING  = $FB;


{ TByteBuf }

constructor TByteBuf.Create(size: integer);
begin
  Self.size := size;
  writeUpperBound := size div 2;
  strLenMax := size div 4;

  clear();
  SetLength(buf, size);
  SetLength(bufswp, 8);
end;

destructor TByteBuf.Destroy;
begin

  inherited;
end;

procedure TByteBuf.swapBuf(len: integer);
var
  i,k: Integer;
  b: Byte;
begin
  k := len - 1;
  len := (len div 2) - 1;
  for i:=0 to len do begin
    b := bufswp[i];
    bufswp[i] := bufswp[k];
    bufswp[k] := b;
    Dec(k);
  end;
end;

function TByteBuf.canWrite: Boolean;
begin
  result := writeIndex < writeUpperBound;
end;

procedure TByteBuf.clear;
begin
  readIndex := 0;
  writeIndex := 0;
end;



function TByteBuf.getByte(index: integer): byte;
begin
  Result := buf[index];
end;

function TByteBuf.getWord(index: integer): word;
begin
  Result := (buf[index] shl 8) + buf[index+1];
end;

function TByteBuf.getMedium(index: integer): integer;
begin
  Result := (buf[index] shl 16) + (buf[index+1] shl 8) + buf[index+2];
end;

function TByteBuf.getInt(index: integer): integer;
begin
  Move(buf[index], bufswp[0], 4);
  swapBuf(4);
  Move(bufswp[0], Result, 4);
end;

function TByteBuf.getLong(index: integer): int64;
begin
  Move(buf[index], bufswp[0], 8);
  swapBuf(8);
  Move(bufswp[0], Result, 8);
end;

function TByteBuf.getString(index, len: integer): string;
begin
  if len = 0 then
    Result := ''
  else begin
    SetLength(Result, len);
    Move(buf[index], result[1], len);
    Result := Utf8ToAnsi(Result);
  end;
end;

function TByteBuf.getDouble(index: integer): double;
begin
  Move(buf[index], bufswp[0], 8);
  swapBuf(8);
  Move(bufswp[0], Result, 8);
end;


function TByteBuf.readByte: byte;
begin
  result := getByte(readIndex);
  Inc(readIndex);
end;

function TByteBuf.readWord: word;
begin
  result := getWord(readIndex);
  Inc(readIndex, 2);
end;

function TByteBuf.readMedium: integer;
begin
  result := getMedium(readIndex);
  Inc(readIndex, 3);
end;

function TByteBuf.readInt: integer;
begin
  result := getInt(readIndex);
  Inc(readIndex, 4);
end;

function TByteBuf.readLong: int64;
begin
  result := getLong(readIndex);
  Inc(readIndex, 8);
end;

function TByteBuf.readDouble: double;
begin
  result := getDouble(readIndex);
  Inc(readIndex, 8);
end;

function TByteBuf.readString(len: integer): string;
begin
  result := getString(readIndex, len);
  Inc(readIndex, len);
end;



procedure TByteBuf.setByte(index: integer; value: byte);
begin
  buf[index] := value;
end;

procedure TByteBuf.setWord(index: integer; value: word);
begin
  buf[index] := value shr 8;
  buf[index+1] := value and $FF;
end;

procedure TByteBuf.setMedium(index: integer; value: integer);
begin
  buf[index] := (value shr 16) and $FF;
  buf[index+1] := (value shr 8) and $FF;
  buf[index+2] := value and $FF;
end;

procedure TByteBuf.setInt(index, value: integer);
begin
  Move(value, bufswp[0], 4);
  swapBuf(4);
  Move(bufswp[0], buf[index], 4);
end;

procedure TByteBuf.setLong(index: integer; value: int64);
begin
  Move(value, bufswp[0], 8);
  swapBuf(8);
  Move(bufswp[0], buf[index], 8);
end;

procedure TByteBuf.setDouble(index: integer; value: double);
begin
  Move(value, bufswp[0], 8);
  swapBuf(8);
  Move(bufswp[0], buf[index], 8);
end;

function TByteBuf.setString(index: integer; const value: string): Integer;
var
  utf8str: string;
begin
  if length(value) = 0 then
    Result := 0
  else begin
    utf8str := AnsiToUtf8(value);
    Result := Length(utf8str);
    Move(utf8str[1], buf[index], result);
  end;
end;



procedure TByteBuf.writeByte(value: byte);
begin
  setByte(writeIndex, value);
  Inc(writeIndex);
end;

procedure TByteBuf.writeWord(value: word);
begin
  setWord(writeIndex, value);
  Inc(writeIndex, 2);
end;

procedure TByteBuf.writeMedium(value: integer);
begin
  setMedium(writeIndex, value);
  Inc(writeIndex, 3);
end;

procedure TByteBuf.writeInt(value: integer);
begin
  setInt(writeIndex, value);
  Inc(writeIndex, 4);
end;

procedure TByteBuf.writeLong(value: int64);
begin
  setLong(writeIndex, value);
  Inc(writeIndex, 8);
end;

procedure TByteBuf.writeDouble(value: double);
begin
  setDouble(writeIndex, value);
  Inc(writeIndex, 8);
end;

function TByteBuf.writeString(const value: string): integer;
begin
  result := setString(writeIndex, value);
  Inc(writeIndex, result);
end;



function TByteBuf.calcCrc32(first, len: integer): integer;
begin
  result := Integer(SZCRC32Full(@buf[first], len));
end;


function TByteBuf.dump: string;
var
  i: Integer;
begin
  Result := '';
  for i:=0 to writeIndex-1 do
    Result := Result + IntToHex(buf[i], 2) + ' ';
end;


function TByteBuf.readSmallSizeString: string;
begin
  result := readString(readByte);
end;

function TByteBuf.readBigString: string;
begin
  result := readString(readWord);
end;

procedure TByteBuf.writeSmallSizeString(const value: string);
var
  posLen, len: Integer;
begin
  posLen := writeIndex;
  Inc(writeIndex);
  writeString(value);
  len := writeIndex - posLen - 1;
  if len < 256 then
    setByte(posLen, len)
  else begin
    len := 254;
    setByte(posLen, len);
    writeIndex := posLen + 1 + len;
  end;
end;



procedure TByteBuf.readValueStatus(tag: TTagRW);
var
  valcode: Byte;
  status: TTagStatus;
begin
  valcode := readByte;

  status := tsGOOD;
  if (valcode and FLAG_STATUS) = 0 then begin
    valcode := valcode or FLAG_STATUS; // set bit to default state
    status := tsBAD;
  end;

  case valcode of
    VAL_ZERO:   tag.setReadValInt(0);
    VAL_ONE:    tag.setReadValInt(1);
    VAL_BYTE:   tag.setReadValInt(    readByte );
    VAL_WORD:   tag.setReadValInt(    readWord );
    VAL_INT:    tag.setReadValInt(    readInt );
    VAL_LONG:   tag.setReadValLong(   readLong );
    VAL_DOUBLE: tag.setReadValDouble( readDouble );
    VAL_STRING: tag.setReadValString( readString(readWord) );
  else
    raise Exception.Create('Unknown value code: ' + IntToStr(valcode));
  end;

  tag.setStatus(status);
end;

procedure TByteBuf.writeValue(tag: TTagRW);
begin
  case tag.getType of
    ttBOOL:   writeValueBool(   tag.getWriteValBool );
    ttINT:    writeValueInt(    tag.getWriteValInt );
    ttLONG:   writeValueLong(   tag.getWriteValLong );
    ttDOUBLE: writeValueDouble( tag.getWriteValDouble );
    ttSTRING: writeValueString( tag.getWriteValString );
  end;
end;


procedure TByteBuf.writeValueBool(value: boolean);
begin
  if value then
    writeByte(VAL_ONE)
  else
    writeByte(VAL_ZERO);
end;

procedure TByteBuf.writeValueInt(value: integer);
begin
  if writeValueShortFormInt(value) then
    Exit;

  writeByte(VAL_INT);
  writeInt(value);
end;

procedure TByteBuf.writeValueLong(value: int64);
begin
  if  (value >= 0) and (value < 65536) and (writeValueShortFormInt(value)) then
    Exit;

  writeByte(VAL_LONG);
  writeLong(value);
end;

function TByteBuf.writeValueShortFormInt(value: Integer): boolean;
begin
  if value = 0 then begin
      writeByte(VAL_ZERO);
      Result := True;
      Exit;
  end;

  if value > 0 then begin
    if value = 1 then begin
      writeByte(VAL_ONE);
      Result := True;
      Exit;
    end;

    if value < 256 then begin
      writeByte(VAL_BYTE);
      writeByte(value);
      Result := True;
      Exit;
    end;

    if value < 65536 then begin
      writeByte(VAL_WORD);
      writeWord(value);
      Result := True;
      Exit;
    end;
  end;
  Result := false;
end;

procedure TByteBuf.writeValueDouble(value: double);
begin
  writeByte(VAL_DOUBLE);
  writeDouble(value);
end;

procedure TByteBuf.writeValueString(const value: string);
begin
  writeByte(VAL_STRING);
  writeBigString(value);
end;

procedure TByteBuf.writeBigString(const value: string);
var
  posLen, len: Integer;
begin
  posLen := writeIndex;
  Inc(writeIndex, 2);
  writeString(value);
  len := writeIndex - posLen - 2;
  if len < strLenMax then begin
    setWord(posLen, len);
  end else begin
    len := strLenMax;
    setWord(posLen, len);
    writeIndex := posLen + 2 + len;
  end;
end;



end.
