From 0d86a79ad303441af3080f1c744da0c556927425 Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 24 Apr 2008 12:47:09 +0000 Subject: - 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 --- Game/Code/Classes/UAudioDecoder_FFMpeg.pas | 28 +- Game/Code/Classes/UCommon.pas | 1092 ++++++++++++++++------------ Game/Code/Classes/ULog.pas | 398 +++++----- Game/Code/Classes/UMain.pas | 2 +- Game/Code/Classes/UTexture.pas | 51 +- Game/Code/Screens/UScreenScore.pas | 12 - Game/Code/UltraStar.dpr | 498 ++++++------- Game/Code/config-macosx.inc | 6 +- Game/Code/config-win.inc | 4 - Game/Code/switches.inc | 22 +- 10 files changed, 1130 insertions(+), 983 deletions(-) (limited to 'Game') 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; diff --git a/Game/Code/Screens/UScreenScore.pas b/Game/Code/Screens/UScreenScore.pas index 9a13681b..516d8df0 100644 --- a/Game/Code/Screens/UScreenScore.pas +++ b/Game/Code/Screens/UScreenScore.pas @@ -619,7 +619,6 @@ begin end; // end todo - {{$IFDEF TRANSLATE} case (Player[PlayerNumber-1].ScoreTotalI) of 0..2000: begin @@ -657,17 +656,6 @@ begin Rating := 6; end; end; - {{$ELSE}{ - case (Player[PlayerNumber-1].ScoreTotalI) of - 0..2000: Text[TextScore[fu]].Text := 'Tone Deaf'; - 2010..4000: Text[TextScore[fu]].Text := 'Amateur'; - 4010..6000: Text[TextScore[fu]].Text := 'Rising Star'; - 6010..8000: Text[TextScore[fu]].Text := 'Lead Singer'; - 8010..9000: Text[TextScore[fu]].Text := 'Hit Artist'; - 9010..9800: Text[TextScore[fu]].Text := 'Superstar'; - 9810..10000: Text[TextScore[fu]].Text := 'Ultrastar'; - end; - {$ENDIF} // Bounce the rating picture in PosX := aPlayerScoreScreenRatings[PlayerNumber].RatePic_X + (aPlayerScoreScreenRatings[PlayerNumber].RatePic_Width / 2); diff --git a/Game/Code/UltraStar.dpr b/Game/Code/UltraStar.dpr index 3cfe2b2d..f7f95365 100644 --- a/Game/Code/UltraStar.dpr +++ b/Game/Code/UltraStar.dpr @@ -1,243 +1,255 @@ -program UltraStar; - -{$IFDEF MSWINDOWS} - {$R 'UltraStar.res' 'UltraStar.rc'} -{$ENDIF} - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - {$IFDEF Unix} - cthreads, // THIS MUST be the first used unit in FPC if Threads are used!! - // (see http://wiki.lazarus.freepascal.org/Multithreaded_Application_Tutorial) - cwstring, // Enable Unicode support - {$ENDIF} - - //------------------------------ - //Includes - 3rd Party Libraries - //------------------------------ - moduleloader in 'lib\JEDI-SDL\SDL\Pas\moduleloader.pas', - opengl12 in 'lib\JEDI-SDL\OpenGL\Pas\opengl12.pas', - sdl in 'lib\JEDI-SDL\SDL\Pas\sdl.pas', - sdl_image in 'lib\JEDI-SDL\SDL_Image\Pas\sdl_image.pas', - sdl_ttf in 'lib\JEDI-SDL\SDL_ttf\Pas\sdl_ttf.pas', - sdlutils in 'lib\JEDI-SDL\SDL\Pas\sdlutils.pas', - - zlib in 'lib\zlib\zlib.pas', - png in 'lib\libpng\png.pas', - - {$IFDEF UseBass} - bass in 'lib\bass\delphi\bass.pas', - UAudioCore_Bass in 'Classes\UAudioCore_Bass.pas', - {$ENDIF} - {$IFDEF UsePortaudio} - portaudio in 'lib\portaudio\delphi\portaudio.pas', - UAudioCore_Portaudio in 'Classes\UAudioCore_Portaudio.pas', - {$ENDIF} - {$IFDEF UsePortmixer} - portmixer in 'lib\portmixer\delphi\portmixer.pas', - {$ENDIF} - - {$IFDEF MSWINDOWS} - midiout in 'lib\midi\midiout.pas', - CIRCBUF in 'lib\midi\CIRCBUF.PAS', - MidiType in 'lib\midi\MidiType.PAS', - MidiDefs in 'lib\midi\MidiDefs.PAS', - MidiCons in 'lib\midi\MidiCons.PAS', - MidiFile in 'lib\midi\MidiFile.PAS', - Delphmcb in 'lib\midi\Delphmcb.PAS', - {$ENDIF} - - {$IFDEF MSWINDOWS} - DirWatch in 'lib\other\DirWatch.pas', - {$ENDIF} - - {$IFDEF UseFFMpeg} - avcodec in 'lib\ffmpeg\avcodec.pas', - avformat in 'lib\ffmpeg\avformat.pas', - avutil in 'lib\ffmpeg\avutil.pas', - rational in 'lib\ffmpeg\rational.pas', - opt in 'lib\ffmpeg\opt.pas', - avio in 'lib\ffmpeg\avio.pas', - mathematics in 'lib\ffmpeg\mathematics.pas', - {$IFDEF UseSWScale} - swscale in 'lib\ffmpeg\swscale.pas', - {$ENDIF} - {$ENDIF} - - {$IFDEF UseProjectM} - projectM in 'lib\projectM\projectM.pas', - {$ENDIF} - - SQLiteTable3 in 'lib\SQLite\SQLiteTable3.pas', - SQLite3 in 'lib\SQLite\SQLite3.pas', - - - //------------------------------ - //Includes - Menu System - //------------------------------ - UDisplay in 'Menu\UDisplay.pas', - UMenu in 'Menu\UMenu.pas', - UMenuStatic in 'Menu\UMenuStatic.pas', - UMenuText in 'Menu\UMenuText.pas', - UMenuButton in 'Menu\UMenuButton.pas', - UMenuInteract in 'Menu\UMenuInteract.pas', - UMenuSelect in 'Menu\UMenuSelect.pas', - UMenuSelectSlide in 'Menu\UMenuSelectSlide.pas', - UDrawTexture in 'Menu\UDrawTexture.pas', - UMenuButtonCollection in 'Menu\UMenuButtonCollection.pas', - - //------------------------------ - //Includes - Classes - //------------------------------ - UConfig in 'Classes\UConfig.pas', - - UCommon in 'Classes\UCommon.pas', - UGraphic in 'Classes\UGraphic.pas', - UTexture in 'Classes\UTexture.pas', - ULanguage in 'Classes\ULanguage.pas', - UMain in 'Classes\UMain.pas', - UDraw in 'Classes\UDraw.pas', - URecord in 'Classes\URecord.pas', - UTime in 'Classes\UTime.pas', - TextGL in 'Classes\TextGL.pas', - USong in 'Classes\USong.pas', - UXMLSong in 'Classes\UXMLSong.pas', - USongs in 'Classes\USongs.pas', - UIni in 'Classes\UIni.pas', - UImage in 'Classes\UImage.pas', - ULyrics in 'Classes\ULyrics.pas', - ULyrics_bak in 'Classes\ULyrics_bak.pas', - USkins in 'Classes\USkins.pas', - UThemes in 'Classes\UThemes.pas', - ULog in 'Classes\ULog.pas', - UJoystick in 'Classes\UJoystick.pas', - //ULCD in 'Classes\ULCD.pas', - //ULight in 'Classes\ULight.pas', - UDataBase in 'Classes\UDataBase.pas', - UCovers in 'Classes\UCovers.pas', - UCatCovers in 'Classes\UCatCovers.pas', - UFiles in 'Classes\UFiles.pas', - UGraphicClasses in 'Classes\UGraphicClasses.pas', - UDLLManager in 'Classes\UDLLManager.pas', - UPlaylist in 'Classes\UPlaylist.pas', - UCommandLine in 'Classes\UCommandLine.pas', - UTextClasses in 'Classes\UTextClasses.pas', - USingScores in 'Classes\USingScores.pas', - USingNotes in 'Classes\USingNotes.pas', - - UModules in 'Classes\UModules.pas', //List of Modules to Load - UHooks in 'Classes\UHooks.pas', //Hook Managing - UServices in 'Classes\UServices.pas', //Service Managing - UCore in 'Classes\UCore.pas', //Core, Maybe remove this - UCoreModule in 'Classes\UCoreModule.pas', //^ - UPluginInterface in 'Classes\UPluginInterface.pas', //Interface offered by Core to Plugins - uPluginLoader in 'Classes\uPluginLoader.pas', //New Plugin Loader Module - - UParty in 'Classes\UParty.pas', // TODO: rewrite Party Manager as Module, reomplent ability to offer party Mody by Plugin - UPlatform in 'Classes\UPlatform.pas', -{$IFDEF WIN32} - UPlatformWindows in 'Classes\UPlatformWindows.pas', -{$ENDIF} -{$IFDEF LINUX} - UPlatformLinux in 'Classes\UPlatformLinux.pas', -{$ENDIF} - - //------------------------------ - //Includes - Media support classes.... - // Make sure UMedia always first, then UMedia_dummy - //------------------------------ - - // TODO : these all need to be renamed like UMedia_******** for consistency - UMusic in 'Classes\UMusic.pas', - //UAudioPlaybackBase in 'Classes\UAudioPlaybackBase.pas', - UMedia_dummy in 'Classes\UMedia_dummy.pas', // Must be first UMedia Unit, all others will override available interfaces -{$IFDEF UseProjectM} - UVisualizer in 'Classes\UVisualizer.pas', // MUST be before Video... so video can override... -{$ENDIF} -{$IFDEF UseFFMpegVideo} - UVideo in 'Classes\UVideo.pas', -{$ENDIF} -{$IFDEF UseFFMpegDecoder} - UAudioDecoder_FFMpeg in 'Classes\UAudioDecoder_FFMpeg.pas', // MUST be before Playback-classes -{$ENDIF} -{$IFDEF UseBASSInput} - UAudioInput_Bass in 'Classes\UAudioInput_Bass.pas', -{$ENDIF} -{$IFDEF UseBASSPlayback} - UAudioPlayback_Bass in 'Classes\UAudioPlayback_Bass.pas', -{$ENDIF} -{$IFDEF UsePortaudioInput} - UAudioInput_Portaudio in 'Classes\UAudioInput_Portaudio.pas', -{$ENDIF} -{$IF Defined(UsePortaudioPlayback) or Defined(UseSDLPlayback)} - UFFT in 'lib\fft\UFFT.pas', - //samplerate in 'lib\samplerate\samplerate.pas', - UAudioPlayback_Softmixer in 'Classes\UAudioPlayback_SoftMixer.pas', -{$IFEND} -{$IFDEF UsePortaudioPlayback} - UAudioPlayback_Portaudio in 'Classes\UAudioPlayback_Portaudio.pas', -{$ENDIF} -{$IFDEF UseSDLPlayback} - UAudioPlayback_SDL in 'Classes\UAudioPlayback_SDL.pas', -{$ENDIF} - - - //------------------------------ - //Includes - Screens - //------------------------------ - UScreenLoading in 'Screens\UScreenLoading.pas', - UScreenWelcome in 'Screens\UScreenWelcome.pas', - UScreenMain in 'Screens\UScreenMain.pas', - UScreenName in 'Screens\UScreenName.pas', - UScreenLevel in 'Screens\UScreenLevel.pas', - UScreenSong in 'Screens\UScreenSong.pas', - UScreenSing in 'Screens\UScreenSing.pas', - UScreenScore in 'Screens\UScreenScore.pas', - UScreenOptions in 'Screens\UScreenOptions.pas', - UScreenOptionsGame in 'Screens\UScreenOptionsGame.pas', - UScreenOptionsGraphics in 'Screens\UScreenOptionsGraphics.pas', - UScreenOptionsSound in 'Screens\UScreenOptionsSound.pas', - UScreenOptionsLyrics in 'Screens\UScreenOptionsLyrics.pas', - UScreenOptionsThemes in 'Screens\UScreenOptionsThemes.pas', - UScreenOptionsRecord in 'Screens\UScreenOptionsRecord.pas', - UScreenOptionsAdvanced in 'Screens\UScreenOptionsAdvanced.pas', - UScreenEditSub in 'Screens\UScreenEditSub.pas', - UScreenEdit in 'Screens\UScreenEdit.pas', - UScreenEditConvert in 'Screens\UScreenEditConvert.pas', - UScreenEditHeader in 'Screens\UScreenEditHeader.pas', - UScreenOpen in 'Screens\UScreenOpen.pas', - UScreenTop5 in 'Screens\UScreenTop5.pas', - UScreenSongMenu in 'Screens\UScreenSongMenu.pas', - UScreenSongJumpto in 'Screens\UScreenSongJumpto.pas', - UScreenStatMain in 'Screens\UScreenStatMain.pas', - UScreenStatDetail in 'Screens\UScreenStatDetail.pas', - UScreenCredits in 'Screens\UScreenCredits.pas', - UScreenPopup in 'Screens\UScreenPopup.pas', - - //Includes - Screens PartyMode - UScreenSingModi in 'Screens\UScreenSingModi.pas', - UScreenPartyNewRound in 'Screens\UScreenPartyNewRound.pas', - UScreenPartyScore in 'Screens\UScreenPartyScore.pas', - UScreenPartyPlayer in 'Screens\UScreenPartyPlayer.pas', - UScreenPartyOptions in 'Screens\UScreenPartyOptions.pas', - UScreenPartyWin in 'Screens\UScreenPartyWin.pas', - - - //------------------------------ - //Includes - Modi SDK - //------------------------------ - ModiSDK in '..\..\Modis\SDK\ModiSDK.pas', //Old SDK, will be deleted soon - UPluginDefs in '..\..\Modis\SDK\UPluginDefs.pas', //New SDK, not only Modis - UPartyDefs in '..\..\Modis\SDK\UPartyDefs.pas', //Headers to register Party Modes - - SysUtils; - -begin - Main; -end. - +program UltraStar; + +{$IFDEF MSWINDOWS} + {$R 'UltraStar.res' 'UltraStar.rc'} +{$ENDIF} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +// TODO: check if this is needed for MacOSX too +{$IFDEF MSWINDOWS} + // Set global application-type (GUI/CONSOLE) switch for Windows. + // CONSOLE is the default for FPC, GUI for Delphi, so we have + // to specify one of the two in any case. + {$IFDEF CONSOLE} + {$APPTYPE CONSOLE} + {$ELSE} + {$APPTYPE GUI} + {$ENDIF} +{$ENDIF} + +uses + {$IFDEF Unix} + cthreads, // THIS MUST be the first used unit in FPC if Threads are used!! + // (see http://wiki.lazarus.freepascal.org/Multithreaded_Application_Tutorial) + cwstring, // Enable Unicode support + {$ENDIF} + + //------------------------------ + //Includes - 3rd Party Libraries + //------------------------------ + moduleloader in 'lib\JEDI-SDL\SDL\Pas\moduleloader.pas', + opengl12 in 'lib\JEDI-SDL\OpenGL\Pas\opengl12.pas', + sdl in 'lib\JEDI-SDL\SDL\Pas\sdl.pas', + sdl_image in 'lib\JEDI-SDL\SDL_Image\Pas\sdl_image.pas', + sdl_ttf in 'lib\JEDI-SDL\SDL_ttf\Pas\sdl_ttf.pas', + sdlutils in 'lib\JEDI-SDL\SDL\Pas\sdlutils.pas', + + zlib in 'lib\zlib\zlib.pas', + png in 'lib\libpng\png.pas', + + {$IFDEF UseBass} + bass in 'lib\bass\delphi\bass.pas', + UAudioCore_Bass in 'Classes\UAudioCore_Bass.pas', + {$ENDIF} + {$IFDEF UsePortaudio} + portaudio in 'lib\portaudio\delphi\portaudio.pas', + UAudioCore_Portaudio in 'Classes\UAudioCore_Portaudio.pas', + {$ENDIF} + {$IFDEF UsePortmixer} + portmixer in 'lib\portmixer\delphi\portmixer.pas', + {$ENDIF} + + {$IFDEF MSWINDOWS} + midiout in 'lib\midi\midiout.pas', + CIRCBUF in 'lib\midi\CIRCBUF.PAS', + MidiType in 'lib\midi\MidiType.PAS', + MidiDefs in 'lib\midi\MidiDefs.PAS', + MidiCons in 'lib\midi\MidiCons.PAS', + MidiFile in 'lib\midi\MidiFile.PAS', + Delphmcb in 'lib\midi\Delphmcb.PAS', + {$ENDIF} + + {$IFDEF MSWINDOWS} + DirWatch in 'lib\other\DirWatch.pas', + {$ENDIF} + + {$IFDEF UseFFMpeg} + avcodec in 'lib\ffmpeg\avcodec.pas', + avformat in 'lib\ffmpeg\avformat.pas', + avutil in 'lib\ffmpeg\avutil.pas', + rational in 'lib\ffmpeg\rational.pas', + opt in 'lib\ffmpeg\opt.pas', + avio in 'lib\ffmpeg\avio.pas', + mathematics in 'lib\ffmpeg\mathematics.pas', + {$IFDEF UseSWScale} + swscale in 'lib\ffmpeg\swscale.pas', + {$ENDIF} + {$ENDIF} + + {$IFDEF UseProjectM} + projectM in 'lib\projectM\projectM.pas', + {$ENDIF} + + SQLiteTable3 in 'lib\SQLite\SQLiteTable3.pas', + SQLite3 in 'lib\SQLite\SQLite3.pas', + + + //------------------------------ + //Includes - Menu System + //------------------------------ + UDisplay in 'Menu\UDisplay.pas', + UMenu in 'Menu\UMenu.pas', + UMenuStatic in 'Menu\UMenuStatic.pas', + UMenuText in 'Menu\UMenuText.pas', + UMenuButton in 'Menu\UMenuButton.pas', + UMenuInteract in 'Menu\UMenuInteract.pas', + UMenuSelect in 'Menu\UMenuSelect.pas', + UMenuSelectSlide in 'Menu\UMenuSelectSlide.pas', + UDrawTexture in 'Menu\UDrawTexture.pas', + UMenuButtonCollection in 'Menu\UMenuButtonCollection.pas', + + //------------------------------ + //Includes - Classes + //------------------------------ + UConfig in 'Classes\UConfig.pas', + + UCommon in 'Classes\UCommon.pas', + UGraphic in 'Classes\UGraphic.pas', + UTexture in 'Classes\UTexture.pas', + ULanguage in 'Classes\ULanguage.pas', + UMain in 'Classes\UMain.pas', + UDraw in 'Classes\UDraw.pas', + URecord in 'Classes\URecord.pas', + UTime in 'Classes\UTime.pas', + TextGL in 'Classes\TextGL.pas', + USong in 'Classes\USong.pas', + UXMLSong in 'Classes\UXMLSong.pas', + USongs in 'Classes\USongs.pas', + UIni in 'Classes\UIni.pas', + UImage in 'Classes\UImage.pas', + ULyrics in 'Classes\ULyrics.pas', + ULyrics_bak in 'Classes\ULyrics_bak.pas', + USkins in 'Classes\USkins.pas', + UThemes in 'Classes\UThemes.pas', + ULog in 'Classes\ULog.pas', + UJoystick in 'Classes\UJoystick.pas', + //ULCD in 'Classes\ULCD.pas', + //ULight in 'Classes\ULight.pas', + UDataBase in 'Classes\UDataBase.pas', + UCovers in 'Classes\UCovers.pas', + UCatCovers in 'Classes\UCatCovers.pas', + UFiles in 'Classes\UFiles.pas', + UGraphicClasses in 'Classes\UGraphicClasses.pas', + UDLLManager in 'Classes\UDLLManager.pas', + UPlaylist in 'Classes\UPlaylist.pas', + UCommandLine in 'Classes\UCommandLine.pas', + UTextClasses in 'Classes\UTextClasses.pas', + USingScores in 'Classes\USingScores.pas', + USingNotes in 'Classes\USingNotes.pas', + + UModules in 'Classes\UModules.pas', //List of Modules to Load + UHooks in 'Classes\UHooks.pas', //Hook Managing + UServices in 'Classes\UServices.pas', //Service Managing + UCore in 'Classes\UCore.pas', //Core, Maybe remove this + UCoreModule in 'Classes\UCoreModule.pas', //^ + UPluginInterface in 'Classes\UPluginInterface.pas', //Interface offered by Core to Plugins + uPluginLoader in 'Classes\uPluginLoader.pas', //New Plugin Loader Module + + UParty in 'Classes\UParty.pas', // TODO: rewrite Party Manager as Module, reomplent ability to offer party Mody by Plugin + UPlatform in 'Classes\UPlatform.pas', +{$IFDEF WIN32} + UPlatformWindows in 'Classes\UPlatformWindows.pas', +{$ENDIF} +{$IFDEF LINUX} + UPlatformLinux in 'Classes\UPlatformLinux.pas', +{$ENDIF} + + //------------------------------ + //Includes - Media support classes.... + // Make sure UMedia always first, then UMedia_dummy + //------------------------------ + + // TODO : these all need to be renamed like UMedia_******** for consistency + UMusic in 'Classes\UMusic.pas', + //UAudioPlaybackBase in 'Classes\UAudioPlaybackBase.pas', + UMedia_dummy in 'Classes\UMedia_dummy.pas', // Must be first UMedia Unit, all others will override available interfaces +{$IFDEF UseProjectM} + UVisualizer in 'Classes\UVisualizer.pas', // MUST be before Video... so video can override... +{$ENDIF} +{$IFDEF UseFFMpegVideo} + UVideo in 'Classes\UVideo.pas', +{$ENDIF} +{$IFDEF UseFFMpegDecoder} + UAudioDecoder_FFMpeg in 'Classes\UAudioDecoder_FFMpeg.pas', // MUST be before Playback-classes +{$ENDIF} +{$IFDEF UseBASSInput} + UAudioInput_Bass in 'Classes\UAudioInput_Bass.pas', +{$ENDIF} +{$IFDEF UseBASSPlayback} + UAudioPlayback_Bass in 'Classes\UAudioPlayback_Bass.pas', +{$ENDIF} +{$IFDEF UsePortaudioInput} + UAudioInput_Portaudio in 'Classes\UAudioInput_Portaudio.pas', +{$ENDIF} +{$IF Defined(UsePortaudioPlayback) or Defined(UseSDLPlayback)} + UFFT in 'lib\fft\UFFT.pas', + //samplerate in 'lib\samplerate\samplerate.pas', + UAudioPlayback_Softmixer in 'Classes\UAudioPlayback_SoftMixer.pas', +{$IFEND} +{$IFDEF UsePortaudioPlayback} + UAudioPlayback_Portaudio in 'Classes\UAudioPlayback_Portaudio.pas', +{$ENDIF} +{$IFDEF UseSDLPlayback} + UAudioPlayback_SDL in 'Classes\UAudioPlayback_SDL.pas', +{$ENDIF} + + + //------------------------------ + //Includes - Screens + //------------------------------ + UScreenLoading in 'Screens\UScreenLoading.pas', + UScreenWelcome in 'Screens\UScreenWelcome.pas', + UScreenMain in 'Screens\UScreenMain.pas', + UScreenName in 'Screens\UScreenName.pas', + UScreenLevel in 'Screens\UScreenLevel.pas', + UScreenSong in 'Screens\UScreenSong.pas', + UScreenSing in 'Screens\UScreenSing.pas', + UScreenScore in 'Screens\UScreenScore.pas', + UScreenOptions in 'Screens\UScreenOptions.pas', + UScreenOptionsGame in 'Screens\UScreenOptionsGame.pas', + UScreenOptionsGraphics in 'Screens\UScreenOptionsGraphics.pas', + UScreenOptionsSound in 'Screens\UScreenOptionsSound.pas', + UScreenOptionsLyrics in 'Screens\UScreenOptionsLyrics.pas', + UScreenOptionsThemes in 'Screens\UScreenOptionsThemes.pas', + UScreenOptionsRecord in 'Screens\UScreenOptionsRecord.pas', + UScreenOptionsAdvanced in 'Screens\UScreenOptionsAdvanced.pas', + UScreenEditSub in 'Screens\UScreenEditSub.pas', + UScreenEdit in 'Screens\UScreenEdit.pas', + UScreenEditConvert in 'Screens\UScreenEditConvert.pas', + UScreenEditHeader in 'Screens\UScreenEditHeader.pas', + UScreenOpen in 'Screens\UScreenOpen.pas', + UScreenTop5 in 'Screens\UScreenTop5.pas', + UScreenSongMenu in 'Screens\UScreenSongMenu.pas', + UScreenSongJumpto in 'Screens\UScreenSongJumpto.pas', + UScreenStatMain in 'Screens\UScreenStatMain.pas', + UScreenStatDetail in 'Screens\UScreenStatDetail.pas', + UScreenCredits in 'Screens\UScreenCredits.pas', + UScreenPopup in 'Screens\UScreenPopup.pas', + + //Includes - Screens PartyMode + UScreenSingModi in 'Screens\UScreenSingModi.pas', + UScreenPartyNewRound in 'Screens\UScreenPartyNewRound.pas', + UScreenPartyScore in 'Screens\UScreenPartyScore.pas', + UScreenPartyPlayer in 'Screens\UScreenPartyPlayer.pas', + UScreenPartyOptions in 'Screens\UScreenPartyOptions.pas', + UScreenPartyWin in 'Screens\UScreenPartyWin.pas', + + + //------------------------------ + //Includes - Modi SDK + //------------------------------ + ModiSDK in '..\..\Modis\SDK\ModiSDK.pas', //Old SDK, will be deleted soon + UPluginDefs in '..\..\Modis\SDK\UPluginDefs.pas', //New SDK, not only Modis + UPartyDefs in '..\..\Modis\SDK\UPartyDefs.pas', //Headers to register Party Modes + + SysUtils; + +begin + Main; +end. + diff --git a/Game/Code/config-macosx.inc b/Game/Code/config-macosx.inc index 9b5e3635..5f06e446 100644 --- a/Game/Code/config-macosx.inc +++ b/Game/Code/config-macosx.inc @@ -1,11 +1,7 @@ {***************************************************************** * Configuration file for UltraStar Deluxe 1.1 *****************************************************************} - -{* Misc options *} - -{$DEFINE DEBUG} - + {* Libraries *} {$DEFINE HaveFFMpeg} diff --git a/Game/Code/config-win.inc b/Game/Code/config-win.inc index 04528fa2..47676ee1 100644 --- a/Game/Code/config-win.inc +++ b/Game/Code/config-win.inc @@ -2,10 +2,6 @@ * Configuration file for UltraStar Deluxe 1.1 *****************************************************************} -{* Misc options *} - -{$DEFINE DEBUG} - {* Libraries *} {$DEFINE HaveFFMpeg} diff --git a/Game/Code/switches.inc b/Game/Code/switches.inc index c803b3f7..8bff4d0e 100644 --- a/Game/Code/switches.inc +++ b/Game/Code/switches.inc @@ -8,7 +8,6 @@ // compiler/IDE dependent config {$IFDEF FPC} - {$DEFINE CONSOLE} {$IFDEF DARWIN} {$H+} // enables usage of AnsiString as String-type {$R-} // disables range-checks @@ -20,11 +19,8 @@ {$DEFINE DEBUG} {$ENDIF} - {$DEFINE DLL_CDECL} {$DEFINE HasInline} {$ELSE} - {$UNDEF CONSOLE} // Delphi requires a special app type... no thanks ! :) - // {$DEFINE CONSOLE} // -- use for development only ! {$DEFINE Delphi} // Delphi version numbers (ignore versions released before Delphi 6 as they miss the $IF directive): @@ -43,10 +39,12 @@ // include defines but no constants {$I config-win.inc} + // enable debug-mode. For development only! + {$DEFINE DEBUG} {$IFDEF DEBUG} - {$IFDEF CONSOLE} - {$APPTYPE CONSOLE} - {$ENDIF} + // windows apps are either GUI- or console-apps. Console-apps will open + // an additional console-window for output. For development only! + {$DEFINE CONSOLE} {$ENDIF} {$DEFINE HaveBASS} @@ -55,10 +53,20 @@ {$ELSEIF Defined(LINUX)} // include defines but no constants {$I config-linux.inc} + + // use "configure --enable-debug", "make debug" or + // the command-line parameter "-debug" instead of defining DEBUG directly + //{$DEFINE DEBUG} + // linux apps are always console-apps so leave this defined. + {$DEFINE CONSOLE} {$ELSEIF Defined(DARWIN)} // include defines but no constants {$I config-macosx.inc} + // enable debug-mode. For development only! + //{$DEFINE DEBUG} + {$DEFINE CONSOLE} + {$DEFINE HaveBASS} {$DEFINE DLL_CDECL} {$DEFINE WIN32} -- cgit v1.2.3