Changeset 172

Timestamp:

Feb 22, 2011, 1:53:47 PM (13 years ago)

Author:

george

Message:

• Fixed: Writing and reading Unicode characters in string.
• Added: Demo for VarBlockSerializer.
• Added: Write and read array of string.

Location:

CoolStreaming

Files:

• CoolStreaming.lpk (modified) (2 diffs)
• Demo/VarBlockSerializer (added)
• Demo/VarBlockSerializer/UMainForm.lfm (added)
• Demo/VarBlockSerializer/UMainForm.pas (added)
• Demo/VarBlockSerializer/VarBlockSerializerDemo.ico (added)
• Demo/VarBlockSerializer/VarBlockSerializerDemo.lpi (added)
• Demo/VarBlockSerializer/VarBlockSerializerDemo.lpr (added)
• Demo/VarBlockSerializer/VarBlockSerializerDemo.res (added)
• UStreamHelper.pas (modified) (3 diffs)
• UVarBlockSerializer.pas (modified) (19 diffs)

CoolStreaming/CoolStreaming.lpk

@@ -6 +6 @@
     <Author Value="Chronos"/>
     <CompilerOptions>
-      <Version Value="9"/>
+      <Version Value="10"/>
       <PathDelim Value="\"/>
       <SearchPaths>
@@ -49 +49 @@
     </Files>
     <Type Value="RunAndDesignTime"/>
-    <RequiredPkgs Count="2">
+    <RequiredPkgs Count="3">
       <Item1>
-        <PackageName Value="TemplateGenerics"/>
+        <PackageName Value="MicroThreading"/>
       </Item1>
       <Item2>
+        <PackageName Value="TemplateGenerics"/>
+      </Item2>
+      <Item3>
         <PackageName Value="FCL"/>
         <MinVersion Major="1" Valid="True"/>
-      </Item2>
+      </Item3>
     </RequiredPkgs>
     <UsageOptions>

CoolStreaming/UStreamHelper.pas

@@ -6 +6 @@
 
 uses
-  Classes, DateUtils, syncobjs;
+  Classes, DateUtils, syncobjs, UMicroThreading;
 
 type
@@ -63 +63 @@
 
   TThreadStreamHelper = class(TStreamHelper)
-    Lock: TCriticalSection;
+    Lock: TMicroThreadCriticalSection;
     procedure Clear;
     constructor Create;
@@ -363 +363 @@
 begin
   inherited Create;
-  Lock := TCriticalSection.Create;
+  Lock := TMicroThreadCriticalSection.Create;
 end;
 

CoolStreaming/UVarBlockSerializer.pas

@@ -1 @@
-// 2010-03-30
+// 2011-02-22
 
 unit UVarBlockSerializer;
@@ -5 +5 @@
 {$mode Delphi}{$H+}
 
-// One recursive VarInt size level supported
+// One level of recursive VarInt size supported
 // Biggest UInt type is QWord (64-bit)
 
@@ -12 +12 @@
 uses
   Classes, DateUtils, UStreamHelper, Math, SysUtils, USubStream,
-  Contnrs, SpecializedList;
+  Contnrs, SpecializedList, LCLProc;
 
 const
   BitAlignment = 8;
-  RealBase = 2;
 
 type
@@ -44 +43 @@
     procedure WriteVarSInt(Value: Int64);
     function ReadVarSInt: Int64;
-    procedure WriteVarFloat(Value: Double);
-    function ReadVarFloat: Double;
+    procedure WriteVarFloat(Value: Double; Base: Integer = 2);
+    function ReadVarFloat(Base: Integer = 2): Double;
     procedure WriteVarString(Value: string);
     function ReadVarString: string;
@@ -87 +86 @@
     procedure WriteVarString(Index: Integer; Value: string);
     function ReadVarString(Index: Integer): string;
-    procedure WriteVarIntegerArray(Index: Integer; List: TListInteger);
-    procedure ReadVarIntegerArray(Index: Integer; List: TListInteger);
+    procedure WriteVarUIntArray(Index: Integer; List: TListInteger);
+    procedure ReadVarUIntArray(Index: Integer; List: TListInteger);
+    procedure WriteVarStringArray(Index: Integer; List: TListString);
+    procedure ReadVarStringArray(Index: Integer; List: TListString);
 
     procedure Clear;
@@ -198 +199 @@
     Data := Stream.ReadByte;
     if I = 0 then begin
-      Length := DecodeUnaryLength(Data);
-      if Length > (BitAlignment) then
-        raise Exception.Create(SUInt64Overflow);
-      LengthMask := GetUnaryLengthMask(Length);
-      Data := Data and (LengthMask xor $ff);
+      if Data = $ff then begin
+        // Read recursive length
+        Length := ReadVarUInt;
+        if Length > BitAlignment then
+          raise Exception.Create(SUInt64Overflow);
+        if Length > 0 then Data := Stream.ReadByte else
+          Data := 0;
+      end else begin
+        Length := DecodeUnaryLength(Data);
+        LengthMask := GetUnaryLengthMask(Length);
+        Data := Data and (LengthMask xor $ff);
+      end;
     end;
     Result := Result or (QWord(Data) shl ((Length - I - 1) * BitAlignment));
@@ -219 +227 @@
 end;
 
-procedure TVarBlockSerializer.WriteVarFloat(Value: Double);
+procedure TVarBlockSerializer.WriteVarFloat(Value: Double; Base: Integer = 2);
 var
   Exponent: Integer;
@@ -229 +237 @@
     // Normalize to integer number with base 10 exponent
     Exponent := 0;
-    while Frac(Value) > 0 do begin
-      Value := Value * RealBase;
-      Dec(Exponent);
-    end;
-    while Frac(Value / RealBase) = 0 do begin
-      Value := Value / RealBase;
-      Inc(Exponent);
+    if Value <> 0 then begin
+      if Frac(Value) > 0 then begin
+        while Frac(Value) > 0 do begin
+          Value := Value * Base;
+          Dec(Exponent);
+        end;
+      end else
+      while Frac(Value / Base) = 0 do begin
+        Value := Value / Base;
+        Inc(Exponent);
+      end;
     end;
     Block.WriteVarSInt(Trunc(Value));
@@ -245 +257 @@
 end;
 
-function TVarBlockSerializer.ReadVarFloat: Double;
+function TVarBlockSerializer.ReadVarFloat(Base: Integer = 2): Double;
 var
   Significant: Int64;
@@ -256 +268 @@
     Significant := Block.ReadVarSInt;
     Exponent := Block.ReadVarSInt;
-    Result := Significant * IntPower(RealBase, Exponent);
+    Result := Significant * IntPower(Base, Exponent);
   finally
     Block.Free;
@@ -266 +278 @@
   Stream: TVarBlockSerializer;
   I: Integer;
+  P: PChar;
+  Unicode: Cardinal;
+  CharLen: Integer;
 begin
   try
     Stream := TVarBlockSerializer.Create;
-    for I := 1 to Length(Value) do
-      Stream.WriteVarUInt(Integer(Value[I]));
+    P := PChar(Value);
+    for I := 0 to UTF8Length(Value) - 1 do begin
+      Unicode := UTF8CharacterToUnicode(P, CharLen);
+      Stream.WriteVarUInt(Unicode);
+      Inc(P, CharLen);
+    end;
     WriteVarBlock(Stream);
   finally
@@ -288 +307 @@
     while Block.Stream.Position < Block.Stream.Size do begin
       Character := Block.ReadVarUInt;
-      Result := Result + Char(Character);
+      Result := Result + UnicodeToUTF8(Character);
     end;
   finally
@@ -352 +371 @@
   I := 0;
   Length := 1;
-  while I < Length do begin
+
     Data := Stream.ReadByte;
-    if I = 0 then begin
       if Data = $ff then begin
         // Read recursive length
         Length := ReadVarUInt;
         AStream.Size := Length;
-        Data := Stream.ReadByte;
-        AStream.WriteByte(Data);
+        if Length > 0 then begin
+          Data := Stream.ReadByte;
+          AStream.WriteByte(Data);
+        end;
       end else begin
         // Read unary length
@@ -367 +387 @@
         LengthMask := GetUnaryLengthMask(Length);
         Data := Data and (LengthMask xor $ff);
-        // Drop first byte if first data zero
+        // Drop first byte if first data is zero
         if Data <> 0 then AStream.WriteByte(Data)
           else begin
@@ -378 +398 @@
           end;
       end;
-    end else AStream.WriteByte(Data);
-    Inc(I);
-  end;
+
+  // If CopyFrom parameter count is zero then whole source is copied
+  if Length > 1 then
+    AStream.CopyFrom(Stream, Length - 1);
   AStream.Position := 0;
 end;
@@ -572 +593 @@
 procedure TVarBlockIndexed.ReadVarBlock(Index: Integer; Block: TVarBlockSerializer);
 begin
-  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
-  TVarBlockSerializer(Items[Index]).ReadVarBlock(Block);
+  with TVarBlockSerializer(Items[Index]) do begin
+    Stream.Position := 0;
+    ReadVarBlock(Block);
+  end;
 end;
 
@@ -650 +673 @@
 function TVarBlockIndexed.ReadVarString(Index: Integer):string;
 begin
-  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
-  Result := TVarBlockSerializer(Items[Index]).ReadVarString;
-end;
-
-procedure TVarBlockIndexed.WriteVarIntegerArray(Index: Integer;
+  with TVarBlockSerializer(Items[Index]) do begin
+    Stream.Position := 0;
+    Result := ReadVarString;
+  end;
+end;
+
+procedure TVarBlockIndexed.WriteVarUIntArray(Index: Integer;
   List: TListInteger);
 var
@@ -670 +695 @@
 end;
 
-procedure TVarBlockIndexed.ReadVarIntegerArray(Index: Integer;
+procedure TVarBlockIndexed.ReadVarUIntArray(Index: Integer;
   List: TListInteger);
 var
@@ -681 +706 @@
     while Temp.Stream.Position < Temp.Stream.Size do begin
       List.Add(Temp.ReadVarUInt);
+    end;
+  finally
+    Temp.Free;
+  end;
+end;
+
+procedure TVarBlockIndexed.WriteVarStringArray(Index: Integer;
+  List: TListString);
+var
+  I: Integer;
+  Temp: TVarBlockSerializer;
+begin
+  try
+    Temp := TVarBlockSerializer.Create;
+    for I := 0 to List.Count - 1 do
+      Temp.WriteVarString(List[I]);
+    WriteVarBlock(Index, Temp);
+  finally
+    Temp.Free;
+  end;
+end;
+
+procedure TVarBlockIndexed.ReadVarStringArray(Index: Integer; List: TListString
+  );
+var
+  Temp: TVarBlockSerializer;
+begin
+  try
+    Temp := TVarBlockSerializer.Create;
+    List.Clear;
+    ReadVarBlock(Index, Temp);
+    while Temp.Stream.Position < Temp.Stream.Size do begin
+      List.Add(Temp.ReadVarString);
     end;
   finally