unit CastleClassUtils;

uses Classes, SysUtils, Contnrs, Generics.Collections, Generics.Defaults,

CastleUtils, CastleStringUtils;

procedure StringsAdd(Strs: TStrings; Count: integer; itemVal: string='dummy');

deprecated 'this utility is very trivial and seldom useful; better implement it in yourself, without relying on CastleClassUtils';

procedure AddStrArrayToStrings(const StrArr: array of string; strlist: TStrings);

deprecated 'use TStrings.AddStrings';

{ TStringList that is case sensitive.

TStringListCaseSens = class(TStringList)

constructor Create;

property CaseSensitive default true;

end deprecated;

procedure Strings_AddSplittedString(Strings: TStrings;

const S, Splitter: string);

procedure Strings_SetText(SList: TStrings; const S: String);

deprecated 'use SList.Text := S';

procedure Strings_Trim(Strings: TStrings; MaxCount: Cardinal);

deprecated 'this utility is very trivial and seldom useful; better implement it in yourself, without relying on CastleClassUtils';

{$define CASTLE_STRINGS_HELPER_ADDSTRINGS}

TStringsHelper = class helper for TStringList

procedure AddStrings(const A: array of String); overload;

end;

procedure WriteStr(const Stream: TStream; const S: Utf8String); overload;

procedure WritelnStr(const Stream: TStream; const S: Utf8String); overload;

procedure WriteStr(const S: Utf8String); overload;

procedure WritelnStr(const S: Utf8String); overload;

procedure WriteStr(const Stream: TStream; const S: String); overload;

procedure WritelnStr(const Stream: TStream; const S: String); overload;

procedure WriteStr(const S: String); overload;

procedure WritelnStr(const S: String); overload;

function StreamReadChar(Stream: TStream): AnsiChar;

function StreamReadZeroEndString(Stream: TStream): Utf8String;

function StreamReadUpto_NotEOS(Stream: TStream; const endingChars: TSetOfChars;

backEndingChar: boolean; out endingChar: AnsiChar): Utf8String; overload;

function StreamReadUpto_NotEOS(Stream: TStream; const endingChars: TSetOfChars;

backEndingChar: boolean): Utf8String; overload;

function StreamReadUpto_NotEOS(Stream: TStream; const endingChars: TSetOfChars;

out endingChar: AnsiChar): Utf8String; overload;

function StreamReadUpto_NotEOS(Stream: TStream; const endingChars: TSetOfChars): Utf8String; overload;

function StreamReadUpto_EOS(Stream: TStream; const endingChars: TSetOfChars;

backEndingChar: boolean; out endingChar: integer): Utf8String; overload;

function StreamReadUpto_EOS(Stream: TStream; const endingChars: TSetOfChars;

backEndingChar: boolean): Utf8String; overload;

function StreamReadUpto_EOS(Stream: TStream; const endingChars: TSetOfChars;

out endingChar: integer): Utf8String; overload;

function StreamReadUpto_EOS(Stream: TStream; const endingChars: TSetOfChars): Utf8String; overload;

procedure ReadGrowingStream(const GrowingStream, DestStream: TStream;

const ResetDestStreamPosition: Boolean;

const BufferSize: Cardinal = 10 * 1000);

function ReadGrowingStreamToString(const GrowingStream: TStream): Utf8String;

function ReadGrowingStreamToDefaultString(const GrowingStream: TStream): String;

procedure StreamWriteString(const Stream: TStream; const S: Utf8String);

function StreamReadString(const Stream: TStream): Utf8String;

function StreamToString(const Stream: TStream): Utf8String;

procedure MemoryStreamLoadFromString(const Stream: TMemoryStream;

const S: Utf8String; const Rewind: boolean = true); overload;

function MemoryStreamLoadFromString(

const S: Utf8String; const Rewind: boolean = true): TMemoryStream; overload;

procedure MemoryStreamLoadFromDefaultString(const Stream: TMemoryStream;

const S: String; const Rewind: boolean = true); overload;

function MemoryStreamLoadFromDefaultString(

const S: String; const Rewind: boolean = true): TMemoryStream; overload;

EStreamNotImplemented = class(Exception);

EStreamNotImplementedWrite = class(EStreamNotImplemented);

EStreamNotImplementedSeek = class(EStreamNotImplemented);

EStreamNotImplementedSetSize = class(EStreamNotImplemented);

{ Abstract class to read another stream, always being able to back one character.

TPeekCharStream = class(TStream)

private

FSourceStream: TStream;

FOwnsSourceStream: boolean;

FLine, FColumn: Int64;

protected

{ @returns(SourceStream.Size). }

function GetSize: Int64; override;

{ This stream doesn't support setting size.

procedure SetSize(NewSize: Longint); override;

{$ifndef FPC}

function GetPosition: Int64; virtual; abstract;

{$endif}

procedure UpdateLineColumn(const C: AnsiChar); overload;

procedure UpdateLineColumn(const Buffer; const BufferCount: Integer); overload;

public

constructor Create(ASourceStream: TStream; AOwnsSourceStream: boolean);

destructor Destroy; override;

{ This stream doesn't support seeking.

function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;

{ This stream doesn't support writing.

function Write(const Buffer; Count: Longint): Longint; override;

{ Underlying stream. }

property SourceStream: TStream read FSourceStream;

{ Should we free underlying SourceStream at destruction. }

property OwnsSourceStream: boolean

read FOwnsSourceStream write FOwnsSourceStream;

{ Peek next character. Returns the next character

function PeekChar: Integer; virtual; abstract;

{ Read next character. A shortcut for Read(c, 1), but it returns -1

function ReadChar: Integer; virtual; abstract;

{ Read characters, until one of EndingChars (or end of stream) is found.

function ReadUpto(const EndingChars: TSetOfChars): Utf8String; virtual;

{$ifndef FPC}

property Position: Int64 read GetPosition;

{$endif}

{ Line number in the file (counting from 1). }

property Line: Int64 read FLine;

{ Column number in the file (counting from 1). }

property Column: Int64 read FColumn;

end;

{ Read another stream, sequentially, always being able to back one character.

TSimplePeekCharStream = class(TPeekCharStream)

private

PeekedChar: Integer;

IsPeekedChar: boolean;

FPosition: Int64;

protected

function GetPosition: Int64; override;

public

function Read(var Buffer; Count: Longint): Longint; override;

function PeekChar: Integer; override;

function ReadChar: Integer; override;

end;

DefaultReadBufferSize = 1024 * 1024;

{ Read another stream, sequentially, always being able to back one character,

TBufferedReadStream = class(TPeekCharStream)

private

FPosition: Int64;

{ Always non-nil, allocated for BufferSize bytes. }

Buffer: PByteArray;

{ A position of the next unread char in Buffer,

BufferPos: Cardinal;

{ Always BufferPos <= BufferEnd.

BufferEnd: Cardinal;

FBufferSize: Cardinal;

{ Sets Buffer contents, BufferEnd reading data from SourceStream.

procedure FillBuffer;

protected

function GetPosition: Int64; override;

public

constructor Create(ASourceStream: TStream; AOwnsSourceStream: boolean;

ABufferSize: Cardinal = DefaultReadBufferSize);

destructor Destroy; override;

function Read(var LocalBuffer; Count: Longint): Longint; override;

function PeekChar: Integer; override;

function ReadChar: Integer; override;

function ReadUpto(const EndingChars: TSetOfChars): Utf8String; override;

property BufferSize: Cardinal read FBufferSize;

end;

procedure CreateIfNeeded(var Component: TComponent;

ComponentClass: TComponentClass; Owner: TComponent);

{ Used by @link(TCastleComponent.PropertySections). }

TPropertySection = (psBasic, psLayout);

TPropertySections = set of TPropertySection;

TCastleComponent = class;

{ Used by @link(TCastleComponent.TranslateProperties). }

TTranslatePropertyEvent = procedure (const Sender: TCastleComponent;

const PropertyName: String; var PropertyValue: String) of object;

{ Call methods of this class within @link(TCastleComponent.CustomSerialization) override.

TSerializationProcess = class abstract

public

type

TListEnumerateEvent = procedure (const Proc: TGetChildProc) of object;

TListAddEvent = procedure (const NewComponent: TComponent) of object;

TListClearEvent = procedure of object;

var

{ @exclude

InternalPreserveDataAcrossUndo: TComponent;

{ Serialize and deserialize given simple Value.

procedure ReadWriteInteger(const Key: String; var Value: Integer; const IsStored: Boolean);

overload; virtual; abstract;

procedure ReadWriteBoolean(const Key: String; var Value: Boolean; const IsStored: Boolean);

overload; virtual; abstract;

procedure ReadWriteString(const Key: String; var Value: String; const IsStored: Boolean);

overload; virtual; abstract;

procedure ReadWriteSingle(const Key: String; var Value: Single; const IsStored: Boolean);

overload; virtual; abstract;

{ @groupEnd }

{ Serialize and deserialize a subcomponent.

procedure ReadWriteSubComponent(const Key: String; const Value: TComponent;

const IsStored: Boolean); virtual; abstract;

{ Make a list serialized and deserialized.

procedure ReadWriteList(const Key: String;

const ListEnumerate: TListEnumerateEvent; const ListAdd: TListAddEvent;

const ListClear: TListClearEvent); virtual; abstract;

{ Is there set with the given Key, and non-empty?

function InternalHasNonEmptySet(const Key: String): Boolean; virtual; abstract;

end;

{ Component with various CGE extensions: can be a parent of other non-visual components

TCastleComponent = class(TComponent)

strict private

type

{ Used by @link(TCastleComponent.NonVisualComponentsEnumerate).

TNonVisualComponentsEnumerator = record

strict private

FParent: TCastleComponent;

FPosition: Integer;

function GetCurrent: TComponent; inline;

public

constructor Create(const AParent: TCastleComponent);

function MoveNext: Boolean; inline;

property Current: TComponent read GetCurrent;

function GetEnumerator: TNonVisualComponentsEnumerator;

end;

var

FNonVisualComponents: TComponentList;

FIsLoading: Boolean;

function GetNonVisualComponents(const Index: Integer): TComponent;

procedure SerializeNonVisualComponentsEnumerate(const Proc: TGetChildProc);

procedure SerializeNonVisualComponentsAdd(const C: TComponent);

procedure SerializeNonVisualComponentsClear;

protected

function GetInternalText: String; virtual;

procedure SetInternalText(const Value: String); virtual;

procedure SetName(const Value: TComponentName); override;

{ Enumerate all properties that are possible to translate in this component.

procedure TranslateProperties(const TranslatePropertyEvent: TTranslatePropertyEvent); virtual;

public

{ Internal field used by CastleComponentSerialize.

InternalOriginalName: String;

destructor Destroy; override;

{ Override this method to call various methods of SerializationProcess,

procedure CustomSerialization(const SerializationProcess: TSerializationProcess); virtual;

{ Main text property, that is synchronized with Name initially.

property InternalText: String read GetInternalText write SetInternalText;

{ Set IsLoading to @true and (only on FPC) add csLoading flag to ComponentState.

procedure InternalLoading;

{ Set IsLoading to @false and (only on FPC) remove csLoading flag from ComponentState

procedure InternalLoaded;

{ Section where to show property in the editor. }

function PropertySections(const PropertyName: String): TPropertySections; virtual;

{ Ignore this component when serializing parent's

procedure SetTransient;

{ Add non-visual component to this component.

procedure AddNonVisualComponent(const NonVisualComponent: TComponent);

{ Insert non-visual component to this component.

procedure InsertNonVisualComponent(const Index: Integer; const NonVisualComponent: TComponent);

{ Removes the component previously added by AddNonVisualComponent. }

procedure RemoveNonVisualComponent(const NonVisualComponent: TComponent);

{ Index of the previously added non-visual component.

function NonVisualComponentsIndexOf(const NonVisualComponent: TComponent): Integer;

{ Count of components added by AddNonVisualComponent.

function NonVisualComponentsCount: Integer;

{ Components added by AddNonVisualComponent. }

property NonVisualComponents [const Index: Integer]: TComponent read GetNonVisualComponents;

{ You can enumerate current non-visual components using loop like

function NonVisualComponentsEnumerate: TNonVisualComponentsEnumerator;

{ Is the component during deserialization now.

property IsLoading: Boolean read FIsLoading;

{ Whether the current value of this object should be written

function ValueIsStreamed: Boolean; virtual;

{ Override to add information that should be visible at design-time.

procedure DesignerInfo(const SList: TStrings); virtual;

{ Override to add warnings that should be visible at design-time.

procedure DesignerWarnings(const SList: TStrings); virtual;

end;

procedure TranslateProperties(const C: TComponent;

const TranslatePropertyEvent: TTranslatePropertyEvent);

{ Used by @link(TCastleComponentFactory.ComponentLoadWithMap)

TComponentMap = class({$ifdef FPC}specialize{$endif} TDictionary<String, TComponent>)

strict private

function GetItem(const Key: String): TComponent;

public

constructor Create; {$ifdef FPC} override; {$else} reintroduce; {$endif}

procedure Add(const Key: String; const Value: TComponent);

procedure AddOrSetValue(const Key: String; const Value: TComponent);

property Items[const Key: String]: TComponent read GetItem write AddOrSetValue; default;

end;

{ Streams to read/write a standard input/output/error of the program.

StdInStream, StdOutStream, StdErrStream: TStream;

{ Extended TObjectStack for Castle Game Engine. }

TCastleObjectStack = class(Contnrs.TObjectStack)

private

function GetCapacity: TListSize;

procedure SetCapacity(const Value: TListSize);

public

{ How many items can this hold without reallocating memory. }

property Capacity: TListSize read GetCapacity write SetCapacity;

end;

{ Extended TObjectQueue for Castle Game Engine. }

TCastleObjectQueue = class(Contnrs.TObjectQueue)

private

function GetCapacity: TListSize;

procedure SetCapacity(const Value: TListSize);

public

{ How many items can this hold without reallocating memory. }

property Capacity: TListSize read GetCapacity write SetCapacity;

end;

{ Extended TObjectList for Castle Game Engine. }

TCastleObjectList = class(Contnrs.TObjectList)

public

{ Create and fill with the contents of given array.

constructor CreateFromArray(const FreeObjects: boolean;

const AItems: array of TObject);

{ Add the contents of the given array to the list. }

procedure AddRange(const A: array of TObject); overload;

procedure AddArray(const A: array of TObject); deprecated 'use AddRange, consistent with other lists';

{ Add the contents of another TObjectList instance to the list. }

procedure AddRange(AList: Contnrs.TObjectList); overload;

procedure AddList(AList: Contnrs.TObjectList); deprecated 'use AddRange, consistent with other lists';

{ Replace first found descendant of ReplaceClass with NewItem.

function MakeSingle(ReplaceClass: TClass; NewItem: TObject;

AddEnd: boolean): TObject; deprecated 'this is a complicated method without clear use-case now; do not use';

{ Extract (remove from the list, but never free) given item index.

function Extract(Index: Integer): TObject; overload;

{ Extract (remove from the list, but never free) first found descendant of

function Extract(RemoveClass: TClass): TObject; overload;