IT Sample pack stuff

function TEngineSample.SchreibePackedITSample(Daten:TEngineStream;IT215:boolean):boolean;
type PITCompressionTable=^TITCompressionType;
     TITCompressionTable=array[0..16] of longint;
     PITCompressionType=^TITCompressionType;
     TITCompressionType=record
      Mask:longint;
      FetchA:longint;
      LowerB:longint;
      UpperB:longint;
      DefaultWidth:longint;
      LowerTable:TITCompressionTable;
      UpperTable:TITCompressionTable;
     end;
const ITCompressionType8Bit:TITCompressionType=
       (
        Mask:$ff;
        FetchA:3;
        LowerB:-4;
        UpperB:3;
        DefaultWidth:9;
        LowerTable:(0,-1,-3,-7,-15,-31,-60,-124,-128,0,0,0,0,0,0,0,0);
        UpperTable:(0,1,3,7,15,31,59,123,127,0,0,0,0,0,0,0,0);
       );
      ITCompressionType16Bit:TITCompressionType=
       (
        Mask:$ffff;
        FetchA:4;
        LowerB:-8;
        UpperB:7;
        DefaultWidth:17;
        LowerTable:(0,-1,-3,-7,-15,-31,-56,-120,-248,-504,-1016,-2040,-4088,-8184,-16376,-32760,-32768);
        UpperTable:(0,1,3,7,15,31,55,119,247,503,1015,2039,4087,8183,16375,32759,32767);
       );
      ITWidthChangeSize:array[0..16] of longint=(4,5,6,7,8,9,7,8,9,10,11,12,13,14,15,16,17);
      ITBufferSize=$ffff+2;
      ITBlockSize=$8000;
type PBuffer=^TBuffer;
     TBuffer=array[0..ITBufferSize-1] of byte;
     PBlock=^TBlock;
     TBlock=array[0..ITBlockSize-1] of byte;
var PackedData:PBuffer;
    SampleData:PBlock;
    Channel:longint;
    Position:longint;
    Offset:longint;
    Remain:longint;
    PackedLength:longint;
    BitPosition:longint;
    RemainBits:longint;
    ByteValue:longint;
    BaseLength:longint;
    Source:array of array of longint;
    OutData:array of array of longint;
    BitWidthTable:array of longint;
    Data:array of longint;
    TwoBytes:array[0..1] of byte;
    CompressionType:PITCompressionType;
    NewValue:longint;
    OldValue:longint;
    IT215Loop:boolean;
    OK:boolean;
 function ConvertWidth(CurrentWidth,NewWidth:longint):longint;
 begin
  dec(CurrentWidth);
  dec(NewWidth);
  if NewWidth>CurrentWidth then begin
   dec(NewWidth);
  end;
  result:=NewWidth;
 end;
 procedure WriteByte(Value:longint);
 begin
  if PackedLength<ITBufferSize then begin
   PackedData^[PackedLength]:=Value;
   inc(PackedLength);
  end else begin
   OK:=false;
  end;
 end;
 procedure WriteBits(Width,Value:longint);
 begin
  while Width>RemainBits do begin
   ByteValue:=ByteValue or (Value shl BitPosition);
   dec(Width,RemainBits);
   Value:=SARLongint(Value,RemainBits);
   BitPosition:=0;
   RemainBits:=8;
   WriteByte(ByteValue);
   ByteValue:=0;
  end;
  if Width>0 then begin
   ByteValue:=ByteValue or ((Value and (((1 shl Width)-1))) shl BitPosition);
   dec(RemainBits,Width);
   inc(BitPosition,Width);
  end;
 end;
 procedure VerifyITSamplePacked(Daten:TEngineStream;bIT215:boolean);
 type psmallint=^smallint;
      pshortint=^shortint;
 var RemainBits,DataBlockPosition,DataBlockSize,BitPosition,RemainSamples,TotalSamples:longint;
     DataBlock:array of byte;
     Error:boolean;
  function ReadBits(Width:longint):longint;
  var Position,Mask:longint;
  begin
   result:=0;
   Position:=0;
   Mask:=(1 shl Width)-1;
   while (Width>=RemainBits) and (DataBlockPosition<DataBlockSize) do begin
    result:=result or ((DataBlock[DataBlockPosition] shr BitPosition) shl Position);
    inc(Position,RemainBits);
    dec(Width,RemainBits);
    inc(DataBlockPosition);
    RemainBits:=8;
    BitPosition:=0;
   end;
   if (Width>0) and (DataBlockPosition<DataBlockSize) then begin
    result:=(result or ((DataBlock[DataBlockPosition] shr BitPosition) shl Position)) and Mask;
    dec(RemainBits,Width);
    inc(BitPosition,Width);
   end;
  end;
 var Channel,Mem1,Mem2,Remain,Width,DefaultWidth,Value,TopBit,FetchA,LowerB,UpperB,
     Position:longint;
     TwoBytes:array[0..1] of byte;
 begin
  DataBlock:=nil;
  try
   Error:=false;
   TotalSamples:=Laenge;
   if Bits=16 then begin
    DefaultWidth:=17;
    FetchA:=4;
    LowerB:=-8;
    UpperB:=7;
   end else begin
    DefaultWidth:=9;
    FetchA:=3;
    LowerB:=-4;
    UpperB:=3;
   end;
   SetLength(OutData,Kaenale,Laenge);
   for Channel:=0 to Kaenale-1 do begin
    for Position:=0 to Laenge-1 do begin
     OutData[Channel,Position]:=0;
    end;
   end;
   SetLength(DataBlock,65536);
   for Channel:=0 to Kaenale-1 do begin
    Position:=0;
    RemainSamples:=TotalSamples;
    while (RemainSamples>0) and (Daten.Position<Daten.Size) do begin
     if Daten.Read(TwoBytes,SizeOf(TwoBytes))<>SizeOf(TwoBytes) then begin
      Error:=true;
      break;
     end;
     DataBlockSize:=(TwoBytes[0] and $ff) or (TwoBytes[1] shl 8);
     if DataBlockSize=0 then begin
      Error:=true;
      break;
     end;
     if Daten.Read(DataBlock[0],DataBlockSize)<>DataBlockSize then begin
      Error:=true;
      break;
     end;
     DataBlockPosition:=0;
     BitPosition:=0;
     RemainBits:=8;
     Mem1:=0;
     Mem2:=0;
     if Bits=16 then begin
      Remain:=$4000;
     end else begin
      Remain:=$8000;
     end;
     if Remain>RemainSamples then begin
      Remain:=RemainSamples;
     end;
     Width:=DefaultWidth;
     while Remain>0 do begin
      if (Width<1) or (Width>DefaultWidth) or (DataBlockPosition>=DataBlockSize) then begin
       Error:=true;
       break;
      end;
      Value:=ReadBits(Width);
      TopBit:=1 shl (Width-1);
      if Width<=6 then begin
       if Value=TopBit then begin
        Value:=ReadBits(FetchA)+1;
        if Value<Width then begin
         Width:=Value;
        end else begin
         Width:=Value+1;
        end;
        continue;
       end;
      end else if Width<DefaultWidth then begin
       if (Value>=(TopBit+LowerB)) and (Value<=(TopBit+UpperB)) then begin
        Value:=(Value-(TopBit+LowerB))+1;
        if Value<Width then begin
         Width:=Value;
        end else begin
         Width:=Value+1;
        end;
        continue;
       end;
      end else begin
       if (Value and TopBit)<>0 then begin
        Width:=(Value and not TopBit)+1;
        continue;
       end else begin
        Value:=Value and not TopBit;
        TopBit:=0;
       end;
      end;
      if (Value and TopBit)<>0 then begin
       dec(Value,TopBit shl 1);
      end;
      inc(Mem1,Value);
      inc(Mem2,Mem1);
      if bIT215 then begin
       Value:=Mem2;
      end else begin
       Value:=Mem1;
      end;
      if Bits=16 then begin
       OutData[Channel,Position]:=smallint(word(Value and $ffff));
      end else begin
       OutData[Channel,Position]:=shortint(byte(Value and $ff));
      end;
      inc(Position);
      dec(RemainSamples);
      dec(Remain);
     end;
     if Error then begin
      OK:=false;
      break;
     end;
    end;
    if Error then begin
     OK:=false;
     break;
    end;
   end;
   if OK then begin
    for Channel:=0 to Kaenale-1 do begin
     for Position:=0 to Laenge-1 do begin
      if OutData[Channel,Position]<>Source[Channel,Position] then begin
       OK:=false;
       break;
      end;
     end;
     if not OK then begin
      break;
     end;
    end;
   end;
   if Error then begin
    OK:=false;
   end;
  finally
   SetLength(DataBlock,0);
  end;
 end;
 function GetWidthChangeSize(w:longint):longint;
 begin
  if (w<1) or (w>17) then begin
   OK:=false;
  end;
  result:=ITWidthChangeSize[w-1];
  if (w<=6) and (Bits=16) then begin
   inc(result);
  end;
 end;
 procedure Squish(sWidth,lWidth,rWidth,Width,Offset,Len:longint);
 var i,s,e,BlockLen,xlWidth,xrWidth,wcsl,wcss,wcsw,KeepDown,LevelLeft:longint;
 begin
  if (Width+1)<1 then begin
   for i:=Offset to (Offset+Len)-1 do begin
    BitWidthTable[i]:=sWidth;
   end;
  end else begin
   if Width>=CompressionType^.DefaultWidth then begin
    OK:=false;
   end;
   i:=Offset;
   e:=Offset+Len;
   while i<e do begin
    if (Data[i]>=CompressionType^.LowerTable[Width]) and (Data[i]<=CompressionType^.UpperTable[Width]) then begin
     s:=i;
     while (i<e) and ((Data[i]>=CompressionType^.LowerTable[Width]) and (Data[i]<=CompressionType^.UpperTable[Width])) do begin
      inc(i);
     end;
     BlockLen:=i-s;
     if s=Offset then begin
      xlWidth:=lWidth;
     end else begin
      xlWidth:=sWidth;
     end;
     if i=e then begin
      xrWidth:=rWidth;
     end else begin
      xrWidth:=sWidth;
     end;
     wcsl:=GetWidthChangeSize(xlWidth);
     wcss:=GetWidthChangeSize(sWidth);
     wcsw:=GetWidthChangeSize(Width+1);
     if i=BaseLength then begin
      KeepDown:=wcsl+((Width+1)*BlockLen);
      LevelLeft:=wcsl+(sWidth*BlockLen);
      if xlWidth=sWidth then begin
       dec(LevelLeft,wcsl);
      end;
     end else begin
      KeepDown:=wcsl+(((Width+1)*BlockLen)+wcsw);
      LevelLeft:=wcsl+((sWidth*BlockLen)+wcss);
      if xlWidth=sWidth then begin
       dec(LevelLeft,wcsl);
      end;
      if xrWidth=sWidth then begin
       dec(LevelLeft,wcss);
      end;
     end;
     if KeepDown<=LevelLeft then begin
      Squish(Width+1,xlWidth,xrWidth,Width-1,s,BlockLen);
     end else begin
      Squish(sWidth,xlWidth,xrWidth,Width-1,s,BlockLen);
     end;
    end else begin
     BitWidthTable[i]:=sWidth;
     inc(i);
    end;
   end;
  end;
 end;
var Width,NewWidth,TopBit,Value:longint;
begin
 OK:=false;
 PackedData:=nil;
 SampleData:=nil;
 Source:=nil;
 OutData:=nil;
 Data:=nil;
 BitWidthTable:=nil;
 try
  GetMem(PackedData,SizeOf(TBuffer));
  GetMem(SampleData,SizeOf(TBlock));
  SetLength(Source,Kaenale,Laenge);
  SetLength(Data,ITBufferSize*4);
  SetLength(BitWidthTable,ITBufferSize*4);
  case Bits of
   8:begin
    CompressionType:=@ITCompressionType8Bit;
    for Channel:=0 to Kaenale-1 do begin
     for Position:=0 to Laenge-1 do begin
      Source[Channel,Position]:=shortint(byte(pointer(@PAnsiChar(DataPointer)[((Position*Kaenale)+Channel)*SizeOf(Byte)])^));
     end;
    end;
   end;
   16:begin
    CompressionType:=@ITCompressionType16Bit;
    for Channel:=0 to Kaenale-1 do begin
     for Position:=0 to Laenge-1 do begin
      Source[Channel,Position]:=smallint(word(pointer(@PAnsiChar(DataPointer)[((Position*Kaenale)+Channel)*SizeOf(word)])^));
     end;
    end;
   end;
   else begin
    CompressionType:=nil;
   end;
  end;
  if assigned(CompressionType) then begin
   OK:=true;
   for Channel:=0 to Kaenale-1 do begin
    Offset:=0;
    Remain:=Laenge;
    while Remain>0 do begin
     PackedLength:=0;
     BitPosition:=0;
     RemainBits:=8;
     ByteValue:=0;
     BaseLength:=ITBlockSize shr ((Bits shr 3)-1);
     if BaseLength>Remain then begin
      BaseLength:=Remain;
     end;
     for Position:=0 to BaseLength-1 do begin
      Data[Position]:=Source[Channel,Offset+Position];
     end;
     for IT215Loop:=false to IT215 do begin
      case Bits of
       8:begin
        OldValue:=0;
        for Position:=0 to BaseLength-1 do begin
         NewValue:=Data[Position];
         Data[Position]:=shortint(byte(shortint(byte(byte(NewValue)-byte(OldValue)))));
         OldValue:=NewValue;
        end;
       end;
       16:begin
        OldValue:=0;
        for Position:=0 to BaseLength-1 do begin
         NewValue:=Data[Position];
         Data[Position]:=smallint(word(smallint(word(word(NewValue)-word(OldValue)))));
         OldValue:=NewValue;
        end;
       end;
      end;
     end;
     for Position:=0 to BaseLength-1 do begin
      BitWidthTable[Position]:=CompressionType^.DefaultWidth;
     end;
     Squish(CompressionType^.DefaultWidth,CompressionType^.DefaultWidth,CompressionType^.DefaultWidth,CompressionType^.DefaultWidth-2,0,BaseLength);
{    for Position:=0 to BaseLength-1 do begin
      NewWidth:=CompressionType^.DefaultWidth;
      for Width:=CompressionType^.DefaultWidth-1 downto 2 do begin
       Value:=Data[Position];
       if (Value>=CompressionType^.LowerTable[Width]) and (Value<=CompressionType^.UpperTable[Width]) then begin
        if (Value<0) or (Value>=(1 shl (Width-1))) then begin
         NewWidth:=Width+1;
        end else begin
         NewWidth:=Width;
        end;
       end else begin
        break;
       end;
      end;
      BitWidthTable[Position]:=NewWidth;
     end;}
     Width:=CompressionType^.DefaultWidth;
     for Position:=0 to BaseLength-1 do begin
      TopBit:=1 shl (Width-1);
      if Width<>BitWidthTable[Position] then begin
       if Width<=6 then begin
        if Width<=0 then begin
         OK:=false;
         break;
        end;
        WriteBits(Width,TopBit);
        WriteBits(CompressionType^.FetchA,ConvertWidth(Width,BitWidthTable[Position]));
       end else if Width<CompressionType^.DefaultWidth then begin
        WriteBits(Width,(TopBit+CompressionType^.LowerB)+ConvertWidth(Width,BitWidthTable[Position]));
       end else begin
        if (BitWidthTable[Position]-1)<0 then begin
         OK:=false;
         break;
        end;
        WriteBits(Width,TopBit+(BitWidthTable[Position]-1));
       end;
       Width:=BitWidthTable[Position];
      end;
      case Bits of
       8:begin
{       if (byte(Data[Position]) and $ff)>=(1 shl Width) then begin
         OK:=false;
         break;
        end;}
        WriteBits(Width,shortint(byte(byte(Data[Position]) and $ff)) and $ff);
       end;
       16:begin
{       if (word(Data[Position]) and $ffff)>=(1 shl Width) then begin
         OK:=false;
         break;
        end;}
        WriteBits(Width,smallint(word(word(Data[Position]) and $ffff)) and $ffff);
       end;
      end;
     end;
     if RemainBits<>8 then begin
      WriteByte(ByteValue);
     end;
     NewValue:=PackedLength;
     TwoBytes[0]:=NewValue and $ff;
     TwoBytes[1]:=(NewValue shr 8) and $ff;
     if Daten.Write(TwoBytes,SizeOf(TwoBytes))<>SizeOf(TwoBytes) then begin
      OK:=false;
      break;
     end;
     if Daten.Write(PackedData^,PackedLength)<>PackedLength then begin
      OK:=false;
      break;
     end;
     inc(Offset,BaseLength);
     dec(Remain,BaseLength);
    end;
   end;
  end;
  if OK then begin
   Daten.Seek(0,soFromBeginning);
   VerifyITSamplePacked(Daten,IT215);
   if OK then begin
    if Daten.Size>=(Laenge*Kaenale*(Bits shr 3)) then begin
     OK:=false;
    end;
   end;
  end;
  Daten.Seek(0,soFromBeginning);
 finally
  if assigned(PackedData) then begin
   FreeMem(PackedData);
  end;
  if assigned(SampleData) then begin
   FreeMem(SampleData);
  end;
  SetLength(Source,0);
  SetLength(OutData,0);
  SetLength(Data,0);
  SetLength(BitWidthTable,0);
 end;
 result:=OK;
end;