unit dwide;

{$MODE FPC}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}

interface

uses
  dutf8,
  dutf16;

//
//  NewWideFromUTF8
//
//      Converts the specified UTF8 string S to Wide string (should not be
//      confused with UTF16 strings). Tries to use the specified Buf as a
//      buffer for resulting string if it has enough space. If not, allocates
//      new memory with GetMem.
//
//      Returns nil on error.
//
//      FreeWideFromUTF8 should be used to free returned string.
//
//  Parameters:
//
//      S: the beginning of the UTF8 string
//      SEnd: the end of the UTF8 string, Length=SEnd-S
//      Buf: the beginning of the small buffer
//      BufEnd: the end of the small buffer
//
//  Returns on success:
//
//      Result: Buf or pointer to newly allocated memory
//
//  Errors:
//
//      Returns Result=nil on any error. Possible errors:
//
//      1. S is not UTF8 string
//      2. S cannot be converted to Wide string
//      3. Out of memory
//
function NewWideFromUTF8(S, SEnd: PAnsiChar;
                         Buf, BufEnd: PWideChar): PWideChar;

//
//  FreeWideFromUTF8
//
//      Frees the specified Wide string W, previously created with
//      NewWideFromUTF8.
//
//      If NewWideFromUTF8, FreeWideFromUTF8 should not be used.
//
//  Parameters:
//
//      W: the string, returned by NewWideFromUTF8
//      Buf: the same value of Buf that has been passed to NewWideFromUTF8
//
procedure FreeWideFromUTF8(W: PWideChar;
                           Buf: PWideChar);

implementation

function TryUTF8ToWide(var S: PAnsiChar;
                       SEnd: PAnsiChar;
                       var Buf: PWideChar;
                       BufEnd: PWideChar;
                       out Count: SizeUInt): Boolean;
label
  LCount;
var
  U: Cardinal;
  SavedS: PAnsiChar;
begin
  Count := 0;

  // First half of the function: try to save converted string
  // to the specified buffer
  while DecodeUTF8Char(S, SEnd, U) do begin
    // Check if U can be represented as 2-byte WideChar
    if GetUTF16CharSize(U) > 2 then begin
      Count := 0;
      Exit(False);
    end;
    Inc(Count);
    if not EncodeUTF16Char(U, Buf, BufEnd) then begin
      if Buf < BufEnd then begin // something went wrong
        Count := 0;
        Exit(False);
      end;
      goto LCount;
    end;
  end;
  if S < SEnd then begin // checks if previous loop failed on invalid data
    Count := 0;
    Exit(False);
  end;
  if Buf < BufEnd then begin
    Buf^ := #0;
    Inc(Buf);
    Exit(True);
  end;
  Exit(True);

LCount:
  SavedS := S;
  // Second half of the function: just count number of characters
  // in the string.
  while DecodeUTF8Char(S, SEnd, U) do begin
    if GetUTF16CharSize(U) > 2 then begin
      Count := 0;
      Exit(False);
    end;
    Inc(Count);
  end;
  if S < SEnd then begin // checks if previous loop failed on invalid data
    Count := 0;
    Exit(False);
  end;
  S := SavedS;
  Inc(Count); // for #0
  Exit(False);
end;

function NewWideFromUTF8(S, SEnd: PAnsiChar;
                         Buf, BufEnd: PWideChar): PWideChar;
var
  SavedS: PAnsiChar;
  SavedBuf: PWideChar;
  Size: SizeUInt;
begin
  SavedS := S;
  SavedBuf := Buf;
  if TryUTF8ToWide(S, SEnd, Buf, BufEnd, Size) then
    Exit(SavedBuf);
  if Size = 0 then
    Exit(nil);
  Size := 2 * Size;
  Result := GetMem(Size);
  // Do not convert first part again - copy it
  Move(SavedBuf^, Result^, 2 * (Buf - SavedBuf));
  Buf := PWideChar(Result) + (Buf - SavedBuf);
  if not TryUTF8ToWide(S, SEnd, Buf, Pointer(Result) + Size, Size) then begin
    // something went wrong
    FreeMem(Result);
    Exit(nil);
  end;
end;

procedure FreeWideFromUTF8(W: PWideChar;
                           Buf: PWideChar);
begin
  if W <> Buf then
    FreeMem(Pointer(W));
end;

end.
