// I, Danny Milosavljevic, hereby release this code into the public domain.

unit ASCII85;

{$M+}
{$MODE OBJFPC}

// Based on C# code from <http://www.codinghorror.com/blog/archives/000410.html> by Jeff Atwood,
//   which is based on C code from <http://www.stillhq.com/cgi-bin/cvsweb/ascii85/>.

interface
uses sysutils, classes, ring_buffers, custom_decoders;

type
  TASCII85State = (ascInitial = 0, ascOneEncodedChar = 1, ascTwoEncodedChars = 2, ascThreeEncodedChars = 3, ascFourEncodedChars = 4, ascNoEncodedChar = 5, ascPrefix = 6);
  
  TDecoder = class(custom_decoders.TCustomDirectDecoder)
  private
    fBExpectBoundary : Boolean;
    fTuple : Cardinal;
    fState : TASCII85State;
  private
    procedure BufferByte(aValue : Byte); inline;
    procedure BufferTuple(aValue : Cardinal; aDecodedCount : Cardinal); inline; // decoding shrinks from 5 byte to 4 byte.
    procedure Decode(aInput : Byte); inline;
  published
    procedure Finish(); override;
    function FinishedP() : Boolean; override;
    property BExpectBoundary : Boolean read fBExpectBoundary write fBExpectBoundary;
  protected
    procedure DecodeBlock(aEncodedBuffer : PByte; aEncodedBufferCount : Cardinal); override;
    function GetPermittedReadCount(aBufferAvailableSpace : Cardinal) : Cardinal; override;
  end;
  
  // TODO encoder...

implementation


{ TDecoder }

const
  cPow85 : array[0..4] of Cardinal = (85*85*85*85, 85*85*85, 85*85, 85, 1); // uint

function DecodeNonTrivialByte(aInput : Byte) : Cardinal; inline;
begin
  if (aInput >= ord('!')) and (aInput <= ord('u')) then
    Result := aInput - ord('!')
  else
    raise EConvertError.Create(Format('could not decode value %d', [aInput]));
//  if chr(aInput) in ['!'..'u'] then
end;

procedure TDecoder.BufferByte(aValue : Byte); inline;
begin
  Buffer.Write(aValue, 1);
end;

procedure TDecoder.BufferTuple(aValue : Cardinal; aDecodedCount { DECODED!!!} : Cardinal); inline;
begin
  if aDecodedCount >= 1 then begin
    BufferByte(aValue shr (24 - (0 * 8)));
    if aDecodedCount >= 2 then begin
      BufferByte(aValue shr (24 - (1 * 8)));
      if aDecodedCount >= 3 then begin
        BufferByte(aValue shr (24 - (2 * 8)));
        if aDecodedCount >= 4 then begin
          BufferByte(aValue shr (24 - (3 * 8)));
          if aDecodedCount >= 5 then begin
            raise EConvertError.Create('not enough decoded data (internal error).');
          end;
        end;
      end;
    end;
  end;
end;

procedure TDecoder.Decode(aInput : Byte);
begin
  if (aInput in [ 10, 13, 9, {0, 8,} 12, 32]) and (fState <> ascPrefix { chicken}) then // skip whitespace.
    Exit;
                                  
  case fState of
  ascInitial, ascNoEncodedChar:
    if aInput = ord('z') then begin
      BufferTuple(0, 4);
    end else begin
      if (aInput = ord('<')) and (fState = ascInitial) {and (fBExpectBoundary)} then begin
        fState := ascPrefix;
      end else begin
        fTuple := fTuple + DecodeNonTrivialByte(aInput) * cPow85[0];
        fState := ascOneEncodedChar;
      end;
    end;
  ascOneEncodedChar:
    begin
      fTuple := fTuple + DecodeNonTrivialByte(aInput) * cPow85[1];
      fState := ascTwoEncodedChars;
    end;
  ascTwoEncodedChars:
    begin
      fTuple := fTuple + DecodeNonTrivialByte(aInput) * cPow85[2];
      fState := ascThreeEncodedChars;
    end;
  ascThreeEncodedChars:
    begin
      fTuple := fTuple + DecodeNonTrivialByte(aInput) * cPow85[3];
      fState := ascFourEncodedChars;
    end;
  ascFourEncodedChars:
    begin
      fTuple := fTuple + DecodeNonTrivialByte(aInput) * cPow85[4];
      
      BufferTuple(fTuple, 4);
      fTuple := 0;
      fState := ascNoEncodedChar;
    end;
  ascPrefix:
    begin
      if aInput = ord('~') then begin
        fBExpectBoundary := True;
        fState := ascNoEncodedChar
      end else begin
        // whoops, actually "~" is outside the allowed range, so we CAN find out whether there was supposed to be a boundary string or not on our own...
        // we reached this place since we saw a '<', thought it was part of '<~', but it wasn't. '<' is an allowed encoded character.

        // catch up on work we should have been doing...
        
        assert(fTuple = 0);
                
        fTuple := fTuple + DecodeNonTrivialByte(ord('<')) * cPow85[0];
        //fState := ascOneEncodedChar;
        fTuple := fTuple + DecodeNonTrivialByte(aInput) * cPow85[1];
        fState := ascTwoEncodedChars;
        
        //raise EConvertError.Create(Format('expected ''<~'', got %d', [aInput]));
      end;
    end
  else
    raise EConvertError.Create('internal error');
  end;
end;

function TDecoder.FinishedP() : Boolean;
begin
  Result := (fState in [ascInitial, ascNoEncodedChar, ascPrefix]);
end;

procedure TDecoder.Finish();
var
  vCount : Cardinal;
begin
  if fState = ascPrefix then
    raise EConvertError.Create('unexpected end of file while trying to find ''<~'' prefix (after the ''<'' was seen).');
    
  if not (fState in [ascInitial, ascNoEncodedChar, ascPrefix]) then begin // we have some bytes left over.
    if fState = ascOneEncodedChar then
      raise EConvertError.Create('The last block of ASCII85 data cannot be a single byte.');

    vCount := Cardinal(fState) - 1; // one less!!

    fTuple := fTuple + cPow85[vCount];
    BufferTuple(fTuple, vCount);
    
    fState := ascInitial;
  end;
end;

function TDecoder.GetPermittedReadCount(aBufferAvailableSpace : Cardinal) : Cardinal;
begin
  Result := aBufferAvailableSpace shr 2;
end;

procedure TDecoder.DecodeBlock(aEncodedBuffer : PByte; aEncodedBufferCount : Cardinal); inline;
var
  vEncodedBufferIndex : Cardinal;
  vItem : Byte;
begin
    if aEncodedBufferCount > 0 then   // Buffer the output we couldn't pass on so far.
    for vEncodedBufferIndex := 0 to aEncodedBufferCount - 1 do begin
      vItem := aEncodedBuffer^;
      if (vItem = ord('~')) and fBExpectBoundary then begin // holy #@! oops...
        BSourceEOF := True;
        {if not fBExpectBoundary then -- flag is not yet valid.
          raise EConvertError.Create('unexpected ''~>'' (there was no starting ''<~'', so why would there be a final one?).');
        }

        // note that here, it could be that we ran over the boundary '~>' suffix in the underlying stream and didn't notice. In that case, the 'Decode' call below would break.

        if not FinishedP() then
          Finish(); // make sure we catch the "virtual characters". This could fill the buffer a little bit.

        // seek the underlying stream and hope nobody noticed that we completely ignored the boundary :)
        try
          Source.Seek(vEncodedBufferIndex - aEncodedBufferCount + 1, 1); // from current position.
          if Source.ReadByte() <> ord('>') then
            raise EConvertError.Create('the final ''~>'' is malformed.');
        except
          on E : EConvertError do 
            raise;
{$IFNDEF UNSEEKABLE_STREAMS_ARE_EVIL}
          else
            ; // too bad... well, we tried.
{$ENDIF}
        end;
        Break; // for.
      end;
      Self.Decode(vItem);
      Inc(aEncodedBuffer);
    end;
end;

initialization
  assert(Sizeof(Cardinal) >= 4);

end.