From 7a01b05b3861a667eb32ce2e0fc88ff3bacb99ae Mon Sep 17 00:00:00 2001
From: mogguh <mogguh@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Tue, 2 Sep 2008 17:25:26 +0000
Subject: Moved: The folder classes has been renamed to base Updated:
 ultrastardx.dpr has been changed accordingly

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1339 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
 src/base/UCommon.pas | 774 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 774 insertions(+)
 create mode 100644 src/base/UCommon.pas

(limited to 'src/base/UCommon.pas')

diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
new file mode 100644
index 00000000..41e3c1f1
--- /dev/null
+++ b/src/base/UCommon.pas
@@ -0,0 +1,774 @@
+unit UCommon;
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+  SysUtils,
+  Classes,
+  {$IFDEF MSWINDOWS}
+  Windows,
+  {$ENDIF}
+  sdl,
+  UConfig,
+  ULog;
+
+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}
+
+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);
+
+function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer;
+procedure FreeAlignedMem(P: Pointer);
+
+
+implementation
+
+uses
+  Math,
+  {$IFDEF Delphi}
+  Dialogs,
+  {$ENDIF}
+  UMain;
+
+
+// data used by the ...Locale() functions
+{$IFDEF LINUX}
+
+var
+  PrevNumLocale: string;
+
+const
+  LC_NUMERIC  = 1;
+
+function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' name 'setlocale';
+
+{$ENDIF}
+
+// 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 := 1 to length(result) 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(CLOCK_REALTIME, ...) here (but not from the libc unit)
+  lpPerformanceCount := RDTSC();
+  result := true;
+end;
+
+function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;
+begin
+  // clock_getres(CLOCK_REALTIME, ...)
+  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}
+
+
+{$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;
+
+
+type
+  // stores the unaligned pointer of data allocated by GetAlignedMem()
+  PMemAlignHeader = ^TMemAlignHeader;
+  TMemAlignHeader = Pointer;
+
+(**
+ * Use this function to assure that allocated memory is aligned on a specific
+ * byte boundary.
+ * Alignment must be a power of 2.
+ *
+ * Important: Memory allocated with GetAlignedMem() MUST be freed with
+ * FreeAlignedMem(), FreeMem() will cause a segmentation fault.
+ *
+ * Hint: If you do not need dynamic memory, consider to allocate memory
+ * statically and use the {$ALIGN x} compiler directive. Note that delphi
+ * supports an alignment "x" of up to 8 bytes only whereas FPC supports
+ * alignments on 16 and 32 byte boundaries too.
+ *)
+{$WARNINGS OFF}
+function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer;
+var
+  OrigPtr: Pointer;
+const
+  MIN_ALIGNMENT = 16;
+begin
+  // Delphi and FPC (tested with 2.2.0) align memory blocks allocated with
+  // GetMem() at least on 8 byte boundaries. Delphi uses a minimal alignment
+  // of either 8 or 16 bytes depending on the size of the requested block
+  // (see System.GetMinimumBlockAlignment). As we do not want to change the
+  // boundary for the worse, we align at least on MIN_ALIGN.
+  if (Alignment < MIN_ALIGNMENT) then
+    Alignment := MIN_ALIGNMENT;
+
+  // allocate unaligned memory
+  GetMem(OrigPtr, SizeOf(TMemAlignHeader) + Size + Alignment);
+  if (OrigPtr = nil) then
+  begin
+    Result := nil;
+    Exit;
+  end;
+
+  // reserve space for the header
+  Result := Pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader));
+  // align memory
+  Result := Pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment);
+
+  // set header with info on old pointer for FreeMem
+  PMemAlignHeader(PtrUInt(Result) - SizeOf(TMemAlignHeader))^ := OrigPtr;
+end;
+{$WARNINGS ON}
+
+{$WARNINGS OFF}
+procedure FreeAlignedMem(P: Pointer);
+begin
+  if (P <> nil) then
+    FreeMem(PMemAlignHeader(PtrUInt(P) - SizeOf(TMemAlignHeader))^);
+end;
+{$WARNINGS ON}
+
+
+initialization
+  InitConsoleOutput();
+
+finalization
+  FinalizeConsoleOutput();
+
+end.
-- 
cgit v1.2.3


From 8dc13b99b51555be6fa16d271ddb02d995b46d96 Mon Sep 17 00:00:00 2001
From: tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Wed, 10 Sep 2008 06:24:16 +0000
Subject: FreeBSD compatibility fixes: - {$IF Defined(Linux)} -> {$IF
 Defined(Linux) or Defined(BSD)} or {$IF Defined(UNIX)} - config-freebsd.inc
 added

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1357 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
 src/base/UCommon.pas | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

(limited to 'src/base/UCommon.pas')

diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
index 41e3c1f1..54c54760 100644
--- a/src/base/UCommon.pas
+++ b/src/base/UCommon.pas
@@ -81,7 +81,7 @@ uses
 
 
 // data used by the ...Locale() functions
-{$IFDEF LINUX}
+{$IF Defined(LINUX) or Defined(BSD)}
 
 var
   PrevNumLocale: string;
@@ -91,7 +91,7 @@ const
 
 function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' name 'setlocale';
 
-{$ENDIF}
+{$IFEND}
 
 // 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.
@@ -111,17 +111,17 @@ function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c'
 //   for each call to projectM instead of changing it globally.
 procedure SetDefaultNumericLocale();
 begin
-  {$ifdef LINUX}
+  {$IF Defined(LINUX) or Defined(BSD)}
   PrevNumLocale := setlocale(LC_NUMERIC, nil);
   setlocale(LC_NUMERIC, 'C');
-  {$endif}
+  {$IFEND}
 end;
 
 procedure RestoreNumericLocale();
 begin
-  {$ifdef LINUX}
+  {$IF Defined(LINUX) or Defined(BSD)}
   setlocale(LC_NUMERIC, PChar(PrevNumLocale));
-  {$endif}
+  {$IFEND}
 end;
 
 (*
@@ -275,7 +275,7 @@ 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
+{$IF Defined(LINUX) or Defined(BSD)}
   // speed up standard case
   if FileExists(FileName) then
   begin
@@ -300,8 +300,9 @@ begin
   end;
   FindClose(SearchInfo);
 {$ELSE}
+  // Windows and Mac OS X do not have case sensitive file systems
   Result := FileExists(FileName);
-{$ENDIF}
+{$IFEND}
 end;
 
 
-- 
cgit v1.2.3


From b8e1a9b524f0922329c5307b0396f78a3dc2b44f Mon Sep 17 00:00:00 2001
From: tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Thu, 11 Sep 2008 16:05:43 +0000
Subject: Define BSD changed to FreeBSD as Darwin also defines BSD

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1366 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
 src/base/UCommon.pas | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

(limited to 'src/base/UCommon.pas')

diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
index 54c54760..38a68d84 100644
--- a/src/base/UCommon.pas
+++ b/src/base/UCommon.pas
@@ -81,7 +81,7 @@ uses
 
 
 // data used by the ...Locale() functions
-{$IF Defined(LINUX) or Defined(BSD)}
+{$IF Defined(Linux) or Defined(FreeBSD)}
 
 var
   PrevNumLocale: string;
@@ -111,7 +111,7 @@ function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c'
 //   for each call to projectM instead of changing it globally.
 procedure SetDefaultNumericLocale();
 begin
-  {$IF Defined(LINUX) or Defined(BSD)}
+  {$IF Defined(LINUX) or Defined(FreeBSD)}
   PrevNumLocale := setlocale(LC_NUMERIC, nil);
   setlocale(LC_NUMERIC, 'C');
   {$IFEND}
@@ -119,7 +119,7 @@ end;
 
 procedure RestoreNumericLocale();
 begin
-  {$IF Defined(LINUX) or Defined(BSD)}
+  {$IF Defined(LINUX) or Defined(FreeBSD)}
   setlocale(LC_NUMERIC, PChar(PrevNumLocale));
   {$IFEND}
 end;
@@ -275,7 +275,7 @@ var
   FilePath, LocalFileName: string;
   SearchInfo: TSearchRec;
 begin
-{$IF Defined(LINUX) or Defined(BSD)}
+{$IF Defined(Linux) or Defined(FreeBSD)}
   // speed up standard case
   if FileExists(FileName) then
   begin
-- 
cgit v1.2.3


From abf47ddd1fe77287136535e2d05ada48b99b8e1f Mon Sep 17 00:00:00 2001
From: tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Fri, 12 Sep 2008 09:51:33 +0000
Subject: - Windows resources (.rc) reduced to the icon - Texture resource
 names are now directly written to resources.inc - Fonts are no resources
 anymore. They are moved to game/fonts and can be changed to support multiple
 charsets (until the TTF part is finished). Fonts are registered in
 fonts/fonts.in

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1367 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
 src/base/UCommon.pas | 101 ++++++++++++++++++++++-----------------------------
 1 file changed, 44 insertions(+), 57 deletions(-)

(limited to 'src/base/UCommon.pas')

diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
index 38a68d84..3f41dae6 100644
--- a/src/base/UCommon.pas
+++ b/src/base/UCommon.pas
@@ -306,87 +306,74 @@ begin
 end;
 
 
-{$IFDEF Unix}
-  // include resource-file info (stored in the constant array "resources")
-  {$I ../resource.inc}
-{$ENDIF}
+// include resource-file info (stored in the constant array "resources")
+{$I ../resource.inc}
 
 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
+    if (Resources[ResIndex][0] = aName ) then
     begin
       try
-        Filename := ResourcesPath + resources[ResIndex][2];
+        Filename := ResourcesPath + Resources[ResIndex][1];
         Result := TFileStream.Create(Filename, fmOpenRead);
       except
-        Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream');
+        Log.LogError('Failed to open: "'+ resources[ResIndex][1] +'"', 'GetResourceStream');
       end;
-      exit;
+      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 );
+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;
+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;
+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;
 // -----------------------------------------------
 
 (*
-- 
cgit v1.2.3


From 3b5af758a1ffb8c02c3fad2ef0acbc0c241b3de5 Mon Sep 17 00:00:00 2001
From: tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Fri, 12 Sep 2008 13:19:17 +0000
Subject: removed resource.inc

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1371 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
 src/base/UCommon.pas | 27 ---------------------------
 1 file changed, 27 deletions(-)

(limited to 'src/base/UCommon.pas')

diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
index 3f41dae6..f2f98537 100644
--- a/src/base/UCommon.pas
+++ b/src/base/UCommon.pas
@@ -25,7 +25,6 @@ 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}
@@ -305,32 +304,6 @@ begin
 {$IFEND}
 end;
 
-
-// include resource-file info (stored in the constant array "resources")
-{$I ../resource.inc}
-
-function GetResourceStream(const aName, aType: string): TStream;
-var
-  ResIndex: integer;
-  Filename: string;
-begin
-  Result := nil;
-
-  for ResIndex := 0 to High(resources) do
-  begin
-    if (Resources[ResIndex][0] = aName ) then
-    begin
-      try
-        Filename := ResourcesPath + Resources[ResIndex][1];
-        Result := TFileStream.Create(Filename, fmOpenRead);
-      except
-        Log.LogError('Failed to open: "'+ resources[ResIndex][1] +'"', 'GetResourceStream');
-      end;
-      Exit;
-    end;
-  end;
-end;
-
 // +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++
 function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;
 var
-- 
cgit v1.2.3


From dbf39d5bfc56c24a67d481187c619dc84828221f Mon Sep 17 00:00:00 2001
From: k-m_schindler <k-m_schindler@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Tue, 23 Sep 2008 21:17:22 +0000
Subject: gpl header added and property svn:header set to "HeadURL Id"

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1403 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
 src/base/UCommon.pas | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

(limited to 'src/base/UCommon.pas')

diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
index f2f98537..6195a680 100644
--- a/src/base/UCommon.pas
+++ b/src/base/UCommon.pas
@@ -1,3 +1,28 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * 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 General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
 unit UCommon;
 
 interface
-- 
cgit v1.2.3


From f0d2b5c1d1e91c70e7e9e0ffd5600bb90a0faf6a Mon Sep 17 00:00:00 2001
From: tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Sat, 25 Oct 2008 10:21:42 +0000
Subject: Some threading questions cleared: - file handling is safe as long as
 only one thread owns the file descriptor - console is safe as long as the
 thread was created by FPC/Delphi

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1469 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
 src/base/UCommon.pas | 17 +++--------------
 1 file changed, 3 insertions(+), 14 deletions(-)

(limited to 'src/base/UCommon.pas')

diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
index 6195a680..a52349c0 100644
--- a/src/base/UCommon.pas
+++ b/src/base/UCommon.pas
@@ -504,22 +504,11 @@ begin
 end;
 
 {*
- * With FPC console output is not thread-safe.
+ * FPC uses threadvars (TLS) managed by FPC for console output locking.
  * 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.
+ * will crash the program as those threadvars have never been initialized.
  * 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
+ * and use it to handle the console-output (hence it is called Console-Handler)
  *}
 procedure ConsoleWriteLn(const msg: string);
 begin
-- 
cgit v1.2.3


From d57509c0c5cbd154bde26be993bd2bb9324d89d6 Mon Sep 17 00:00:00 2001
From: k-m_schindler <k-m_schindler@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Wed, 3 Jun 2009 22:26:24 +0000
Subject: cosmetics. no code change

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1799 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
 src/base/UCommon.pas | 98 +++++++++++++++++++++++++---------------------------
 1 file changed, 48 insertions(+), 50 deletions(-)

(limited to 'src/base/UCommon.pas')

diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
index a52349c0..d729b6dd 100644
--- a/src/base/UCommon.pas
+++ b/src/base/UCommon.pas
@@ -44,28 +44,28 @@ uses
   ULog;
 
 type
-  TMessageType = ( mtInfo, mtError );
+  TMessageType = (mtInfo, mtError);
 
-procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo );
+procedure ShowMessage(const msg: string; msgType: TMessageType = mtInfo);
 
 procedure ConsoleWriteLn(const msg: string);
 
 function RWopsFromStream(Stream: TStream): PSDL_RWops;
 
 {$IFDEF FPC}
-function RandomRange(aMin: Integer; aMax: Integer) : Integer;
+function RandomRange(aMin: integer; aMax: integer): integer;
 {$ENDIF}
 
-function StringReplaceW(text : WideString; search, rep: WideChar):WideString;
-function AdaptFilePaths( const aPath : widestring ): widestring;
+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;
+  procedure ZeroMemory(Destination: pointer; Length: dword);
+  function MakeLong(a, b: word): longint;
   (*
   #define LOBYTE(a) (BYTE)(a)
   #define HIBYTE(a) (BYTE)((a)>>8)
@@ -90,8 +90,8 @@ function IsControlChar(ch: WideChar): boolean;
 // A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below)
 procedure MergeSort(List: TList; CompareFunc: TListSortCompare);
 
-function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer;
-procedure FreeAlignedMem(P: Pointer);
+function GetAlignedMem(Size: cardinal; Alignment: integer): pointer;
+procedure FreeAlignedMem(P: pointer);
 
 
 implementation
@@ -224,10 +224,10 @@ begin
                     exOverflow, exUnderflow, exPrecision]);
 end;
 
-function StringReplaceW(text : WideString; search, rep: WideChar) : WideString;
+function StringReplaceW(text: WideString; search, rep: WideChar): WideString;
 var
-  iPos  : integer;
-//  sTemp : WideString;
+  iPos:  integer;
+//  sTemp: WideString;
 begin
 (*
   result := text;
@@ -251,25 +251,25 @@ begin
   end;
 end;
 
-function AdaptFilePaths( const aPath : widestring ): widestring;
+function AdaptFilePaths(const aPath: WideString): WideString;
 begin
-  result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] );
+  result := StringReplaceW(aPath, '\', PathDelim);//, [rfReplaceAll]);
 end;
 
 
 {$IFNDEF MSWINDOWS}
-procedure ZeroMemory( Destination: Pointer; Length: DWORD );
+procedure ZeroMemory(Destination: pointer; Length: dword);
 begin
-  FillChar( Destination^, Length, 0 );
+  FillChar(Destination^, Length, 0);
 end;
 
-function MakeLong(A, B: Word): Longint;
+function MakeLong(A, B: word): longint;
 begin
   Result := (LongInt(B) shl 16) + A;
 end;
 
 (*
-function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool;
+function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER): Bool;
 
   // From http://en.wikipedia.org/wiki/RDTSC
   function RDTSC: Int64; register;
@@ -310,7 +310,7 @@ begin
   Result := false;
 
   FilePath := ExtractFilePath(FileName);
-  if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then
+  if (FindFirst(FilePath + '*', faAnyFile, SearchInfo) = 0) then
   begin
     LocalFileName := ExtractFileName(FileName);
     repeat
@@ -330,14 +330,14 @@ begin
 end;
 
 // +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++
-function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;
+function SdlStreamSeek(context: PSDL_RWops; offset: integer; whence: integer): integer; cdecl;
 var
-  stream : TStream;
-  origin : Word;
+  stream: TStream;
+  origin: word;
 begin
-  stream := TStream( context.unknown );
-  if ( stream = nil ) then
-    raise EInvalidContainer.Create( 'SDLStreamSeek on nil' );
+  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.
@@ -345,30 +345,30 @@ begin
   else
     origin := soFromBeginning; // just in case
   end;
-  Result := stream.Seek( offset, origin );
+  Result := stream.Seek(offset, origin);
 end;
   
-function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl;
+function SdlStreamRead(context: PSDL_RWops; Ptr: pointer; size: integer; maxnum: integer): integer; cdecl;
 var
-  stream : TStream;
+  stream: TStream;
 begin
-  stream := TStream( context.unknown );
-  if ( stream = nil ) then
-    raise EInvalidContainer.Create( 'SDLStreamRead on nil' );
+  stream := TStream(context.unknown);
+  if (stream = nil) then
+    raise EInvalidContainer.Create('SDLStreamRead on nil');
   try
-    Result := stream.read( Ptr^, Size * maxnum ) div size;
+    Result := stream.read(Ptr^, Size * maxnum) div size;
   except
     Result := -1;
   end;
 end;
   
-function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl;
+function SDLStreamClose(context: PSDL_RWops): integer; cdecl;
 var
-  stream : TStream;
+  stream: TStream;
 begin
-  stream := TStream( context.unknown );
-  if ( stream = nil ) then
-    raise EInvalidContainer.Create( 'SDLStreamClose on nil' );
+  stream := TStream(context.unknown);
+  if (stream = nil) then
+    raise EInvalidContainer.Create('SDLStreamClose on nil');
   stream.Free;
   Result := 1;
 end;
@@ -397,12 +397,10 @@ begin
   end;
 end;
 
-
-
 {$IFDEF FPC}
-function RandomRange(aMin: Integer; aMax: Integer) : Integer;
+function RandomRange(aMin: integer; aMax: integer): integer;
 begin
-  RandomRange := Random(aMax-aMin) + aMin ;
+  RandomRange := Random(aMax - aMin) + aMin ;
 end;
 {$ENDIF}
 
@@ -455,7 +453,7 @@ begin
 
     System.EnterCriticalSection(ConsoleCriticalSection);
     // output pending messages
-    for i := 0 to MessageList.Count-1 do
+    for i := 0 to MessageList.Count - 1 do
     begin
       _ConsoleWriteLn(MessageList[i]);
     end;
@@ -528,7 +526,7 @@ end;
 
 procedure ShowMessage(const msg: String; msgType: TMessageType);
 {$IFDEF MSWINDOWS}
-var Flags: Cardinal;
+var Flags: cardinal;
 {$ENDIF}
 begin
 {$IF Defined(MSWINDOWS)}
@@ -607,7 +605,7 @@ procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: inte
                     CompareFunc: TListSortCompare);
 var
   LeftSize, RightSize: integer; // number of elements in left/right block
-  LeftEnd, RightEnd: integer;   // Index after last element 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
@@ -683,7 +681,7 @@ end;
 type
   // stores the unaligned pointer of data allocated by GetAlignedMem()
   PMemAlignHeader = ^TMemAlignHeader;
-  TMemAlignHeader = Pointer;
+  TMemAlignHeader = pointer;
 
 (**
  * Use this function to assure that allocated memory is aligned on a specific
@@ -699,9 +697,9 @@ type
  * alignments on 16 and 32 byte boundaries too.
  *)
 {$WARNINGS OFF}
-function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer;
+function GetAlignedMem(Size: cardinal; Alignment: integer): pointer;
 var
-  OrigPtr: Pointer;
+  OrigPtr: pointer;
 const
   MIN_ALIGNMENT = 16;
 begin
@@ -722,9 +720,9 @@ begin
   end;
 
   // reserve space for the header
-  Result := Pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader));
+  Result := pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader));
   // align memory
-  Result := Pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment);
+  Result := pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment);
 
   // set header with info on old pointer for FreeMem
   PMemAlignHeader(PtrUInt(Result) - SizeOf(TMemAlignHeader))^ := OrigPtr;
@@ -732,7 +730,7 @@ end;
 {$WARNINGS ON}
 
 {$WARNINGS OFF}
-procedure FreeAlignedMem(P: Pointer);
+procedure FreeAlignedMem(P: pointer);
 begin
   if (P <> nil) then
     FreeMem(PMemAlignHeader(PtrUInt(P) - SizeOf(TMemAlignHeader))^);
-- 
cgit v1.2.3


From 917901e8e33438c425aef50a0a7417f32d77b760 Mon Sep 17 00:00:00 2001
From: s_alexander <s_alexander@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Mon, 9 Nov 2009 00:27:55 +0000
Subject: merged unicode branch (r1931) into trunk

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1939 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
 src/base/UCommon.pas | 321 +++++++++++++--------------------------------------
 1 file changed, 79 insertions(+), 242 deletions(-)

(limited to 'src/base/UCommon.pas')

diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
index d729b6dd..fa0faf3c 100644
--- a/src/base/UCommon.pas
+++ b/src/base/UCommon.pas
@@ -39,9 +39,28 @@ uses
   {$IFDEF MSWINDOWS}
   Windows,
   {$ENDIF}
-  sdl,
   UConfig,
-  ULog;
+  ULog,
+  UPath;
+
+type
+  TStringDynArray = array of string;
+
+const
+  SepWhitespace = [#9, #10, #13, ' ']; // tab, lf, cr, space
+
+{**
+ * Splits a string into pieces separated by Separators.
+ * MaxCount specifies the max. number of pieces. If it is <= 0 the number is
+ * not limited. If > 0 the last array element will hold the rest of the string
+ * (with leading separators removed).
+ *
+ * Examples:
+ *   SplitString(' split  me now ', 0) -> ['split', 'me', 'now']
+ *   SplitString(' split  me now ', 1) -> ['split', 'me now']
+ *}
+function SplitString(const Str: string; MaxCount: integer = 0; Separators: TSysCharSet = SepWhitespace): TStringDynArray;
+
 
 type
   TMessageType = (mtInfo, mtError);
@@ -50,43 +69,19 @@ procedure ShowMessage(const msg: string; msgType: TMessageType = mtInfo);
 
 procedure ConsoleWriteLn(const msg: string);
 
-function RWopsFromStream(Stream: TStream): PSDL_RWops;
-
 {$IFDEF FPC}
 function RandomRange(aMin: integer; aMax: integer): integer;
 {$ENDIF}
 
-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))
-  *)
+procedure ZeroMemory(Destination: pointer; Length: dword);
+function MakeLong(a, b: word): longint;
 {$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);
 
@@ -101,8 +96,63 @@ uses
   {$IFDEF Delphi}
   Dialogs,
   {$ENDIF}
-  UMain;
+  sdl,
+  UFilesystem,
+  UMain,
+  UUnicodeUtils;
+
+function SplitString(const Str: string; MaxCount: integer; Separators: TSysCharSet): TStringDynArray;
+
+  {*
+   * Adds Str[StartPos..Endpos-1] to the result array.
+   *}
+  procedure AddSplit(StartPos, EndPos: integer);
+  begin
+    SetLength(Result, Length(Result)+1);
+    Result[High(Result)] := Copy(Str, StartPos, EndPos-StartPos);
+  end;
 
+var
+  I: integer;
+  Start: integer;
+  Last: integer;
+begin
+  Start := 0;
+  SetLength(Result, 0);
+
+  for I := 1 to Length(Str) do
+  begin
+    if (Str[I] in Separators) then
+    begin
+      // end of component found
+      if (Start > 0) then
+      begin
+        AddSplit(Start, I);
+        Start := 0;
+      end;
+    end
+    else if (Start = 0) then
+    begin
+      // mark beginning of component
+      Start := I;
+      // check if this is the last component
+      if (Length(Result) = MaxCount-1) then
+      begin
+        // find last non-separator char
+        Last := Length(Str);
+        while (Str[Last] in Separators) do
+          Dec(Last);
+        // add component up to last non-separator
+        AddSplit(Start, Last);
+        Exit;
+      end;
+    end;
+  end;
+
+  // last component
+  if (Start > 0) then
+    AddSplit(Start, Length(Str)+1);
+end;
 
 // data used by the ...Locale() functions
 {$IF Defined(Linux) or Defined(FreeBSD)}
@@ -224,39 +274,6 @@ begin
                     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 := 1 to length(result) 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
@@ -268,135 +285,8 @@ 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(CLOCK_REALTIME, ...) here (but not from the libc unit)
-  lpPerformanceCount := RDTSC();
-  result := true;
-end;
-
-function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;
-begin
-  // clock_getres(CLOCK_REALTIME, ...)
-  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
-{$IF Defined(Linux) or Defined(FreeBSD)}
-  // 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}
-  // Windows and Mac OS X do not have case sensitive file systems
-  Result := FileExists(FileName);
-{$IFEND}
-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
@@ -541,59 +431,6 @@ begin
 {$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
-- 
cgit v1.2.3


From 962f21e84feb128c650c0478a6f7af337dacaee6 Mon Sep 17 00:00:00 2001
From: whiteshark0 <whiteshark0@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Thu, 15 Apr 2010 17:57:15 +0000
Subject: - port theme detection code from UIni to UThemes - load new value
 DefaultSkin from themefiles - load value Color (skins default color) from
 skinfiles - use default skin and color on first start - use default skin and
 color on theme/skin change

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2241 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
 src/base/UCommon.pas | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

(limited to 'src/base/UCommon.pas')

diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
index fa0faf3c..18022337 100644
--- a/src/base/UCommon.pas
+++ b/src/base/UCommon.pas
@@ -45,6 +45,7 @@ uses
 
 type
   TStringDynArray = array of string;
+  TUTF8StringDynArray = array of UTF8String;
 
 const
   SepWhitespace = [#9, #10, #13, ' ']; // tab, lf, cr, space
@@ -88,6 +89,8 @@ procedure MergeSort(List: TList; CompareFunc: TListSortCompare);
 function GetAlignedMem(Size: cardinal; Alignment: integer): pointer;
 procedure FreeAlignedMem(P: pointer);
 
+function GetArrayIndex(const SearchArray: array of UTF8String; Value: string; CaseInsensitiv: boolean = false): integer;
+
 
 implementation
 
@@ -514,6 +517,28 @@ begin
   TempList.Free;
 end;
 
+(**
+ * Returns the index of Value in SearchArray
+ * or -1 if Value is not in SearchArray.
+ *)
+function GetArrayIndex(const SearchArray: array of UTF8String; Value: string;
+    CaseInsensitiv: boolean = false): integer;
+var
+  i: integer;
+begin
+  Result := -1;
+
+  for i := 0 to High(SearchArray) do
+  begin
+    if (SearchArray[i] = Value) or
+       (CaseInsensitiv and (CompareText(SearchArray[i], Value) = 0)) then
+    begin
+      Result := i;
+      Break;
+    end;
+  end;
+end;
+
 
 type
   // stores the unaligned pointer of data allocated by GetAlignedMem()
-- 
cgit v1.2.3