- reverted some stuff that was erroneously commited by one of the last commits.

- moved DEBUG define from config-*.inc back to switches.inc
- APPTYPE is needed by FPC (for Windows) too. Fixed some crashes with Writeln in FPC (Win) if no console is available.
- Moved thread-safe ULog.SafeWriteln() to UCommon.ConsoleWriteln(), this is used by DebugWriteln() now, so this is thread-safe too
- Added log-levels (sorted by severity): DEBUG, INFO, STATUS, WARN, ERROR, CRITICAL. Default log-level is LOG_LEVEL_ERROR, so warnings and less important logs are not printed by default. You can change this by LOG_LEVEL_DEFAULT or Log.SetLogLevel(Level). Please use Log.LogError/Warn/Status/Info/Debug/... instead of DebugWriteln() to avoid spamming the console. See ULog.pas for further info.

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

5 files changed, 859 insertions, 712 deletions

diff --git a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas
index 8903bc09..209e1838 100644
--- a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas
+++ b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas
@@ -372,7 +372,7 @@ begin
       if(url_feof(pbIOCtx) <> 0) then
       begin
         {$IFDEF DebugFFMpegDecode}
-        SafeWriteLn('feof');
+        DebugWriteln('feof');
         {$ENDIF}
         eofState := true;
         continue;
@@ -382,7 +382,7 @@ begin
       if(url_ferror(pbIOCtx) = 0) then
       begin
         {$IFDEF DebugFFMpegDecode}
-        SafeWriteLn('Errorf');
+        DebugWriteln('Errorf');
         {$ENDIF}
         // no error -> wait for user input
         SDL_Delay(100);
@@ -397,11 +397,11 @@ begin
       end;
     end;
 
-    //SafeWriteLn( 'ffmpeg - av_read_frame' );
+    //DebugWriteln( 'ffmpeg - av_read_frame' );
 
     if(packet.stream_index = ffmpegStreamIndex) then
     begin
-      //SafeWriteLn( 'packet_queue_put' );
+      //DebugWriteln( 'packet_queue_put' );
       packetQueue.put(@packet);
     end
     else
@@ -425,7 +425,7 @@ begin
   begin
     while (audio_pkt_size > 0) do
     begin
-      //SafeWriteLn( 'got audio packet' );
+      //DebugWriteln( 'got audio packet' );
       data_size := bufSize;
 
       {$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0
@@ -438,13 +438,13 @@ begin
                   data_size, audio_pkt_data, audio_pkt_size);
       {$IFEND}
 
-      //SafeWriteLn('avcodec_decode_audio : ' + inttostr( len1 ));
+      //DebugWriteln('avcodec_decode_audio : ' + inttostr( len1 ));
 
       if(len1 < 0) then
       begin
         // if error, skip frame
         {$IFDEF DebugFFMpegDecode}
-        SafeWriteLn( 'Skip audio frame' );
+        DebugWriteln( 'Skip audio frame' );
         {$ENDIF}
         audio_pkt_size := 0;
         break;
@@ -482,7 +482,7 @@ begin
     begin
       avcodec_flush_buffers(pCodecCtx);
       {$IFDEF DebugFFMpegDecode}
-      SafeWriteLn('Flush');
+      DebugWriteln('Flush');
       {$ENDIF}
       continue;
     end;
@@ -493,13 +493,13 @@ begin
       // end-of-file reached -> set EOF-flag
       SetEOF(true);
       {$IFDEF DebugFFMpegDecode}
-      SafeWriteLn('EOF');
+      DebugWriteln('EOF');
       {$ENDIF}
       // note: buffer is not (even partially) filled -> no data to return
       exit;
     end;
 
-    //SafeWriteLn( 'Audio Packet Size - ' + inttostr(audio_pkt_size) );
+    //DebugWriteln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) );
   end;
 end;
 
@@ -522,14 +522,14 @@ begin
     begin
       // we have already sent all our data; get more
       audio_size := DecodeFrame(audio_buf, sizeof(TAudioBuffer));
-      //SafeWriteLn('audio_decode_frame : '+ inttostr(audio_size));
+      //DebugWriteln('audio_decode_frame : '+ inttostr(audio_size));
 
       if(audio_size < 0) then
       begin
         // if error, output silence
         audio_buf_size := 1024;
         FillChar(audio_buf, audio_buf_size, #0);
-        //SafeWriteLn( 'Silence' );
+        //DebugWriteln( 'Silence' );
       end
       else
       begin
@@ -731,7 +731,7 @@ begin
     Self.lastPkt := pkt1;
     inc(Self.nbPackets);
 
-    //SafeWriteLn('Put: ' + inttostr(nbPackets));
+    //DebugWriteln('Put: ' + inttostr(nbPackets));
 
     Self.size := Self.size + pkt1^.pkt.size;
     SDL_CondSignal(Self.cond);
@@ -765,7 +765,7 @@ begin
           Self.lastPkt := nil;
         dec(Self.nbPackets);
 
-        //SafeWriteLn('Get: ' + inttostr(nbPackets));
+        //DebugWriteln('Get: ' + inttostr(nbPackets));
 
         Self.size := Self.size - pkt1^.pkt.size;
         pkt := pkt1^.pkt;
diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas
index 7539a958..5af018b7 100644
--- a/Game/Code/Classes/UCommon.pas
+++ b/Game/Code/Classes/UCommon.pas
@@ -1,470 +1,622 @@
-unit UCommon;
-
-interface
-
-{$IFDEF FPC}
-  {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
-  SysUtils,
-  Classes,
-  {$IFDEF MSWINDOWS}
-  Windows,
-  Messages,
-  {$ENDIF}
-  ULog;
-
-{$IFNDEF DARWIN}
-// FIXME: remove this if it is not needed anymore
-type
-  hStream        = THandle;
-  HGLRC          = THandle;
-  TLargeInteger  = Int64;
-  TWin32FindData = LongInt;
-{$ENDIF}
-
-function GetResourceStream(const aName, aType : string): TStream;
-
-procedure ShowMessage( const msg : String );
-
-{$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 win32}
-  procedure ZeroMemory( Destination: Pointer; Length: DWORD );
-{$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;
-
-
-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 win32}
-procedure ZeroMemory( Destination: Pointer; Length: DWORD );
-begin
-  FillChar( Destination^, Length, 0 );
-end; //ZeroMemory
-
-(*
-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 Linux}
-  // include resource-file info (stored in the constant array "resources")
-  {$I ../resource.inc}
-{$ENDIF}
-
-function GetResourceStream(const aName, aType: string): TStream;
-{$IFDEF Linux}
-var
-  ResIndex: integer;
-  Filename: string;
-{$ENDIF}
-begin
-  Result := nil;
-
-  {$IFDEF Linux}
-  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;
-
-{$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, '',
-    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}
-
-procedure ShowMessage( const msg : String );
-begin
-{$IF Defined(MSWINDOWS)}
-  MessageBox(0, PChar(msg), PChar(USDXVersionStr()), MB_ICONINFORMATION);
-{$ELSE}
-  debugwriteln(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;
-
-end.
+unit UCommon;

+

+interface

+

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

+{$I switches.inc}

+

+uses

+  SysUtils,

+  Classes,

+  {$IFDEF MSWINDOWS}

+  Windows,

+  Messages,

+  {$ENDIF}

+  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;

+

+{$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 win32}

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

+{$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;

+

+

+implementation

+

+uses

+  Math,

+  {$IFDEF Delphi}

+  Dialogs,

+  {$ENDIF}

+  {$IFDEF LINUX}

+  libc,

+  {$ENDIF}

+  {$IFDEF FPC}

+  sdl,

+  {$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; //ZeroMemory

+

+(*

+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 Linux}

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

+  {$I ../resource.inc}

+{$ENDIF}

+

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

+{$IFDEF Linux}

+var

+  ResIndex: integer;

+  Filename: string;

+{$ENDIF}

+begin

+  Result := nil;

+

+  {$IFDEF Linux}

+  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;

+

+{$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, '',

+    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;

+  ConsoleMutex: PSDL_Mutex;

+  ConsoleCond: PSDL_Cond;

+  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

+    SDL_mutexP(ConsoleMutex);

+    // wait for new output or quit-request

+    while ((MessageList.Count = 0) and (not ConsoleQuit)) do

+      SDL_CondWait(ConsoleCond, ConsoleMutex);

+    // 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;

+

+    SDL_mutexV(ConsoleMutex);

+  end;

+  result := 0;

+end;

+{$ENDIF}

+

+procedure InitConsoleOutput();

+begin

+  {$IFDEF FPC}

+  // init thread-safe output

+  MessageList := TStringList.Create();

+  ConsoleMutex := SDL_CreateMutex();

+  ConsoleCond := SDL_CreateCond();

+  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

+  SDL_mutexP(ConsoleMutex);

+  ConsoleQuit := true;

+  SDL_CondSignal(ConsoleCond);

+  SDL_mutexV(ConsoleMutex);

+  WaitForThreadTerminate(ConsoleHandler, 0);

+  // free data

+  SDL_DestroyCond(ConsoleCond);

+  SDL_DestroyMutex(ConsoleMutex);

+  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

+ *       - Use TEvent and TCriticalSection instead of the SDL equivalents.

+ *           Note: If those two objects use TLS they might crash FPC too.

+ *}

+procedure ConsoleWriteLn(const msg: string);

+begin

+{$IFDEF CONSOLE}

+  {$IFDEF FPC}

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

+  //GetCurrentThreadThreadId();

+  SDL_mutexP(ConsoleMutex);

+  MessageList.Add(msg);

+  SDL_CondSignal(ConsoleCond);

+  SDL_mutexV(ConsoleMutex);

+  {$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;

+

+initialization

+  InitConsoleOutput();

+

+finalization

+  FinalizeConsoleOutput();

+

+end.

diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas
index 2a628792..d2664b1e 100644
--- a/Game/Code/Classes/ULog.pas
+++ b/Game/Code/Classes/ULog.pas
@@ -11,21 +11,52 @@ interface
 uses

   Classes;

 

+(*

+ * LOG_LEVEL_[TYPE] defines the "minimum" index for logs of type TYPE. Each

+ * level greater than this BUT less or equal than LOG_LEVEL_[TYPE]_MAX is of this type.  

+ * This means a level "LOG_LEVEL_ERROR >= Level <= LOG_LEVEL_ERROR_MAX" e.g.

+ * "Level := LOG_LEVEL_ERROR+2" is considered an error level.

+ * This is nice for debugging if you have more or less important debug messages.

+ * For example you can assign LOG_LEVEL_DEBUG+10 for the more important ones and

+ * LOG_LEVEL_DEBUG+20 for less important ones and so on. By changing the log-level

+ * you can hide the less important ones.  

+ *)

+const

+  LOG_LEVEL_DEBUG_MAX    = MaxInt;

+  LOG_LEVEL_DEBUG        = 50;

+  LOG_LEVEL_INFO_MAX     = LOG_LEVEL_DEBUG-1;

+  LOG_LEVEL_INFO         = 40;

+  LOG_LEVEL_STATUS_MAX   = LOG_LEVEL_INFO-1;

+  LOG_LEVEL_STATUS       = 30;

+  LOG_LEVEL_WARN_MAX     = LOG_LEVEL_STATUS-1;

+  LOG_LEVEL_WARN         = 20;

+  LOG_LEVEL_ERROR_MAX    = LOG_LEVEL_WARN-1;

+  LOG_LEVEL_ERROR        = 10;

+  LOG_LEVEL_CRITICAL_MAX = LOG_LEVEL_ERROR-1;

+  LOG_LEVEL_CRITICAL     =  0;

+  LOG_LEVEL_NONE         = -1;

+  

+  LOG_LEVEL_DEFAULT = LOG_LEVEL_ERROR;

+

 type

   TLog = class

+  private

+    LogFile:             TextFile;

+    LogFileOpened:       boolean;

+    BenchmarkFile:       TextFile;

+    BenchmarkFileOpened: boolean;

+

+    LogLevel: integer;

+

+    procedure LogToFile(const Text: string);

   public

     BenchmarkTimeStart:   array[0..7] of real;

     BenchmarkTimeLength:  array[0..7] of real;//TDateTime;

 

-    FileBenchmark:    TextFile;

-    FileBenchmarkO:   boolean; // opened

-    FileError:        TextFile;

-    FileErrorO:       boolean; // opened

-

     Title: String; //Application Title

 

-    //Should Log Files be written

-    Enabled:          Boolean;

+    // Write log message to log-file

+    FileOutputEnabled: Boolean;

 

     constructor Create;

 

@@ -35,25 +66,30 @@ type
     // benchmark

     procedure BenchmarkStart(Number: integer);

     procedure BenchmarkEnd(Number: integer);

-    procedure LogBenchmark(Text: string; Number: integer);

-

-    // error

-    procedure LogError(Text: string); overload;

-

+    procedure LogBenchmark(const Text: string; Number: integer);

+

+    procedure SetLogLevel(Level: integer);

+    function GetLogLevel(): integer;

+

+    procedure LogMsg(const Text: string; Level: integer); overload;

+    procedure LogMsg(const Msg, Context: string; Level: integer); overload; {$IFDEF HasInline}inline;{$ENDIF}

+    procedure LogDebug(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}

+    procedure LogInfo(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}

+    procedure LogStatus(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}

+    procedure LogWarn(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}

+    procedure LogError(const Text: string); overload; {$IFDEF HasInline}inline;{$ENDIF}

+    procedure LogError(const Msg, Context: string); overload; {$IFDEF HasInline}inline;{$ENDIF}

     //Critical Error (Halt + MessageBox)

-    procedure CriticalError(Text: string);

+    procedure LogCritical(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}

+    procedure CriticalError(const Text: string); {$IFDEF HasInline}inline;{$ENDIF}

 

     // voice

     procedure LogVoice(SoundNr: integer);

-

-    // compability

-    procedure LogStatus(Log1, Log2: string);

-    procedure LogError(Log1, Log2: string); overload;

-    procedure LogBuffer(const buf : Pointer; const bufLength : Integer; filename : string);

+    // buffer

+    procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : string);

   end;

 

-procedure SafeWriteLn(const msg: string); {$IFDEF HasInline}inline;{$ENDIF}

-procedure debugWriteln( aString : String );

+procedure DebugWriteln(const aString: String);

 

 var

   Log:    TLog;

@@ -61,113 +97,45 @@ var
 implementation

 

 uses

-  {$IFDEF win32}

-  windows,

-  {$ENDIF}

   SysUtils,

   DateUtils,

-//UFiles,

   URecord,

   UMain,  

   UTime,

-//UIni,  // JB - Seems to not be needed.

-  {$IFDEF FPC}

-  sdl,

-  {$ENDIF}

+  UCommon,

   UCommandLine;

 

-{$IFDEF FPC}

-var

-  MessageList: TStringList;

-  ConsoleHandler: TThreadID;

-  ConsoleMutex: PSDL_Mutex;

-  ConsoleCond: PSDL_Cond;

-{$ENDIF}

-

-{$IFDEF FPC}

-{*

- * The console-handlers main-function.

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

- *}

-function ConsoleHandlerFunc(param: pointer): PtrInt;

-var

-  i: integer;

+(*

+ * Write to console if in debug mode (Thread-safe).

+ * If debug-mode is disabled nothing is done. 

+ *)

+procedure DebugWriteln(const aString: string);

 begin

-  while true do

+  {$IFNDEF DEBUG}

+  if Params.Debug then

   begin

-    SDL_mutexP(ConsoleMutex);

-    while (MessageList.Count = 0) do

-      SDL_CondWait(ConsoleCond, ConsoleMutex);

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

-    begin

-      WriteLn(MessageList[i]);

-    end;

-    MessageList.Clear();

-    SDL_mutexV(ConsoleMutex);

+  {$ENDIF}

+    ConsoleWriteLn(aString);

+  {$IFNDEF DEBUG}

   end;

-  result := 0;

-end;

-{$ENDIF}

-

-{*

- * 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

- *       - Use TEvent and TCriticalSection instead of the SDL equivalents.

- *           Note: If those two objects use TLS they might crash FPC too.

- *}

-procedure SafeWriteLn(const msg: string);

-begin

-{$IFDEF FPC}

-  SDL_mutexP(ConsoleMutex);

-  MessageList.Add(msg);

-  SDL_CondSignal(ConsoleCond);

-  SDL_mutexV(ConsoleMutex);

-{$ELSE}

-  debugWriteln(msg);

-{$ENDIF}

-end;

-

-procedure debugWriteln( aString : String );

-begin

-  {$IFDEF CONSOLE}

-    if FindCmdLineSwitch( cDebug ) then

-      writeln( 'DEBUG - '+aString );

   {$ENDIF}

-

 end;

 

 

 constructor TLog.Create;

 begin

-{$IFDEF FPC}

-  // TODO: check for the main-thread?

-  //GetCurrentThreadThreadId();

-  MessageList := TStringList.Create();

-  ConsoleMutex := SDL_CreateMutex();

-  ConsoleCond := SDL_CreateCond();

-  ConsoleHandler := BeginThread(@ConsoleHandlerFunc);

-{$ENDIF}

+  LogLevel := LOG_LEVEL_DEFAULT;

+  FileOutputEnabled := true;

 end;

 

 destructor TLog.Destroy;

 begin

-  if FileBenchmarkO then CloseFile(FileBenchmark);

-//  if FileAnalyzeO then CloseFile(FileAnalyze);

-  if FileErrorO then CloseFile(FileError);

+  if BenchmarkFileOpened then

+    CloseFile(BenchmarkFile);

+  //if AnalyzeFileOpened then

+  //  CloseFile(AnalyzeFile);

+  if LogFileOpened then

+    CloseFile(LogFile);

 end;

 

 procedure TLog.BenchmarkStart(Number: integer);

@@ -180,7 +148,7 @@ begin
   BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number];

 end;

 

-procedure TLog.LogBenchmark(Text: string; Number: integer);

+procedure TLog.LogBenchmark(const Text: string; Number: integer);

 var

   Minutes:      integer;

   Seconds:      integer;

@@ -192,27 +160,31 @@ var
 

   ValueText:    string;

 begin

-  if Enabled AND (Params.Benchmark) then begin

-    if not FileBenchmarkO then begin

-      FileBenchmarkO := true;

-      AssignFile(FileBenchmark, LogPath + 'Benchmark.log');

+  if (FileOutputEnabled and Params.Benchmark) then

+  begin

+    if not BenchmarkFileOpened then

+    begin

+      BenchmarkFileOpened := true;

+      AssignFile(BenchmarkFile, LogPath + 'Benchmark.log');

       {$I-}

-      Rewrite(FileBenchmark);

-      if IOResult = 0 then FileBenchmarkO := true;

+      Rewrite(BenchmarkFile);

+      if IOResult = 0 then

+        BenchmarkFileOpened := true;

       {$I+}

 

       //If File is opened write Date to Benchmark File

-      If (FileBenchmarkO) then

+      If (BenchmarkFileOpened) then

       begin

-        WriteLn(FileBenchmark, Title + ' Benchmark File');

-        WriteLn(FileBenchmark, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));

-        WriteLn(FileBenchmark, '-------------------');

+        WriteLn(BenchmarkFile, Title + ' Benchmark File');

+        WriteLn(BenchmarkFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));

+        WriteLn(BenchmarkFile, '-------------------');

 

-        Flush(FileBenchmark);

+        Flush(BenchmarkFile);

       end;

     end;

 

-  if FileBenchmarkO then begin

+  if BenchmarkFileOpened then

+  begin

     Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000);

     Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60;

     Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60);

@@ -232,7 +204,8 @@ begin
 

     if (Minutes = 0) and (Seconds >= 1) then begin

       MilisecondsS := IntToStr(Miliseconds);

-      while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS;

+      while Length(MilisecondsS) < 3 do

+        MilisecondsS := '0' + MilisecondsS;

 

       SecondsS := IntToStr(Seconds);

 

@@ -241,115 +214,176 @@ begin
 

     if Minutes >= 1 then begin

       MilisecondsS := IntToStr(Miliseconds);

-      while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS;

+      while Length(MilisecondsS) < 3 do

+        MilisecondsS := '0' + MilisecondsS;

 

       SecondsS := IntToStr(Seconds);

-      while Length(SecondsS) < 2 do SecondsS := '0' + SecondsS;

+      while Length(SecondsS) < 2 do

+        SecondsS := '0' + SecondsS;

 

       MinutesS := IntToStr(Minutes);

 

       ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes';

     end;

 

-    WriteLn(FileBenchmark, Text + ': ' + ValueText);

-    Flush(FileBenchmark);

+    WriteLn(BenchmarkFile, Text + ': ' + ValueText);

+    Flush(BenchmarkFile);

     end;

   end;

 end;

 

-procedure TLog.LogError(Text: string);

+procedure TLog.LogToFile(const Text: string);

 begin

-  if Enabled AND (not FileErrorO) then begin

-    //FileErrorO := true;

-    AssignFile(FileError, LogPath + 'Error.log');

+  if (FileOutputEnabled and not LogFileOpened) then

+  begin

+    AssignFile(LogFile, LogPath + 'Error.log');

     {$I-}

-    Rewrite(FileError);

-    if IOResult = 0 then FileErrorO := true;

+    Rewrite(LogFile);

+    if IOResult = 0 then

+      LogFileOpened := true;

     {$I+}

 

     //If File is opened write Date to Error File

-    If (FileErrorO) then

+    if (LogFileOpened) then

     begin

-      WriteLn(FileError, Title + ' Error Log');

-      WriteLn(FileError, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));

-      WriteLn(FileError, '-------------------');

+      WriteLn(LogFile, Title + ' Error Log');

+      WriteLn(LogFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));

+      WriteLn(LogFile, '-------------------');

 

-      Flush(FileError);

+      Flush(LogFile);

     end;

   end;

 

-  if FileErrorO then begin

+  if LogFileOpened then

+  begin

     try

-      WriteLn(FileError, Text);

-      Flush(FileError);

+      WriteLn(LogFile, Text);

+      Flush(LogFile);

     except

-      FileErrorO := false;

+      LogFileOpened := false;

     end;

   end;

-  {$IFDEF DEBUG}

-  SafeWriteLn('Error: ' + Text);

-  {$ENDIF}

 end;

 

-procedure TLog.LogVoice(SoundNr: integer);

+procedure TLog.SetLogLevel(Level: integer);

+begin

+  LogLevel := Level;

+end;

+

+function TLog.GetLogLevel(): integer;

+begin

+  Result := LogLevel;

+end;

+

+procedure TLog.LogMsg(const Text: string; Level: integer);

 var

-// FileVoice:    File; // Auto Removed, Unused Variable

-  FS:           TFileStream;

-  FileName:     string;

-  Num:          integer;

+  LogMsg: string;

 begin

-  for Num := 1 to 9999 do begin

-    FileName := IntToStr(Num);

-    while Length(FileName) < 4 do FileName := '0' + FileName;

-    FileName := LogPath + 'Voice' + FileName + '.raw';

-    if not FileExists(FileName) then break

+  if (Level <= LogLevel) then

+  begin

+    if (Level <= LOG_LEVEL_CRITICAL_MAX) then

+      LogMsg := 'CRITICAL: ' + Text

+    else if (Level <= LOG_LEVEL_ERROR_MAX) then

+      LogMsg := 'ERROR:  ' + Text

+    else if (Level <= LOG_LEVEL_WARN_MAX) then

+      LogMsg := 'WARN:   ' + Text

+    else if (Level <= LOG_LEVEL_STATUS_MAX) then

+      LogMsg := 'STATUS: ' + Text

+    else if (Level <= LOG_LEVEL_INFO_MAX) then

+      LogMsg := 'INFO:   ' + Text

+    else

+      LogMsg := 'DEBUG:  ' + Text;

+

+    // output log-message

+    DebugWriteLn(LogMsg);

+

+    // actions for error- and more severe levels

+    if (Level <= LOG_LEVEL_ERROR_MAX) then

+    begin

+      // Write message to log-file

+      LogToFile(Text);

+    end;

+

+    // actions for critical- and more severe levels

+    if (Level <= LOG_LEVEL_CRITICAL_MAX) then

+    begin

+      // Show information (window)

+      ShowMessage(Text, mtError);

+      // Exit Application

+      Halt;

+    end;

   end;

+end;

 

+procedure TLog.LogMsg(const Msg, Context: string; Level: integer);

+begin

+  LogMsg(Msg + ' ['+Context+']', Level);

+end;

 

-  FS := TFileStream.Create(FileName, fmCreate);

+procedure TLog.LogDebug(const Msg, Context: string);

+begin

+  LogMsg(Msg, Context, LOG_LEVEL_DEBUG);

+end;

 

-  AudioInputProcessor.Sound[SoundNr].BufferLong.Seek(0, soBeginning);

-  FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong, AudioInputProcessor.Sound[SoundNr].BufferLong.Size);

+procedure TLog.LogInfo(const Msg, Context: string);

+begin

+  LogMsg(Msg, Context, LOG_LEVEL_INFO);

+end;

 

-  FS.Free;

+procedure TLog.LogStatus(const Msg, Context: string);

+begin

+  LogMsg(Msg, Context, LOG_LEVEL_STATUS);

 end;

 

-procedure TLog.LogStatus(Log1, Log2: string);

+procedure TLog.LogWarn(const Msg, Context: string);

 begin

-  //Just for Debugging

-  //Comment for Release    

-  //LogError(Log2 + ': ' + Log1);

+  LogMsg(Msg, Context, LOG_LEVEL_WARN);

+end;

 

-  //If Debug => Write to Console Output

-  {$IFDEF DEBUG}

-  // SafeWriteLn(Log2 + ': ' + Log1);

-  {$ENDIF}

+procedure TLog.LogError(const Msg, Context: string);

+begin

+  LogMsg(Msg, Context, LOG_LEVEL_ERROR);

 end;

 

-procedure TLog.LogError(Log1, Log2: string);

+procedure TLog.LogError(const Text: string);

 begin

-  LogError(Log1 + ' ['+Log2+']');

+  LogMsg(Text, LOG_LEVEL_ERROR);

 end;

 

-procedure TLog.CriticalError(Text: string);

+procedure TLog.CriticalError(const Text: string);

 begin

-  //Write Error to Logfile:

-  LogError (Text);

-

-  {$IFDEF MSWINDOWS}

-  //Show Errormessage

-  Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK);

-  {$ELSE}

-  // TODO - JB_Linux handle critical error so user can see message.

-  SafeWriteLn( 'Critical ERROR :' );

-  SafeWriteLn( Text );

-  {$ENDIF}

+  LogMsg(Text, LOG_LEVEL_CRITICAL);

+end;

+

+procedure TLog.LogCritical(const Msg, Context: string);

+begin

+  LogMsg(Msg, Context, LOG_LEVEL_CRITICAL);

+end;

 

-  //Exit Application

-  Halt;

+procedure TLog.LogVoice(SoundNr: integer);

+var

+  FS:           TFileStream;

+  FileName:     string;

+  Num:          integer;

+begin

+  for Num := 1 to 9999 do begin

+    FileName := IntToStr(Num);

+    while Length(FileName) < 4 do

+      FileName := '0' + FileName;

+    FileName := LogPath + 'Voice' + FileName + '.raw';

+    if not FileExists(FileName) then

+      break

+  end;

+

+  FS := TFileStream.Create(FileName, fmCreate);

+

+  AudioInputProcessor.Sound[SoundNr].BufferLong.Seek(0, soBeginning);

+  FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong, AudioInputProcessor.Sound[SoundNr].BufferLong.Size);

+

+  FS.Free;

 end;

 

-procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; filename: string);

+procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: string);

 var

   f : TFileStream;

 begin

diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas
index 2e49ac8d..5dc03fe8 100644
--- a/Game/Code/Classes/UMain.pas
+++ b/Game/Code/Classes/UMain.pas
@@ -165,7 +165,7 @@ begin
     // Log + Benchmark
     Log := TLog.Create;
     Log.Title := WndTitle;
-    Log.Enabled := not Params.NoLog;
+    Log.FileOutputEnabled := not Params.NoLog;
     Log.BenchmarkStart(0);
 
     // Language
diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas
index a56c0096..07dc309f 100644
--- a/Game/Code/Classes/UTexture.pas
+++ b/Game/Code/Classes/UTexture.pas
@@ -137,48 +137,7 @@ uses ULog,
      {$IFDEF DARWIN}
      MacResources,
      {$ENDIF}
-     StrUtils,
-     dialogs;
-
-const
-  fmt_rgba: TSDL_Pixelformat = (
-    palette:      nil;
-    BitsPerPixel:  32;
-    BytesPerPixel:  4;
-    Rloss:          0;
-    Gloss:          0;
-    Bloss:          0;
-    Aloss:          0;
-    Rshift:         0;
-    Gshift:         8;
-    Bshift:        16;
-    Ashift:        24;
-    Rmask:  $000000ff;
-    Gmask:  $0000ff00;
-    Bmask:  $00ff0000;
-    Amask:  $ff000000;
-    ColorKey:       0;
-    Alpha:        255
-  );
-  fmt_rgb: TSDL_Pixelformat = (
-    palette:      nil;
-    BitsPerPixel:  24;
-    BytesPerPixel:  3;
-    Rloss:          0;
-    Gloss:          0;
-    Bloss:          0;
-    Aloss:          0;
-    Rshift:         0;
-    Gshift:         8;
-    Bshift:        16;
-    Ashift:         0;
-    Rmask:  $000000ff;
-    Gmask:  $0000ff00;
-    Bmask:  $00ff0000;
-    Amask:  $00000000;
-    ColorKey:       0;
-    Alpha:        255
-  );
+     StrUtils;
 
 Constructor TTextureUnit.Create;
 begin
@@ -530,7 +489,8 @@ begin
   {$endif}
   if not assigned(TexSurface) then
   begin
-    Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ TextureTypeToStr(Typ) );
+    Log.LogError('Could not load texture: "' + Identifier +' '+ TextureTypeToStr(Typ) +'"',
+                 'TTextureUnit.LoadTexture');
     Exit;
   end;
 
@@ -851,7 +811,8 @@ begin
         Log.LogStatus(' Error creating Cover Thumbnail',' LoadTexture('''+Name+''')');
     end
     else
-      Log.LogStatus( 'ERROR Could not load texture for Cover Thumbnail: ' , name+' '+ TextureTypeToStr(Typ) );
+      Log.LogError('Could not load texture for Cover Thumbnail: "' + name+' '+ TextureTypeToStr(Typ) +'"',
+                   'TTextureUnit.GetCoverThumbnail');
 
     SDL_FreeSurface(TexSurface);
   end;
@@ -1025,7 +986,7 @@ begin
       Exit;
     end;
   end;
-  Log.LogError('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType');
+  Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType');
   Result := TEXTURE_TYPE_PLAIN;
 end;