338_compress2

PROGRAM RLE_Compress_2_Draft;

//Procedure RleCompress2(Stream : TStream); forward;
//Procedure RleDecompress2(Stream : TStream); forward;

// kind of an Idea from bitbox, locs= 238; 6 intF;

{TYPE 
<Type declarations>} 

VAR 
//<Variable declarations>
    div_dbl: double;
    a,b,c, i, bin1, bin2, bin3: integer;
    wd: word;
    st: String;
    fileStream: TFileStream;
    midilist: TStringList;
//<FUNCTION>
//<PROCEDURE> 


function GetTextFromFile(const AFile: String; var RetStr: string): boolean;
//var
  //fileStream: TFileStream;
begin
  result:= false;
  if not fileExists(AFile) then exit;
  FileStream:= TFileStream.Create(AFile, fmOpenRead);
    writeln('file size '+inttostr(filestream.size));
  try
    if FileStream.Size > 0 then begin
      SetLength(RetStr, FileStream.Size);
      fileStream.Seek(0, 0)
      FileStream.Read(RetStr, FileStream.Size); 
      result:= true;
    end;
  finally
    //FileStream.Free;
  end; //try
end;

procedure RleCompressTest(Stream: TStream);
var
  Count, Count2, Count3, I: Integer;
  Buf1: array [0..1024] of Byte;
  Buf2: array [0..60000] of Byte;
  buf3: string;
  B: Byte;
  Tmp: TMemoryStream;
begin
  Tmp := TMemoryStream.Create;
  Stream.Position := 0;
  Count := 1024;
  while Count = 1024 do begin
    //Count := Stream.Read(Buf1, 1024);
    Count2 := 0;
    I := 0;
    while I < Count do begin
      B := Buf1[I];
      Count3 := 0;
      while (Buf1[I] = B) and (I < Count) and (Count3 < $30) do begin
        Inc(I);
        Inc(Count3);
      end;
      //if (I = Count) and (Count3 in [2..$2F]) and (Count = 1024) then
      if (I = Count) and (Count3 > 2) and (Count <$2F) and (Count = 1024) then
        Stream.Position := Stream.Position - Count3
      else begin
        if Count3 = 1 then begin
          if (B and $C0) = $C0 then begin
            Buf2[Count2] := $C1;
            Buf2[Count2 + 1] := B;
            //Inc(Count2, 2);
            Count2:= count2 + 2;
          end
          else begin
            Buf2[Count2] := B;
            Inc(Count2);
          end;
        end
        else begin
          Buf2[Count2] := Count3 or $C0;
          Buf2[Count2 + 1] := B;
          //Inc(Count2, 2);
         Count2:= count2 + 2;
        end;
      end;
    end;
    //Tmp.Write(Buf2, Count2);
  end;
  Tmp.Position := 0;
  Stream.Size := 0;
  Stream.CopyFrom(Tmp, Tmp.Size);
  Tmp.Free;
end;

procedure RleDecompressTest(Stream: TStream);
var
  Count, Count2, Count3, I: Integer;
  Buf1: array [0..1024] of Byte;
  Buf2: array [0..60000] of Byte;
  B: Byte;
  Tmp: TMemoryStream;
begin
  Tmp := TMemoryStream.Create;
  Stream.Position := 0;
  Count := 1024;
  while Count = 1024 do
  begin
    //Count := Stream.Read(Buf1, 1024);
    Count2 := 0;
    I := 0;
    while I < Count do begin
      if (Buf1[I] and $C0) = $C0 then begin
        if I = Count - 1 then
          Stream.Position := Stream.Position - 1
        else begin
          B := Buf1[I] and $3F;
          Inc(I);
          for Count3 := Count2 to Count2 + B - 1 do
            Buf2[Count3] := Buf1[I];
          Count2 := Count2 + B;
        end;
      end
      else begin
        Buf2[Count2] := Buf1[I];
        Inc(Count2);
      end;
      Inc(I);
    end;
    //Tmp.Write(Buf2, Count2);
  end;
  Tmp.Position := 0;
  Stream.Size := 0;
  Stream.CopyFrom(Tmp, Tmp.Size);
  Tmp.Free;
end;


Procedure AllBooleanPattern(aX, aY: integer);
begin
    Writeln(#13#10+'************** All Booolean Functions **************');
    PrintF('%-36s 01 False',[inttobin(0)])
    PrintF('%-36s 02 AND',[inttobin(aX AND aY)])
    PrintF('%-36s 03 Inhibit',[inttobin(aX AND NOT aY)])
    PrintF('%-36s 04 Prepend',[inttobin(aX)])
    PrintF('%-36s 05 Praesect',[inttobin(NOT aX AND aY)])
    PrintF('%-36s 06 Postpend',[inttobin(aY)])
    PrintF('%-36s 07 XOR',[inttobin(aX XOR aY)])
    PrintF('%-36s 08 OR',[inttobin(aX OR aY)])
    PrintF('%-36s 09 NOR',[inttobin(NOT(aX OR aY))])
    PrintF('%-36s 10 Aequival',[inttobin((NOT aX OR aY)AND(NOT aY OR aX))])
    PrintF('%-36s 11 NegY',[inttobin(NOT aY)])
    PrintF('%-36s 12 ImplicatY',[inttobin(aX OR NOT aY)])
    PrintF('%-36s 13 NegX',[inttobin(NOT aX)])
    PrintF('%-36s 14 ImplicatX',[inttobin(NOT aX OR aY)])
    PrintF('%-36s 15 NAND',[inttobin(NOT(aX AND aY))])
    PrintF('%-36s 16 True',[inttobin(NOT 0)])
end;

 var tempstream: TStream;

BEGIN  //Main
//<Executable statements>

if GetTextFromFile(Exepath+'examples/firstdemo_compress.txt',st) then
    ShowMessageBig(st);
    
       fileStream.Seek(0, 0)
       //writeln(StreamtoString(fileStream))
       //StringToStream
       fileStream.Seek(0, 0)
       writeln('file stream size '+inttostr(filestream.size));
       fileStream.Free;
    
       //tempStream:= TFileStream.create(Exepath+'firstdemo.txt',fmShareExclusive);
       tempStream:= TFileStream.create(Exepath+'examples/firstdemo_compress.txt',fmOpenReadWrite);
       try
         RleCompress2(tempStream);
         tempStream.Seek(0, 0)
         writeln('RLE compress '+StreamtoString(tempStream))
      
         RleDECompress2(tempStream);
         tempStream.Seek(0, 0)
         writeln('RLE decompress '+StreamtoString(tempStream))
       finally
        //fileStream.Free;
         tempStream.Free;
       end;
       
       midilist:= TStringList.create;
       GetMidiOutputs(midilist);
       for i:= 1 to midilist.count -1 do 
         writeln(midilist.strings[i]);
       midilist.Free;
  
   //RleDecompress( Stream : TStream)');
   div_dbl:= 5.0 / 2.0; // 2.500000
   writeln(Format('%0.6f', [div_dbl]))
   div_dbl:= 20 mod 3;  // 2.00000
   writeln(Format('%f', [div_dbl]))
   a:= 5; b:= 6;
   if not (A<>B) then writeln('even') else
                    writeln('odd');   
   if (A=B) then writeln('even') else
                    writeln('odd');   

   // wholee ASCII Table
   {for i:= 0 to 255 do
     writeln(format('wert %d %s',[i, Chr(i)]))}

    writeln(Format('%s',[inttobin(97)]))
    writeln(Format('%s',[inttobin(223)]))
    writeln(Format('%s',[inttobin(97 XOR 223)]))
    bin1:= 97;
    bin2:= 223;
    bin3:= bin1 XOR bin2;
    writeln(Format('%s',[IntToBin(bin3)]))
    writeln(' ');
    wd:= 150;
    writeln('first     '+IntToBin(wd))
    writeln(IntToStr(wd))
    
    //double the value
    wd:= wd SHL 1
    writeln('double '+IntToBin(wd))
    writeln(IntToStr(wd))
    //half the value
    wd:= wd SHR 1
    writeln('half     '+IntToBin(wd))
    writeln(IntToStr(wd))
    //init the value
    writeln('init      '+IntToBin(wd))
    writeln('          '+IntToBin(wd XOR wd))

    //AllBooleanPattern(10,12);
END. 


       (A<>B)  NOT --> A=B
        0  0 0 1       0 0
        0  1 1 0
        1  0 1 0
        1  1 0 1       1 1
        
        //19.8. um 16 Uhr PT1 Update
        
  XOR App      
  0110 0001
^ 1101 1111
-----------
  1011 1110
        
        
  00000000000000000000000100101100 XOR
  00000000000000000000000100101100
                         000000000
                         
00000000000000000000000000000000     01 False
00000000000000000000000000001000     02 AND
00000000000000000000000000000010     03 Inhibit
00000000000000000000000000001010     04 Prepend
00000000000000000000000000000100     05 Praesect
00000000000000000000000000001100     06 Postpend
00000000000000000000000000000110     07 XOR
00000000000000000000000000001110     08 OR
11111111111111111111111111110001     09 NOR
11111111111111111111111111111001     10 Aequival
11111111111111111111111111110011     11 NegY
11111111111111111111111111111011     12 ImplicatY
11111111111111111111111111110101     13 NegX
11111111111111111111111111111101     14 ImplicatX
11111111111111111111111111110111     15 NAND
11111111111111111111111111111111     16 True                         

----app_template_loaded----


procedure RleCompress(Stream: TStream);
var
  Count, Count2, Count3, I: Integer;
  Buf1: array [0..1024] of Byte;
  Buf2: array [0..60000] of Byte;
  B: Byte;
  Tmp: TMemoryStream;
begin
  Tmp := TMemoryStream.Create;
  Stream.Position := 0;

  Count := 1024;
  while Count = 1024 do
  begin
    Count := Stream.Read(Buf1, 1024);
    Count2 := 0;
    I := 0;
    while I < Count do
    begin
      B := Buf1[I];
      Count3 := 0;
      while (Buf1[I] = B) and (I < Count) and (Count3 < $30) do
      begin
        Inc(I);
        Inc(Count3);
      end;
      if (I = Count) and (Count3 in [2..$2F]) and (Count = 1024) then
        Stream.Position := Stream.Position - Count3
      else
      begin
        if Count3 = 1 then
        begin
          if (B and $C0) = $C0 then
          begin
            Buf2[Count2] := $C1;
            Buf2[Count2 + 1] := B;
            Inc(Count2, 2);
          end
          else
          begin
            Buf2[Count2] := B;
            Inc(Count2);
          end;
        end
        else
        begin
          Buf2[Count2] := Count3 or $C0;
          Buf2[Count2 + 1] := B;
          Inc(Count2, 2);
        end;
      end;
    end;
    Tmp.Write(Buf2, Count2);
  end;

  Tmp.Position := 0;
  Stream.Size := 0;
  Stream.CopyFrom(Tmp, Tmp.Size);
  Tmp.Free;
end;

procedure RleDecompress(Stream: TStream);
var
  Count, Count2, Count3, I: Integer;
  Buf1: array [0..1024] of Byte;
  Buf2: array [0..60000] of Byte;
  B: Byte;
  Tmp: TMemoryStream;
begin
  Tmp := TMemoryStream.Create;
  Stream.Position := 0;

  Count := 1024;
  while Count = 1024 do
  begin
    Count := Stream.Read(Buf1, 1024);
    Count2 := 0;
    I := 0;
    while I < Count do
    begin
      if (Buf1[I] and $C0) = $C0 then
      begin
        if I = Count - 1 then
          Stream.Position := Stream.Position - 1
        else
        begin
          B := Buf1[I] and $3F;
          Inc(I);
          for Count3 := Count2 to Count2 + B - 1 do
            Buf2[Count3] := Buf1[I];
          Count2 := Count2 + B;
        end;
      end
      else
      begin
        Buf2[Count2] := Buf1[I];
        Inc(Count2);
      end;
      Inc(I);
    end;
    Tmp.Write(Buf2, Count2);
  end;

  Tmp.Position := 0;
  Stream.Size := 0;
  Stream.CopyFrom(Tmp, Tmp.Size);
  Tmp.Free;
end;