diff options
Diffstat (limited to '')
-rw-r--r-- | Game/Code/Classes/UAudioDecoder_FFMpeg.pas | 28 | ||||
-rw-r--r-- | Game/Code/Classes/UCommon.pas | 1092 | ||||
-rw-r--r-- | Game/Code/Classes/ULog.pas | 398 | ||||
-rw-r--r-- | Game/Code/Classes/UMain.pas | 2 | ||||
-rw-r--r-- | Game/Code/Classes/UTexture.pas | 51 |
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; |