- set svn:eol-style to native

- removed some svn:executable properties from non-executable files

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1144 b956fd51-792f-4845-bead-9b4dfca2ff2c

1 files changed, 791 insertions, 791 deletions

diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas
index f3edd62a..418c0c1a 100644
--- a/Game/Code/Classes/UCommon.pas
+++ b/Game/Code/Classes/UCommon.pas
@@ -1,791 +1,791 @@
-unit UCommon;

-

-interface

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-{$ENDIF}

-

-{$I switches.inc}

-

-uses

-  SysUtils,

-  Classes,

-  {$IFDEF MSWINDOWS}

-  Windows,

-  Messages,

-  {$ENDIF}

-  sdl,

-  ULog;

-

-{$IFNDEF DARWIN}

-// FIXME: remove this if it is not needed anymore

-type

-  hStream        = THandle;

-  HGLRC          = THandle;

-  TLargeInteger  = Int64;

-  TWin32FindData = LongInt;

-{$ENDIF}

-

-type

-  TMessageType = ( mtInfo, mtError );

-

-procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo );

-

-procedure ConsoleWriteLn(const msg: string);

-

-function GetResourceStream(const aName, aType : string): TStream;

-function RWopsFromStream(Stream: TStream): PSDL_RWops;

-

-{$IFDEF FPC}

-function RandomRange(aMin: Integer; aMax: Integer) : Integer;

-{$ENDIF}

-

-{$IF Defined(MSWINDOWS) and Defined(FPC)}

-function  AllocateHWnd(Method: TWndMethod): HWND;

-procedure DeallocateHWnd(hWnd: HWND);

-{$IFEND}

-

-function StringReplaceW(text : WideString; search, rep: WideChar):WideString;

-function AdaptFilePaths( const aPath : widestring ): widestring;

-

-procedure DisableFloatingPointExceptions();

-procedure SetDefaultNumericLocale();

-procedure RestoreNumericLocale();

-

-{$IFNDEF MSWINDOWS}

-  procedure ZeroMemory( Destination: Pointer; Length: DWORD );

-  function MakeLong(a, b: Word): Longint;

-  (*

-  #define LOBYTE(a) (BYTE)(a)

-  #define HIBYTE(a) (BYTE)((a)>>8)

-  #define LOWORD(a) (WORD)(a)

-  #define HIWORD(a) (WORD)((a)>>16)

-  #define MAKEWORD(a,b) (WORD)(((a)&0xff)|((b)<<8))

-  *)

-{$ENDIF}

-

-function FileExistsInsensitive(var FileName: string): boolean;

-

-(*

- * Character classes

- *)

-

-function IsAlphaChar(ch: WideChar): boolean;

-function IsNumericChar(ch: WideChar): boolean;

-function IsAlphaNumericChar(ch: WideChar): boolean;

-function IsPunctuationChar(ch: WideChar): boolean;

-function IsControlChar(ch: WideChar): boolean;

-

-// A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below)

-procedure MergeSort(List: TList; CompareFunc: TListSortCompare);

-

-

-implementation

-

-uses

-  Math,

-  {$IFDEF Delphi}

-  Dialogs,

-  {$ENDIF}

-  {$IFDEF LINUX}

-  libc,

-  {$ENDIF}

-  UMain,

-  UConfig;

-

-var

-  PrevNumLocale: string;

-

-// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '')

-// to set the language/country specific locale (e.g. charset) for this application.

-// Unfortunately, LC_NUMERIC is set by this call too.

-// It defines the decimal-separator and other country-specific numeric settings.

-// This parameter is used by the C string-to-float parsing functions atof() and strtod().

-// After changing LC_NUMERIC some external C-based libs (like projectM) are not

-// able to parse strings correctly

-// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is).

-// So we reset the numeric settings to the default ('C').

-// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not

-//   changed by this because it doesn't use the locale-settings.

-// TODO:

-// - Check if this is needed in MacOSX (at least the locale is set in cwstring)

-// - Find out which libs are concerned by this problem.

-//   If only projectM is concerned by this problem set and restore the numeric locale

-//   for each call to projectM instead of changing it globally.

-procedure SetDefaultNumericLocale();

-begin

-  {$ifdef LINUX}

-  PrevNumLocale := setlocale(LC_NUMERIC, nil);

-  setlocale(LC_NUMERIC, 'C');

-  {$endif}

-end;

-

-procedure RestoreNumericLocale();

-begin

-  {$ifdef LINUX}

-  setlocale(LC_NUMERIC, PChar(PrevNumLocale));

-  {$endif}

-end;

-

-(*

- * If an invalid floating point operation was performed the Floating-point unit (FPU)

- * generates a Floating-point exception (FPE). Dependending on the settings in

- * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself

- * (we will call this as "FPE disabled" later on) or is passed to the application

- * (FPE enabled).

- * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is

- * considered an error and an exception is thrown. Otherwise the FPU will handle

- * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without

- * throwing an error to the application.

- * The same applies to a division by INF that either raises an exception

- * (FPE enabled) or returns 0.0 (FPE disabled).

- * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED

- * on program startup (at least with Intel CPUs), but for some strange reasons

- * they are ENABLED in pascal (both delphi and FPC) by default.

- * Many libs operating with floating-point values rely heavily on the C-specific

- * behaviour. So using them in delphi is a ticking time-bomb because sooner or

- * later they will crash because of an FPE (this problem occurs massively

- * in OpenGL-based libs like projectM). In contrast to this no error will occur

- * if the lib is linked to a C-program.

- *

- * Further info on FPUs:

- * For x86 and x86_64 CPUs we have to consider two FPU instruction sets.

- * The math co-processor i387 (aka 8087 or x87) set introduced with the i386

- * and SSE (Streaming SIMD Extensions) introduced with the Pentium3.

- * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR)

- * to control FPEs. Either has (among others) 6bits to enable/disable several

- * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision).

- * Those exception-types must all be masked (=1) to get the default C behaviour.

- * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE).

- * Instead of using assembler code, we can use Set8087CW() provided by delphi and

- * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR.

- * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program

- * startup but only FPC enables FPEs (especially div-by-zero) for SSE too.

- * So we have to mask FPEs for x87  in Delphi and FPC and for SSE in FPC only.

- * FPC and Delphi both provide a SetExceptionMask() for control of the FPE

- * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE

- * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask()

- * is what we need and it even is plattform and CPU independent.

- *

- * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers)

- * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL

- * headers they do not work properly with FPC. I already patched them, so they

- * work at least until they are updated the next time. In addition Set8086CW()

- * does not suffice to disable FPEs because the SSE FPEs are not disabled by this.

- * FPEs with SSE are a big problem with some libs because many linux distributions

- * optimize code for SSE or Pentium3 (for example: int(INF) which convert the

- * double value "infinity" to an integer might be automatically optimized by

- * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case

- * to make USDX portable.

- *

- * Summary:

- * Call this function on initialization to make sure FPEs are turned off.

- * It will solve a lot of errors with FPEs in external libs.

- *)

-procedure DisableFloatingPointExceptions();

-begin

-  (*

-  // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR().

-  // Note: Leave these lines for documentation purposes just in case

-  //       SetExceptionMask() does not work anymore (due to bugs in FPC etc.).

-  {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)}

-  Set8087CW($133F);

-  {$IFEND}

-  {$IF Defined(FPC)}

-  if (has_sse_support) then

-    SetSSECSR($1F80);

-  {$IFEND}

-  *)

-  

-  // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and

-  // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore).

-  SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,

-                    exOverflow, exUnderflow, exPrecision]);

-end;

-

-function StringReplaceW(text : WideString; search, rep: WideChar):WideString;

-var

-  iPos  : integer;

-//  sTemp : WideString;

-begin

-(*

-  result := text;

-  iPos   := Pos(search, result);

-  while (iPos > 0) do

-  begin

-    sTemp  := copy(result, iPos + length(search), length(result));

-    result := copy(result, 1, iPos - 1) + rep + sTEmp;

-    iPos   := Pos(search, result);

-  end;

-*)

-  result := text;

-

-  if search = rep then

-    exit;

-

-  for iPos := 0 to length( result ) - 1 do

-  begin

-    if result[ iPos ] = search then

-      result[ iPos ] := rep;

-  end;

-end;

-

-function AdaptFilePaths( const aPath : widestring ): widestring;

-begin

-  result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] );

-end;

-

-

-{$IFNDEF MSWINDOWS}

-procedure ZeroMemory( Destination: Pointer; Length: DWORD );

-begin

-  FillChar( Destination^, Length, 0 );

-end;

-

-function MakeLong(A, B: Word): Longint;

-begin

-  Result := (LongInt(B) shl 16) + A;

-end;

-

-(*

-function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool;

-

-  // From http://en.wikipedia.org/wiki/RDTSC

-  function RDTSC: Int64; register;

-  asm

-    rdtsc

-  end;

-

-begin

-  // Use clock_gettime  here maybe ... from libc

-  lpPerformanceCount := RDTSC();

-  result := true;

-end;

-

-function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;

-begin

-  lpFrequency := 0;

-  result := true;

-end;

-*)

-{$ENDIF}

-

-// Checks if a regular files or directory with the given name exists.

-// The comparison is case insensitive.

-function FileExistsInsensitive(var FileName: string): boolean;

-var

-  FilePath, LocalFileName: string;

-  SearchInfo: TSearchRec;

-begin

-{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems

-  // speed up standard case

-  if FileExists(FileName) then

-  begin

-    Result := true;

-    exit;

-  end;

-

-  Result := false;

-

-  FilePath := ExtractFilePath(FileName);

-  if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then

-  begin

-    LocalFileName := ExtractFileName(FileName);

-    repeat

-      if (AnsiSameText(LocalFileName, SearchInfo.Name)) then

-      begin

-        FileName := FilePath + SearchInfo.Name;

-        Result := true;

-        break;

-      end;

-    until (FindNext(SearchInfo) <> 0);

-  end;

-  FindClose(SearchInfo);

-{$ELSE}

-  Result := FileExists(FileName);

-{$ENDIF}

-end;

-

-

-{$IFDEF Unix}

-  // include resource-file info (stored in the constant array "resources")

-  {$I ../resource.inc}

-{$ENDIF}

-

-function GetResourceStream(const aName, aType: string): TStream;

-{$IFDEF Unix}

-var

-  ResIndex: integer;

-  Filename: string;

-{$ENDIF}

-begin

-  Result := nil;

-

-  {$IFDEF Unix}

-  for ResIndex := 0 to High(resources) do

-  begin

-    if (resources[ResIndex][0] = aName ) and

-       (resources[ResIndex][1] = aType ) then

-    begin

-      try

-        Filename := ResourcesPath + resources[ResIndex][2];

-        Result := TFileStream.Create(Filename, fmOpenRead);

-      except

-        Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream');

-      end;

-      exit;

-    end;

-  end;

-  {$ELSE}

-  try

-    Result := TResourceStream.Create(HInstance, aName , PChar(aType));

-  except

-    Log.LogError('Invalid resource: "'+ aType + ':' + aName +'"', 'GetResourceStream');

-  end;

-  {$ENDIF}

-end;

-

-// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++

-  function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;

-  var

-    stream : TStream;

-    origin : Word;

-  begin

-    stream := TStream( context.unknown );

-    if ( stream = nil ) then

-      raise EInvalidContainer.Create( 'SDLStreamSeek on nil' );

-    case whence of

-      0 : origin := soFromBeginning; //	Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0.

-      1 : origin := soFromCurrent; //	Offset is from the current position in the resource. Seek moves to Position + Offset.

-      2 : origin := soFromEnd;

-    else

-      origin := soFromBeginning; // just in case

-    end;

-    Result := stream.Seek( offset, origin );

-  end;

-  

-  function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl;

-  var

-    stream : TStream;

-  begin

-    stream := TStream( context.unknown );

-    if ( stream = nil ) then

-      raise EInvalidContainer.Create( 'SDLStreamRead on nil' );

-    try

-      Result := stream.read( Ptr^, Size * maxnum ) div size;

-    except

-      Result := -1;

-    end;

-  end;

-  

-  function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl;

-  var

-    stream : TStream;

-  begin

-    stream := TStream( context.unknown );

-    if ( stream = nil ) then

-      raise EInvalidContainer.Create( 'SDLStreamClose on nil' );

-    stream.Free;

-    Result := 1;

-  end;

-// -----------------------------------------------

-

-(*

- * Creates an SDL_RWops handle from a TStream.

- * The stream and RWops must be freed by the user after usage.

- * Use SDL_FreeRW(...) to free the RWops data-struct. 

- *)

-function RWopsFromStream(Stream: TStream): PSDL_RWops;

-begin

-  Result := SDL_AllocRW();

-  if (Result = nil) then

-    Exit;

-

-  // set RW-callbacks

-  with Result^ do

-  begin

-    unknown := TUnknown(Stream);

-    seek    := SDLStreamSeek;

-    read    := SDLStreamRead;

-    write   := nil;

-    close   := SDLStreamClose;

-    type_   := 2;

-  end;

-end;

-

-

-

-{$IFDEF FPC}

-function RandomRange(aMin: Integer; aMax: Integer) : Integer;

-begin

-  RandomRange := Random(aMax-aMin) + aMin ;

-end;

-{$ENDIF}

-

-{$IF Defined(MSWINDOWS) and Defined(FPC)}

-function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

-var

-  Msg: TMessage;

-  MethodPtr: ^TWndMethod;

-begin

-  FillChar(Msg, SizeOf(Msg), 0);  

-  Msg.msg := uMsg;

-  Msg.wParam := wParam;

-  Msg.lParam := lParam;

-

-  MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA));

-  if Assigned(MethodPtr) then

-    MethodPtr^(Msg);

-   

-  Result := DefWindowProc(hwnd, uMsg, wParam, lParam);

-end;

-

-function AllocateHWnd(Method: TWndMethod): HWND;

-var

-  ClassExists: Boolean;

-  WndClass, OldClass: TWndClass;

-  MethodPtr: ^TMethod;

-begin

-  Result := 0;

-

-  // setup class-info

-  FillChar(WndClass, SizeOf(TWndClass), 0);

-  WndClass.hInstance := HInstance;

-  // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned,

-  //   otherwise race-conditions might occur

-  WndClass.lpfnWndProc := @DefWindowProc;

-  WndClass.lpszClassName:= 'USDXUtilWindowClass';

-

-  // check if class is already registered

-  ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass);

-  // create window-class shared by all windows created by AllocateHWnd()

-  if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then

-  begin

-    if ClassExists then

-      UnregisterClass(WndClass.lpszClassName, HInstance);

-    if (RegisterClass(WndClass) = 0) then

-       Exit;

-  end;

-  // create window

-  Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '',

-    DWORD(WS_POPUP), 0, 0, 0, 0, 0, 0, HInstance, nil);

-  if (Result = 0) then

-    Exit;

-  // assign individual callback procedure to the window

-  if Assigned(Method) then

-  begin

-    // TMethod contains two pointers but we can pass just one as USERDATA

-    GetMem(MethodPtr, SizeOf(TMethod));

-    MethodPtr^ := TMethod(Method);

-    SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr));

-  end;

-  // now enable AllocateHWndCallback for this window

-  SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback));

-end;

-

-procedure DeallocateHWnd(hWnd: HWND);

-var

-  MethodPtr: ^TMethod;

-begin

-  if (hWnd <> 0) then

-  begin

-    MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA));

-    DestroyWindow(hWnd);

-    if Assigned(MethodPtr) then

-      FreeMem(MethodPtr);

-  end;

-end;

-{$IFEND}

-

-{$IFDEF FPC}

-var

-  MessageList: TStringList;

-  ConsoleHandler: TThreadID;

-  // Note: TRTLCriticalSection is defined in the units System and Libc, use System one

-  ConsoleCriticalSection: System.TRTLCriticalSection;

-  ConsoleEvent: PRTLEvent;

-  ConsoleQuit: boolean;

-{$ENDIF}

-

-(*

- * Write to console if one is available.

- * It checks if a console is available before output so it will not

- * crash on windows if none is available.

- * Do not use this function directly because it is not thread-safe,

- * use ConsoleWriteLn() instead.

- *)

-procedure _ConsoleWriteLn(const aString: string); {$IFDEF HasInline}inline;{$ENDIF}

-begin

-  {$IFDEF MSWINDOWS}

-  // sanity check to avoid crashes with writeln()

-  if (IsConsole) then

-  begin

-  {$ENDIF}

-    Writeln(aString);

-  {$IFDEF MSWINDOWS}

-  end;

-  {$ENDIF}

-end;

-

-{$IFDEF FPC}

-{*

- * The console-handlers main-function.

- * TODO: create a quit-event on closing.

- *}

-function ConsoleHandlerFunc(param: pointer): PtrInt;

-var

-  i: integer;

-  quit: boolean;

-begin

-  quit := false;

-  while (not quit) do

-  begin

-    // wait for new output or quit-request

-    RTLeventWaitFor(ConsoleEvent);

-

-    System.EnterCriticalSection(ConsoleCriticalSection);

-    // output pending messages

-    for i := 0 to MessageList.Count-1 do

-    begin

-      _ConsoleWriteLn(MessageList[i]);

-    end;

-    MessageList.Clear();

-

-    // use local quit-variable to avoid accessing

-    // ConsoleQuit outside of the critical section

-    if (ConsoleQuit) then

-      quit := true;

-

-    RTLeventResetEvent(ConsoleEvent);

-    System.LeaveCriticalSection(ConsoleCriticalSection);

-  end;

-  result := 0;

-end;

-{$ENDIF}

-

-procedure InitConsoleOutput();

-begin

-  {$IFDEF FPC}

-  // init thread-safe output

-  MessageList := TStringList.Create();

-  System.InitCriticalSection(ConsoleCriticalSection);

-  ConsoleEvent := RTLEventCreate();

-  ConsoleQuit := false;

-  // must be a thread managed by FPC. Otherwise (e.g. SDL-thread)

-  // it will crash when using Writeln.

-  ConsoleHandler := BeginThread(@ConsoleHandlerFunc);

-  {$ENDIF}

-end;

-

-procedure FinalizeConsoleOutput();

-begin

-  {$IFDEF FPC}

-  // terminate console-handler

-  System.EnterCriticalSection(ConsoleCriticalSection);

-  ConsoleQuit := true;

-  RTLeventSetEvent(ConsoleEvent);

-  System.LeaveCriticalSection(ConsoleCriticalSection);

-  WaitForThreadTerminate(ConsoleHandler, 0);

-  // free data

-  System.DoneCriticalsection(ConsoleCriticalSection);

-  RTLeventDestroy(ConsoleEvent);

-  MessageList.Free();

-  {$ENDIF}

-end;

-

-{*

- * With FPC console output is not thread-safe.

- * Using WriteLn() from external threads (like in SDL callbacks)

- *  will damage the heap and crash the program.

- * Most probably FPC uses thread-local-data (TLS) to lock a mutex on

- *  the console-buffer. This does not work with external lib's threads

- *  because these do not have the TLS data and so it crashes while

- *  accessing unallocated memory.

- * The solution is to create an FPC-managed thread which has the TLS data

- *  and use it to handle the console-output (hence it is called Console-Handler)

- * It should be safe to do so, but maybe FPC requires the main-thread to access

- *  the console-buffer only. In this case output should be delegated to it.

- *

- * TODO: - check if it is safe if an FPC-managed thread different than the

- *           main-thread accesses the console-buffer in FPC.

- *       - check if Delphi's WriteLn is thread-safe.

- *       - check if we need to synchronize file-output too

- *}

-procedure ConsoleWriteLn(const msg: string);

-begin

-{$IFDEF CONSOLE}

-  {$IFDEF FPC}

-  // TODO: check for the main-thread and use a simple _ConsoleWriteLn() then?

-  //GetCurrentThreadThreadId();

-  System.EnterCriticalSection(ConsoleCriticalSection);

-  MessageList.Add(msg);

-  RTLeventSetEvent(ConsoleEvent);

-  System.LeaveCriticalSection(ConsoleCriticalSection);

-  {$ELSE}

-  _ConsoleWriteLn(msg);

-  {$ENDIF}

-{$ENDIF}

-end;

-

-procedure ShowMessage(const msg: String; msgType: TMessageType);

-{$IFDEF MSWINDOWS}

-var Flags: Cardinal;

-{$ENDIF}

-begin

-{$IF Defined(MSWINDOWS)}

-  case msgType of

-    mtInfo:  Flags := MB_ICONINFORMATION or MB_OK;

-    mtError: Flags := MB_ICONERROR or MB_OK;

-    else Flags := MB_OK;

-  end;

-  MessageBox(0, PChar(msg), PChar(USDXVersionStr()), Flags);

-{$ELSE}

-  ConsoleWriteln(msg);

-{$IFEND}

-end;

-

-function IsAlphaChar(ch: WideChar): boolean;

-begin

-  // TODO: add chars > 255 when unicode-fonts work?

-  case ch of

-    'A'..'Z',  // A-Z

-    'a'..'z',  // a-z

-    #170,#181,#186,

-    #192..#214,

-    #216..#246,

-    #248..#255:

-      Result := true;

-    else

-      Result := false;

-  end;

-end;

-

-function IsNumericChar(ch: WideChar): boolean;

-begin

-  case ch of

-    '0'..'9':

-      Result := true;

-    else

-      Result := false;

-  end;

-end;

-

-function IsAlphaNumericChar(ch: WideChar): boolean;

-begin

-  Result := (IsAlphaChar(ch) or IsNumericChar(ch));

-end;

-

-function IsPunctuationChar(ch: WideChar): boolean;

-begin

-  // TODO: add chars outside of Latin1 basic (0..127)?

-  case ch of

-    ' '..'/',':'..'@','['..'`','{'..'~':

-      Result := true;

-    else

-      Result := false;

-  end;

-end;

-

-function IsControlChar(ch: WideChar): boolean;

-begin

-  case ch of

-    #0..#31,

-    #127..#159:

-      Result := true;

-    else

-      Result := false;

-  end;

-end;

-

-(*

- * Recursive part of the MergeSort algorithm.

- * OutList will be either InList or TempList and will be swapped in each

- * depth-level of recursion. By doing this it we can directly merge into the

- * output-list. If we only had In- and OutList parameters we had to merge into

- * InList after the recursive calls and copy the data to the OutList afterwards.

- *)

-procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: integer;

-                    CompareFunc: TListSortCompare);

-var

-  LeftSize, RightSize: integer; // number of elements in left/right block

-  LeftEnd, RightEnd: integer;   // Index after last element in left/right block

-  MidPos: integer; // index of first element in right block

-  Pos: integer;    // position in output list

-begin

-  LeftSize := BlockSize div 2;

-  RightSize := BlockSize - LeftSize;

-  MidPos := StartPos + LeftSize;

-

-  // sort left and right halves of this block by recursive calls of this function 

-  if (LeftSize >= 2) then

-    _MergeSort(InList, OutList, TempList, StartPos, LeftSize, CompareFunc)

-  else

-    TempList[StartPos] := InList[StartPos];

-  if (RightSize >= 2) then

-    _MergeSort(InList, OutList, TempList, MidPos, RightSize, CompareFunc)

-  else

-    TempList[MidPos] := InList[MidPos];

-

-  // merge sorted left and right sub-lists into output-list 

-  LeftEnd := MidPos;

-  RightEnd := StartPos + BlockSize;

-  Pos := StartPos;

-  while ((StartPos < LeftEnd) and (MidPos < RightEnd)) do

-  begin

-    if (CompareFunc(TempList[StartPos], TempList[MidPos]) <= 0) then

-    begin

-      OutList[Pos] := TempList[StartPos];

-      Inc(StartPos);

-    end

-    else

-    begin

-      OutList[Pos] := TempList[MidPos];

-      Inc(MidPos);

-    end;

-    Inc(Pos);

-  end;

-

-  // copy remaining elements to output-list

-  while (StartPos < LeftEnd) do

-  begin

-    OutList[Pos] := TempList[StartPos];

-    Inc(StartPos);

-    Inc(Pos);

-  end;

-  while (MidPos < RightEnd) do

-  begin

-    OutList[Pos] := TempList[MidPos];

-    Inc(MidPos);

-    Inc(Pos);

-  end;

-end;

-

-(*

- * Stable alternative to the instable TList.Sort() (uses QuickSort) implementation.

- * A stable sorting algorithm preserves preordered items. E.g. if sorting by

- * songs by title first and artist afterwards, the songs of each artist will

- * be ordered by title. In contrast to this an unstable algorithm (like QuickSort)

- * may destroy an existing order, so the songs of an artist will not be ordered

- * by title anymore after sorting by artist in the previous example.

- * If you do not need a stable algorithm, use TList.Sort() instead.

- *)

-procedure MergeSort(List: TList; CompareFunc: TListSortCompare);

-var

-  TempList: TList;

-begin

-  TempList := TList.Create();

-  TempList.Count := List.Count;

-  if (List.Count >= 2) then

-    _MergeSort(List, TempList, List, 0, List.Count, CompareFunc);

-  TempList.Free;

-end;

-

-

-initialization

-  InitConsoleOutput();

-

-finalization

-  FinalizeConsoleOutput();

-

-end.

+unit UCommon;
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+  SysUtils,
+  Classes,
+  {$IFDEF MSWINDOWS}
+  Windows,
+  Messages,
+  {$ENDIF}
+  sdl,
+  ULog;
+
+{$IFNDEF DARWIN}
+// FIXME: remove this if it is not needed anymore
+type
+  hStream        = THandle;
+  HGLRC          = THandle;
+  TLargeInteger  = Int64;
+  TWin32FindData = LongInt;
+{$ENDIF}
+
+type
+  TMessageType = ( mtInfo, mtError );
+
+procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo );
+
+procedure ConsoleWriteLn(const msg: string);
+
+function GetResourceStream(const aName, aType : string): TStream;
+function RWopsFromStream(Stream: TStream): PSDL_RWops;
+
+{$IFDEF FPC}
+function RandomRange(aMin: Integer; aMax: Integer) : Integer;
+{$ENDIF}
+
+{$IF Defined(MSWINDOWS) and Defined(FPC)}
+function  AllocateHWnd(Method: TWndMethod): HWND;
+procedure DeallocateHWnd(hWnd: HWND);
+{$IFEND}
+
+function StringReplaceW(text : WideString; search, rep: WideChar):WideString;
+function AdaptFilePaths( const aPath : widestring ): widestring;
+
+procedure DisableFloatingPointExceptions();
+procedure SetDefaultNumericLocale();
+procedure RestoreNumericLocale();
+
+{$IFNDEF MSWINDOWS}
+  procedure ZeroMemory( Destination: Pointer; Length: DWORD );
+  function MakeLong(a, b: Word): Longint;
+  (*
+  #define LOBYTE(a) (BYTE)(a)
+  #define HIBYTE(a) (BYTE)((a)>>8)
+  #define LOWORD(a) (WORD)(a)
+  #define HIWORD(a) (WORD)((a)>>16)
+  #define MAKEWORD(a,b) (WORD)(((a)&0xff)|((b)<<8))
+  *)
+{$ENDIF}
+
+function FileExistsInsensitive(var FileName: string): boolean;
+
+(*
+ * Character classes
+ *)
+
+function IsAlphaChar(ch: WideChar): boolean;
+function IsNumericChar(ch: WideChar): boolean;
+function IsAlphaNumericChar(ch: WideChar): boolean;
+function IsPunctuationChar(ch: WideChar): boolean;
+function IsControlChar(ch: WideChar): boolean;
+
+// A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below)
+procedure MergeSort(List: TList; CompareFunc: TListSortCompare);
+
+
+implementation
+
+uses
+  Math,
+  {$IFDEF Delphi}
+  Dialogs,
+  {$ENDIF}
+  {$IFDEF LINUX}
+  libc,
+  {$ENDIF}
+  UMain,
+  UConfig;
+
+var
+  PrevNumLocale: string;
+
+// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '')
+// to set the language/country specific locale (e.g. charset) for this application.
+// Unfortunately, LC_NUMERIC is set by this call too.
+// It defines the decimal-separator and other country-specific numeric settings.
+// This parameter is used by the C string-to-float parsing functions atof() and strtod().
+// After changing LC_NUMERIC some external C-based libs (like projectM) are not
+// able to parse strings correctly
+// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is).
+// So we reset the numeric settings to the default ('C').
+// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not
+//   changed by this because it doesn't use the locale-settings.
+// TODO:
+// - Check if this is needed in MacOSX (at least the locale is set in cwstring)
+// - Find out which libs are concerned by this problem.
+//   If only projectM is concerned by this problem set and restore the numeric locale
+//   for each call to projectM instead of changing it globally.
+procedure SetDefaultNumericLocale();
+begin
+  {$ifdef LINUX}
+  PrevNumLocale := setlocale(LC_NUMERIC, nil);
+  setlocale(LC_NUMERIC, 'C');
+  {$endif}
+end;
+
+procedure RestoreNumericLocale();
+begin
+  {$ifdef LINUX}
+  setlocale(LC_NUMERIC, PChar(PrevNumLocale));
+  {$endif}
+end;
+
+(*
+ * If an invalid floating point operation was performed the Floating-point unit (FPU)
+ * generates a Floating-point exception (FPE). Dependending on the settings in
+ * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself
+ * (we will call this as "FPE disabled" later on) or is passed to the application
+ * (FPE enabled).
+ * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is
+ * considered an error and an exception is thrown. Otherwise the FPU will handle
+ * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without
+ * throwing an error to the application.
+ * The same applies to a division by INF that either raises an exception
+ * (FPE enabled) or returns 0.0 (FPE disabled).
+ * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED
+ * on program startup (at least with Intel CPUs), but for some strange reasons
+ * they are ENABLED in pascal (both delphi and FPC) by default.
+ * Many libs operating with floating-point values rely heavily on the C-specific
+ * behaviour. So using them in delphi is a ticking time-bomb because sooner or
+ * later they will crash because of an FPE (this problem occurs massively
+ * in OpenGL-based libs like projectM). In contrast to this no error will occur
+ * if the lib is linked to a C-program.
+ *
+ * Further info on FPUs:
+ * For x86 and x86_64 CPUs we have to consider two FPU instruction sets.
+ * The math co-processor i387 (aka 8087 or x87) set introduced with the i386
+ * and SSE (Streaming SIMD Extensions) introduced with the Pentium3.
+ * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR)
+ * to control FPEs. Either has (among others) 6bits to enable/disable several
+ * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision).
+ * Those exception-types must all be masked (=1) to get the default C behaviour.
+ * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE).
+ * Instead of using assembler code, we can use Set8087CW() provided by delphi and
+ * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR.
+ * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program
+ * startup but only FPC enables FPEs (especially div-by-zero) for SSE too.
+ * So we have to mask FPEs for x87  in Delphi and FPC and for SSE in FPC only.
+ * FPC and Delphi both provide a SetExceptionMask() for control of the FPE
+ * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE
+ * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask()
+ * is what we need and it even is plattform and CPU independent.
+ *
+ * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers)
+ * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL
+ * headers they do not work properly with FPC. I already patched them, so they
+ * work at least until they are updated the next time. In addition Set8086CW()
+ * does not suffice to disable FPEs because the SSE FPEs are not disabled by this.
+ * FPEs with SSE are a big problem with some libs because many linux distributions
+ * optimize code for SSE or Pentium3 (for example: int(INF) which convert the
+ * double value "infinity" to an integer might be automatically optimized by
+ * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case
+ * to make USDX portable.
+ *
+ * Summary:
+ * Call this function on initialization to make sure FPEs are turned off.
+ * It will solve a lot of errors with FPEs in external libs.
+ *)
+procedure DisableFloatingPointExceptions();
+begin
+  (*
+  // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR().
+  // Note: Leave these lines for documentation purposes just in case
+  //       SetExceptionMask() does not work anymore (due to bugs in FPC etc.).
+  {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)}
+  Set8087CW($133F);
+  {$IFEND}
+  {$IF Defined(FPC)}
+  if (has_sse_support) then
+    SetSSECSR($1F80);
+  {$IFEND}
+  *)
+  
+  // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and
+  // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore).
+  SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
+                    exOverflow, exUnderflow, exPrecision]);
+end;
+
+function StringReplaceW(text : WideString; search, rep: WideChar):WideString;
+var
+  iPos  : integer;
+//  sTemp : WideString;
+begin
+(*
+  result := text;
+  iPos   := Pos(search, result);
+  while (iPos > 0) do
+  begin
+    sTemp  := copy(result, iPos + length(search), length(result));
+    result := copy(result, 1, iPos - 1) + rep + sTEmp;
+    iPos   := Pos(search, result);
+  end;
+*)
+  result := text;
+
+  if search = rep then
+    exit;
+
+  for iPos := 0 to length( result ) - 1 do
+  begin
+    if result[ iPos ] = search then
+      result[ iPos ] := rep;
+  end;
+end;
+
+function AdaptFilePaths( const aPath : widestring ): widestring;
+begin
+  result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] );
+end;
+
+
+{$IFNDEF MSWINDOWS}
+procedure ZeroMemory( Destination: Pointer; Length: DWORD );
+begin
+  FillChar( Destination^, Length, 0 );
+end;
+
+function MakeLong(A, B: Word): Longint;
+begin
+  Result := (LongInt(B) shl 16) + A;
+end;
+
+(*
+function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool;
+
+  // From http://en.wikipedia.org/wiki/RDTSC
+  function RDTSC: Int64; register;
+  asm
+    rdtsc
+  end;
+
+begin
+  // Use clock_gettime  here maybe ... from libc
+  lpPerformanceCount := RDTSC();
+  result := true;
+end;
+
+function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;
+begin
+  lpFrequency := 0;
+  result := true;
+end;
+*)
+{$ENDIF}
+
+// Checks if a regular files or directory with the given name exists.
+// The comparison is case insensitive.
+function FileExistsInsensitive(var FileName: string): boolean;
+var
+  FilePath, LocalFileName: string;
+  SearchInfo: TSearchRec;
+begin
+{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems
+  // speed up standard case
+  if FileExists(FileName) then
+  begin
+    Result := true;
+    exit;
+  end;
+
+  Result := false;
+
+  FilePath := ExtractFilePath(FileName);
+  if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then
+  begin
+    LocalFileName := ExtractFileName(FileName);
+    repeat
+      if (AnsiSameText(LocalFileName, SearchInfo.Name)) then
+      begin
+        FileName := FilePath + SearchInfo.Name;
+        Result := true;
+        break;
+      end;
+    until (FindNext(SearchInfo) <> 0);
+  end;
+  FindClose(SearchInfo);
+{$ELSE}
+  Result := FileExists(FileName);
+{$ENDIF}
+end;
+
+
+{$IFDEF Unix}
+  // include resource-file info (stored in the constant array "resources")
+  {$I ../resource.inc}
+{$ENDIF}
+
+function GetResourceStream(const aName, aType: string): TStream;
+{$IFDEF Unix}
+var
+  ResIndex: integer;
+  Filename: string;
+{$ENDIF}
+begin
+  Result := nil;
+
+  {$IFDEF Unix}
+  for ResIndex := 0 to High(resources) do
+  begin
+    if (resources[ResIndex][0] = aName ) and
+       (resources[ResIndex][1] = aType ) then
+    begin
+      try
+        Filename := ResourcesPath + resources[ResIndex][2];
+        Result := TFileStream.Create(Filename, fmOpenRead);
+      except
+        Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream');
+      end;
+      exit;
+    end;
+  end;
+  {$ELSE}
+  try
+    Result := TResourceStream.Create(HInstance, aName , PChar(aType));
+  except
+    Log.LogError('Invalid resource: "'+ aType + ':' + aName +'"', 'GetResourceStream');
+  end;
+  {$ENDIF}
+end;
+
+// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++
+  function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;
+  var
+    stream : TStream;
+    origin : Word;
+  begin
+    stream := TStream( context.unknown );
+    if ( stream = nil ) then
+      raise EInvalidContainer.Create( 'SDLStreamSeek on nil' );
+    case whence of
+      0 : origin := soFromBeginning; //	Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0.
+      1 : origin := soFromCurrent; //	Offset is from the current position in the resource. Seek moves to Position + Offset.
+      2 : origin := soFromEnd;
+    else
+      origin := soFromBeginning; // just in case
+    end;
+    Result := stream.Seek( offset, origin );
+  end;
+  
+  function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl;
+  var
+    stream : TStream;
+  begin
+    stream := TStream( context.unknown );
+    if ( stream = nil ) then
+      raise EInvalidContainer.Create( 'SDLStreamRead on nil' );
+    try
+      Result := stream.read( Ptr^, Size * maxnum ) div size;
+    except
+      Result := -1;
+    end;
+  end;
+  
+  function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl;
+  var
+    stream : TStream;
+  begin
+    stream := TStream( context.unknown );
+    if ( stream = nil ) then
+      raise EInvalidContainer.Create( 'SDLStreamClose on nil' );
+    stream.Free;
+    Result := 1;
+  end;
+// -----------------------------------------------
+
+(*
+ * Creates an SDL_RWops handle from a TStream.
+ * The stream and RWops must be freed by the user after usage.
+ * Use SDL_FreeRW(...) to free the RWops data-struct. 
+ *)
+function RWopsFromStream(Stream: TStream): PSDL_RWops;
+begin
+  Result := SDL_AllocRW();
+  if (Result = nil) then
+    Exit;
+
+  // set RW-callbacks
+  with Result^ do
+  begin
+    unknown := TUnknown(Stream);
+    seek    := SDLStreamSeek;
+    read    := SDLStreamRead;
+    write   := nil;
+    close   := SDLStreamClose;
+    type_   := 2;
+  end;
+end;
+
+
+
+{$IFDEF FPC}
+function RandomRange(aMin: Integer; aMax: Integer) : Integer;
+begin
+  RandomRange := Random(aMax-aMin) + aMin ;
+end;
+{$ENDIF}
+
+{$IF Defined(MSWINDOWS) and Defined(FPC)}
+function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
+var
+  Msg: TMessage;
+  MethodPtr: ^TWndMethod;
+begin
+  FillChar(Msg, SizeOf(Msg), 0);  
+  Msg.msg := uMsg;
+  Msg.wParam := wParam;
+  Msg.lParam := lParam;
+
+  MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA));
+  if Assigned(MethodPtr) then
+    MethodPtr^(Msg);
+   
+  Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
+end;
+
+function AllocateHWnd(Method: TWndMethod): HWND;
+var
+  ClassExists: Boolean;
+  WndClass, OldClass: TWndClass;
+  MethodPtr: ^TMethod;
+begin
+  Result := 0;
+
+  // setup class-info
+  FillChar(WndClass, SizeOf(TWndClass), 0);
+  WndClass.hInstance := HInstance;
+  // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned,
+  //   otherwise race-conditions might occur
+  WndClass.lpfnWndProc := @DefWindowProc;
+  WndClass.lpszClassName:= 'USDXUtilWindowClass';
+
+  // check if class is already registered
+  ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass);
+  // create window-class shared by all windows created by AllocateHWnd()
+  if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then
+  begin
+    if ClassExists then
+      UnregisterClass(WndClass.lpszClassName, HInstance);
+    if (RegisterClass(WndClass) = 0) then
+       Exit;
+  end;
+  // create window
+  Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '',
+    DWORD(WS_POPUP), 0, 0, 0, 0, 0, 0, HInstance, nil);
+  if (Result = 0) then
+    Exit;
+  // assign individual callback procedure to the window
+  if Assigned(Method) then
+  begin
+    // TMethod contains two pointers but we can pass just one as USERDATA
+    GetMem(MethodPtr, SizeOf(TMethod));
+    MethodPtr^ := TMethod(Method);
+    SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr));
+  end;
+  // now enable AllocateHWndCallback for this window
+  SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback));
+end;
+
+procedure DeallocateHWnd(hWnd: HWND);
+var
+  MethodPtr: ^TMethod;
+begin
+  if (hWnd <> 0) then
+  begin
+    MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA));
+    DestroyWindow(hWnd);
+    if Assigned(MethodPtr) then
+      FreeMem(MethodPtr);
+  end;
+end;
+{$IFEND}
+
+{$IFDEF FPC}
+var
+  MessageList: TStringList;
+  ConsoleHandler: TThreadID;
+  // Note: TRTLCriticalSection is defined in the units System and Libc, use System one
+  ConsoleCriticalSection: System.TRTLCriticalSection;
+  ConsoleEvent: PRTLEvent;
+  ConsoleQuit: boolean;
+{$ENDIF}
+
+(*
+ * Write to console if one is available.
+ * It checks if a console is available before output so it will not
+ * crash on windows if none is available.
+ * Do not use this function directly because it is not thread-safe,
+ * use ConsoleWriteLn() instead.
+ *)
+procedure _ConsoleWriteLn(const aString: string); {$IFDEF HasInline}inline;{$ENDIF}
+begin
+  {$IFDEF MSWINDOWS}
+  // sanity check to avoid crashes with writeln()
+  if (IsConsole) then
+  begin
+  {$ENDIF}
+    Writeln(aString);
+  {$IFDEF MSWINDOWS}
+  end;
+  {$ENDIF}
+end;
+
+{$IFDEF FPC}
+{*
+ * The console-handlers main-function.
+ * TODO: create a quit-event on closing.
+ *}
+function ConsoleHandlerFunc(param: pointer): PtrInt;
+var
+  i: integer;
+  quit: boolean;
+begin
+  quit := false;
+  while (not quit) do
+  begin
+    // wait for new output or quit-request
+    RTLeventWaitFor(ConsoleEvent);
+
+    System.EnterCriticalSection(ConsoleCriticalSection);
+    // output pending messages
+    for i := 0 to MessageList.Count-1 do
+    begin
+      _ConsoleWriteLn(MessageList[i]);
+    end;
+    MessageList.Clear();
+
+    // use local quit-variable to avoid accessing
+    // ConsoleQuit outside of the critical section
+    if (ConsoleQuit) then
+      quit := true;
+
+    RTLeventResetEvent(ConsoleEvent);
+    System.LeaveCriticalSection(ConsoleCriticalSection);
+  end;
+  result := 0;
+end;
+{$ENDIF}
+
+procedure InitConsoleOutput();
+begin
+  {$IFDEF FPC}
+  // init thread-safe output
+  MessageList := TStringList.Create();
+  System.InitCriticalSection(ConsoleCriticalSection);
+  ConsoleEvent := RTLEventCreate();
+  ConsoleQuit := false;
+  // must be a thread managed by FPC. Otherwise (e.g. SDL-thread)
+  // it will crash when using Writeln.
+  ConsoleHandler := BeginThread(@ConsoleHandlerFunc);
+  {$ENDIF}
+end;
+
+procedure FinalizeConsoleOutput();
+begin
+  {$IFDEF FPC}
+  // terminate console-handler
+  System.EnterCriticalSection(ConsoleCriticalSection);
+  ConsoleQuit := true;
+  RTLeventSetEvent(ConsoleEvent);
+  System.LeaveCriticalSection(ConsoleCriticalSection);
+  WaitForThreadTerminate(ConsoleHandler, 0);
+  // free data
+  System.DoneCriticalsection(ConsoleCriticalSection);
+  RTLeventDestroy(ConsoleEvent);
+  MessageList.Free();
+  {$ENDIF}
+end;
+
+{*
+ * With FPC console output is not thread-safe.
+ * Using WriteLn() from external threads (like in SDL callbacks)
+ *  will damage the heap and crash the program.
+ * Most probably FPC uses thread-local-data (TLS) to lock a mutex on
+ *  the console-buffer. This does not work with external lib's threads
+ *  because these do not have the TLS data and so it crashes while
+ *  accessing unallocated memory.
+ * The solution is to create an FPC-managed thread which has the TLS data
+ *  and use it to handle the console-output (hence it is called Console-Handler)
+ * It should be safe to do so, but maybe FPC requires the main-thread to access
+ *  the console-buffer only. In this case output should be delegated to it.
+ *
+ * TODO: - check if it is safe if an FPC-managed thread different than the
+ *           main-thread accesses the console-buffer in FPC.
+ *       - check if Delphi's WriteLn is thread-safe.
+ *       - check if we need to synchronize file-output too
+ *}
+procedure ConsoleWriteLn(const msg: string);
+begin
+{$IFDEF CONSOLE}
+  {$IFDEF FPC}
+  // TODO: check for the main-thread and use a simple _ConsoleWriteLn() then?
+  //GetCurrentThreadThreadId();
+  System.EnterCriticalSection(ConsoleCriticalSection);
+  MessageList.Add(msg);
+  RTLeventSetEvent(ConsoleEvent);
+  System.LeaveCriticalSection(ConsoleCriticalSection);
+  {$ELSE}
+  _ConsoleWriteLn(msg);
+  {$ENDIF}
+{$ENDIF}
+end;
+
+procedure ShowMessage(const msg: String; msgType: TMessageType);
+{$IFDEF MSWINDOWS}
+var Flags: Cardinal;
+{$ENDIF}
+begin
+{$IF Defined(MSWINDOWS)}
+  case msgType of
+    mtInfo:  Flags := MB_ICONINFORMATION or MB_OK;
+    mtError: Flags := MB_ICONERROR or MB_OK;
+    else Flags := MB_OK;
+  end;
+  MessageBox(0, PChar(msg), PChar(USDXVersionStr()), Flags);
+{$ELSE}
+  ConsoleWriteln(msg);
+{$IFEND}
+end;
+
+function IsAlphaChar(ch: WideChar): boolean;
+begin
+  // TODO: add chars > 255 when unicode-fonts work?
+  case ch of
+    'A'..'Z',  // A-Z
+    'a'..'z',  // a-z
+    #170,#181,#186,
+    #192..#214,
+    #216..#246,
+    #248..#255:
+      Result := true;
+    else
+      Result := false;
+  end;
+end;
+
+function IsNumericChar(ch: WideChar): boolean;
+begin
+  case ch of
+    '0'..'9':
+      Result := true;
+    else
+      Result := false;
+  end;
+end;
+
+function IsAlphaNumericChar(ch: WideChar): boolean;
+begin
+  Result := (IsAlphaChar(ch) or IsNumericChar(ch));
+end;
+
+function IsPunctuationChar(ch: WideChar): boolean;
+begin
+  // TODO: add chars outside of Latin1 basic (0..127)?
+  case ch of
+    ' '..'/',':'..'@','['..'`','{'..'~':
+      Result := true;
+    else
+      Result := false;
+  end;
+end;
+
+function IsControlChar(ch: WideChar): boolean;
+begin
+  case ch of
+    #0..#31,
+    #127..#159:
+      Result := true;
+    else
+      Result := false;
+  end;
+end;
+
+(*
+ * Recursive part of the MergeSort algorithm.
+ * OutList will be either InList or TempList and will be swapped in each
+ * depth-level of recursion. By doing this it we can directly merge into the
+ * output-list. If we only had In- and OutList parameters we had to merge into
+ * InList after the recursive calls and copy the data to the OutList afterwards.
+ *)
+procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: integer;
+                    CompareFunc: TListSortCompare);
+var
+  LeftSize, RightSize: integer; // number of elements in left/right block
+  LeftEnd, RightEnd: integer;   // Index after last element in left/right block
+  MidPos: integer; // index of first element in right block
+  Pos: integer;    // position in output list
+begin
+  LeftSize := BlockSize div 2;
+  RightSize := BlockSize - LeftSize;
+  MidPos := StartPos + LeftSize;
+
+  // sort left and right halves of this block by recursive calls of this function 
+  if (LeftSize >= 2) then
+    _MergeSort(InList, OutList, TempList, StartPos, LeftSize, CompareFunc)
+  else
+    TempList[StartPos] := InList[StartPos];
+  if (RightSize >= 2) then
+    _MergeSort(InList, OutList, TempList, MidPos, RightSize, CompareFunc)
+  else
+    TempList[MidPos] := InList[MidPos];
+
+  // merge sorted left and right sub-lists into output-list 
+  LeftEnd := MidPos;
+  RightEnd := StartPos + BlockSize;
+  Pos := StartPos;
+  while ((StartPos < LeftEnd) and (MidPos < RightEnd)) do
+  begin
+    if (CompareFunc(TempList[StartPos], TempList[MidPos]) <= 0) then
+    begin
+      OutList[Pos] := TempList[StartPos];
+      Inc(StartPos);
+    end
+    else
+    begin
+      OutList[Pos] := TempList[MidPos];
+      Inc(MidPos);
+    end;
+    Inc(Pos);
+  end;
+
+  // copy remaining elements to output-list
+  while (StartPos < LeftEnd) do
+  begin
+    OutList[Pos] := TempList[StartPos];
+    Inc(StartPos);
+    Inc(Pos);
+  end;
+  while (MidPos < RightEnd) do
+  begin
+    OutList[Pos] := TempList[MidPos];
+    Inc(MidPos);
+    Inc(Pos);
+  end;
+end;
+
+(*
+ * Stable alternative to the instable TList.Sort() (uses QuickSort) implementation.
+ * A stable sorting algorithm preserves preordered items. E.g. if sorting by
+ * songs by title first and artist afterwards, the songs of each artist will
+ * be ordered by title. In contrast to this an unstable algorithm (like QuickSort)
+ * may destroy an existing order, so the songs of an artist will not be ordered
+ * by title anymore after sorting by artist in the previous example.
+ * If you do not need a stable algorithm, use TList.Sort() instead.
+ *)
+procedure MergeSort(List: TList; CompareFunc: TListSortCompare);
+var
+  TempList: TList;
+begin
+  TempList := TList.Create();
+  TempList.Count := List.Count;
+  if (List.Count >= 2) then
+    _MergeSort(List, TempList, List, 0, List.Count, CompareFunc);
+  TempList.Free;
+end;
+
+
+initialization
+  InitConsoleOutput();
+
+finalization
+  FinalizeConsoleOutput();
+
+end.