1 files changed, 339 insertions, 0 deletions
diff --git a/gfx/schar16.pas b/gfx/schar16.pas
new file mode 100644
index 00000000..156004ba
--- /dev/null
+++ b/gfx/schar16.pas
@@ -0,0 +1,339 @@
+{ schar16.pas: Function for handling 16 bit unicode in normal 8 bit ansi strings
+  File maintainer: nvitya@freemail.hu
+
+History:
+}
+
+unit schar16;
+
+{$ifdef FPC}
+{$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+const
+  u8escchar  : char = '^';
+  u8escclose : char = ';';
+
+type
+  String16 = string;
+  String8  = string;
+
+  Char16 = packed record
+             char1 : char;
+             char2 : char;
+           end;
+
+function Str8to16(s : String8) : string16; // = u8
+function Str16to8(s : String16) : string8;  // = u16u8
+
+function u8(s : String8) : string16;       // decodes escaped text
+function u8u16(s : String8) : string16;    // same as u8
+function u8noesc(s : String8) : string16;  // inserts #0-s, doesn't use escapes
+
+function u16u8(s : string16) : string8;    // escapes only 256..65535
+function u16u8safe(s : string16) : string8; // escapes 0.31 and 255..65535
+function u16u8trunc(s : string16) : string8; // truncates hi byte, doesn't use escapes ('^' -> '^'), try handle code pages
+// this function could cause information loss
+
+function Length16(s : String16) : integer;
+procedure SetLength16(var s : String16; len : integer);
+
+function Pos16(const s : string16; const searched : string16) : integer;
+function UpCase16(const s : string16) : string16;
+function Upper16(const s : string16) : string16;
+
+function Copy16(s : String16; ind,len : integer) : String16;
+procedure Insert16(s : String16; var dest : string16; ind : integer);
+procedure Delete16(var s : String16; ind, count : integer);
+
+procedure AddChar16(var s : String16; ch16 : Char16); overload;
+procedure AddChar16(var s : String16; w : word); overload;
+
+implementation
+
+uses UnitKeys;
+
+function u8(s : String8) : string16;
+var
+  n : integer;
+  ccode : word;
+  c : char;
+begin
+  // 'asdf^123^452^354;78;
+  result := '';
+  n := 1;
+  while (n <= length(s)) do
+  begin
+    if s[n] = u8escchar then
+    begin
+      inc(n);
+      if (n <= length(s)) and (s[n] = u8escchar) then
+      begin
+        result := result + u8escchar + #0;
+        inc(n);
+        continue;
+      end;
+
+      ccode := 0;
+      while (n <= length(s)) do
+      begin
+        c := s[n];
+        if (c >= '0') and (c <= '9') then ccode := ccode * 10 + (ord(c)-ord('0'))
+        else
+            break;
+        inc(n);
+      end;
+      result := result + chr(lo(ccode)) + chr(hi(ccode));
+
+      if (n <= length(s)) and (s[n] = u8escclose) then inc(n);
+    end
+    else
+    begin
+      result := result + s[n] + #0;
+      inc(n);
+    end;
+  end;
+end;
+
+function u8u16(s : String8) : string16;    // same as u8
+begin
+  result := u8(s);
+end;
+
+function u16u8safe(s : string16) : string8;
+var
+  ccode : word;
+  n : integer;
+  uni : boolean;
+begin
+  result := '';
+  uni := false;
+  n := 1;
+  while n < length(s) do
+  begin
+    ccode := ord(s[n]) + (ord(s[n+1]) shl 8);
+    if (ccode < 32) or (ccode > 254) then
+    begin
+       result := result + u8escchar + IntToStr(ccode);
+       uni := true;
+    end
+    else
+    begin
+      if ccode = ord(u8escchar) then result := result + u8escchar + u8escchar
+      else
+      begin
+        if uni and (ccode >= ord('0')) and (ccode <= ord('9')) then result := result + u8escclose;
+        result := result + chr(ccode);
+      end;
+      uni := false;
+    end;
+    inc(n,2);
+  end;
+end;
+
+function u16u8(s : string16) : string8;
+var
+  ccode : word;
+  n : integer;
+  uni : boolean;
+begin
+  result := '';
+  uni := false;
+  n := 1;
+  while n < length(s) do
+  begin
+    ccode := ord(s[n]) + (ord(s[n+1]) shl 8);
+    if (ccode > 255) then
+    begin
+       result := result + u8escchar + IntToStr(ccode);
+       uni := true;
+    end
+    else
+    begin
+      if ccode = ord(u8escchar) then result := result + u8escchar + u8escchar
+      else
+      begin
+        if uni and (ccode >= ord('0')) and (ccode <= ord('9')) then result := result + u8escclose;
+        result := result + chr(ccode);
+      end;
+      uni := false;
+    end;
+    inc(n,2);
+  end;
+end;
+
+function u16u8trunc(s : string16) : string8;
+var
+  n : integer;
+  i : integer;
+  len : integer;
+  ct,c : char;
+begin
+  SetLength(Result,length16(s));
+  i := 1;
+  len := length16(s);
+  for n := 1 to len do
+  begin
+    ct := s[i+1];
+    c  := s[i];
+    // some hungarian translation:
+    if ct = #1 then
+    begin
+      c := TranslateChar(ct,c);
+    end;
+    Result[n] := c;
+    inc(i,2);
+  end;
+end;
+
+function u8noesc(s: String8): string16;
+var
+  n : integer;
+  i : integer;
+  len : integer;
+begin
+  SetLength16(Result,length(s));
+  i := 1;
+  len := length(s);
+  for n := 1 to len do
+  begin
+    Result[i] :=  s[n];
+    inc(i);
+    Result[i] := #0;
+    inc(i);
+  end;
+end;
+
+function Str8to16(s : String8) : string16;
+begin
+  result := u8(s);
+end;
+
+function Str16to8(s : String16) : string8;
+begin
+  result := u16u8(s);
+end;
+
+{
+function Str8to16(s : String8) : string16;
+var
+  n : integer;
+  i : integer;
+  len : integer;
+begin
+  SetLength16(Result,length(s));
+  i := 1;
+  len := length(s);
+  for n := 1 to len do
+  begin
+    Result[i] :=  s[n];
+    inc(i);
+    Result[i] := #0;
+    inc(i);
+  end;
+end;
+
+function Str16to8(s : String8) : string8;
+var
+  n : integer;
+  i : integer;
+  len : integer;
+  ct,c : char;
+begin
+  SetLength(Result,length16(s));
+  i := 1;
+  len := length16(s);
+  for n := 1 to len do
+  begin
+    ct := s[i+1];
+    c  := s[i];
+    // some hungarian translation:
+    if ct = #1 then
+    begin
+      c := TranslateChar(ct,c);
+    end;
+    Result[n] := c;
+    inc(i,2);
+  end;
+end;
+}
+
+procedure SetLength16(var s : String16; len : integer);
+begin
+  if len >= 0 then SetLength(s,len shl 1);
+end;
+
+function Length16(s : String16) : integer;
+begin
+  Result := Length(s) shr 1;
+end;
+
+function Pos16(const s : string16; const searched : string16) : integer;
+var
+  n: integer;
+begin
+  result := 0;
+  if length16(s) < 1 then Exit;
+  for n := 1 to Length16(searched)-Length16(s) do
+  begin
+    if CompareMem(@s[1], @searched[n*2-1], Length16(s)) then
+    begin
+      result := n;
+      Exit;
+    end;
+  end;
+end;
+
+function UpCase16(const s : string16) : string16;
+begin
+  if length(s) < 2 then Exit;
+  if s[2] = #0 then Result := UpCase(s[1])+#0
+  else
+  begin
+    result := chr(ord(s[1]) and $FE) + s[2];
+  end;
+end;
+
+function Upper16(const s : string16) : string16;
+var
+  n : integer;
+begin
+  result := '';
+  for n := 1 to length16(s) do
+  begin
+    result := result + UpCase16(s[n*2-1]+s[n*2]);
+  end;
+end;
+
+function Copy16(s : String16; ind,len : integer) : String16;
+begin
+  result := copy(s,1 + ((ind-1) shl 1), len shl 1);
+end;
+
+procedure Insert16(s : String16; var dest : string16; ind : integer);
+begin
+  Insert(s,dest,1 + ((ind-1) shl 1));
+end;
+
+procedure Delete16(var s : String16; ind, count : integer);
+begin
+  Delete(s,1 + ((ind-1) shl 1), count shl 1);
+end;
+
+procedure AddChar16(var s : String16; ch16 : Char16);
+begin
+  s := s + ch16.char1 + ch16.char2;
+end;
+
+procedure AddChar16(var s : String16; w : word);
+begin
+  s := s + chr(lo(w)) + chr(hi(w));
+end;
+
+end.
+