unit string4unit2;

{
    UTF32 unit.
    For GNU/Linux 64 bit version.
    Version: 1.
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    Used https://chat.deepseek.com/
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

{$MODE OBJFPC}{$H+}

interface

uses
  SysUtils, LazUTF8, BaseUnix;

type
  string4 = class
  private
    FData: array of UInt32; // UTF-32/UCS-4
    function GetLength: Integer;
    function GetChar(Index: Integer): UInt32;
    procedure SetChar(Index: Integer; Value: UInt32);
  public
    constructor Create;
    destructor Destroy; override;

    procedure FromUTF8(const S: string);
    function ToUTF8: string;

    property Length: Integer read GetLength;
    property Chars[Index: Integer]: UInt32 read GetChar write SetChar; default;

    function Concat(const S: string4): string4;
    function IsRTL: Boolean;
    procedure Reverse;
    procedure Clear;
    procedure Reserve(Capacity: Integer);

    // Прямой вывод UTF-32 через sys_write
    procedure WriteRawUTF32;

function TryEnableUTF32Mode: Boolean;
function IsUTF32ModeEnabled: Boolean;
  end;

implementation

uses
  Linux;

const
  KDSETMODE   = $4B3A;
  KDGETMODE   = $4B3B;
  KD_TEXT     = 0;
  KD_GRAPHICS = 1;
  KD_UTF8     = 2;
  KD_UTF32    = 3; // Гипотетический флаг (может не работать!)

constructor string4.Create;
begin
  inherited Create;
  SetLength(FData, 0);
end;

destructor string4.Destroy;
begin
  SetLength(FData, 0);
  inherited Destroy;
end;

procedure string4.FromUTF8(const S: string);
var
  UTF8Ptr: PChar;
  CharLen: Integer;
  CodePoint: UInt32;
begin
  SetLength(FData, 0);
  UTF8Ptr := PChar(S);
  while UTF8Ptr^ <> #0 do
  begin
    CodePoint := UTF8CodepointToUnicode(UTF8Ptr, CharLen);
    if CodePoint = 0 then Break;
    SetLength(FData, System.Length(FData) + 1);
    FData[High(FData)] := CodePoint;
    Inc(UTF8Ptr, CharLen);
  end;
end;

function string4.ToUTF8: string;
var
  I: Integer;
  UTF8Char: string;
begin
  Result := '';
  for I := 0 to High(FData) do
  begin
    UTF8Char := UnicodeToUTF8(FData[I]);
    Result := Result + UTF8Char;
  end;
end;

function string4.GetLength: Integer;
begin
  Result := System.Length(FData);
end;

function string4.GetChar(Index: Integer): UInt32;
begin
  if (Index < 0) or (Index >= System.Length(FData)) then
    raise Exception.Create('Index out of bounds');
  Result := FData[Index];
end;

procedure string4.SetChar(Index: Integer; Value: UInt32);
begin
  if (Index < 0) or (Index >= System.Length(FData)) then
    raise Exception.Create('Index out of bounds');
  FData[Index] := Value;
end;

function string4.Concat(const S: string4): string4;
var
  I: Integer;
begin
  Result := string4.Create;
  SetLength(Result.FData, Self.Length + S.Length);
  for I := 0 to Self.Length - 1 do
    Result.FData[I] := Self.FData[I];
  for I := 0 to S.Length - 1 do
    Result.FData[Self.Length + I] := S.FData[I];
end;

function string4.IsRTL: Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to High(FData) do
  begin
    if (FData[I] >= $0590) and (FData[I] <= $08FF) then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

procedure string4.Reverse;
var
  I, J: Integer;
  Temp: UInt32;
begin
  I := 0;
  J := High(FData);
  while I < J do
  begin
    Temp := FData[I];
    FData[I] := FData[J];
    FData[J] := Temp;
    Inc(I);
    Dec(J);
  end;
end;

procedure string4.Clear;
begin
  SetLength(FData, 0);
end;

procedure string4.Reserve(Capacity: Integer);
begin
  if Capacity > System.Length(FData) then
    SetLength(FData, Capacity);
end;

function string4.TryEnableUTF32Mode: Boolean;
begin
  Result := (FpIOCtl(StdInputHandle, KDSETMODE, Pointer(KD_UTF32)) = 0);
end;

function string4.IsUTF32ModeEnabled: Boolean;
var
  Mode: Integer;
begin
  Mode := KD_TEXT;
  FpIOCtl(StdInputHandle, KDGETMODE, @Mode);
  Result := (Mode = KD_UTF32);
end;

procedure string4.WriteRawUTF32;
begin
  if (Length = 0) then Exit;

  // Если режим UTF-32 не включён, пробуем его активировать
  if not IsUTF32ModeEnabled then
    TryEnableUTF32Mode;

  // Пытаемся вывести UTF-32
  if (FpWrite(StdOutputHandle, @FData[0], Length * SizeOf(UInt32)) = -1) then
    Write(ToUTF8()); // Fallback на UTF-8
end;

end.