From 5f11f9f3e328f6818a42f0a3405404612399c64e Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 30 Aug 2008 18:12:06 +0000 Subject: Removed outdated 1.1 branch contents git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/1.1@1331 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/ULog.pas | 364 --------------------------------------------- 1 file changed, 364 deletions(-) delete mode 100644 Game/Code/Classes/ULog.pas (limited to 'Game/Code/Classes/ULog.pas') diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas deleted file mode 100644 index 542fa0b3..00000000 --- a/Game/Code/Classes/ULog.pas +++ /dev/null @@ -1,364 +0,0 @@ -unit ULog; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes; - -type - TLog = class - 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; - - constructor Create; - - // destuctor - destructor Destroy; override; - - // benchmark - procedure BenchmarkStart(Number: integer); - procedure BenchmarkEnd(Number: integer); - procedure LogBenchmark(Text: string; Number: integer); - - // error - procedure LogError(Text: string); overload; - - //Critical Error (Halt + MessageBox) - procedure CriticalError(Text: string); - - // 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); - end; - -procedure SafeWriteLn(const msg: string); inline; - -var - Log: TLog; - -implementation - -uses - {$IFDEF win32} - windows, - {$ENDIF} - SysUtils, - DateUtils, -//UFiles, - UMain, - URecord, - UTime, -//UIni, // JB - Seems to not be needed. - {$IFDEF FPC} - sdl, - {$ENDIF} - 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; -begin - while true do - 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); - 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} - WriteLn(msg); -{$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} -end; - -destructor TLog.Destroy; -begin - if FileBenchmarkO then CloseFile(FileBenchmark); -// if FileAnalyzeO then CloseFile(FileAnalyze); - if FileErrorO then CloseFile(FileError); -end; - -procedure TLog.BenchmarkStart(Number: integer); -begin - BenchmarkTimeStart[Number] := USTime.GetTime; //Time; -end; - -procedure TLog.BenchmarkEnd(Number: integer); -begin - BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number]; -end; - -procedure TLog.LogBenchmark(Text: string; Number: integer); -var - Minutes: integer; - Seconds: integer; - Miliseconds: integer; - - MinutesS: string; - SecondsS: string; - MilisecondsS: string; - - ValueText: string; -begin - if Enabled AND (Params.Benchmark) then begin - if not FileBenchmarkO then begin - FileBenchmarkO := true; - AssignFile(FileBenchmark, LogPath + 'Benchmark.log'); - {$I-} - Rewrite(FileBenchmark); - if IOResult = 0 then FileBenchmarkO := true; - {$I+} - - //If File is opened write Date to Benchmark File - If (FileBenchmarkO) then - begin - WriteLn(FileBenchmark, Title + ' Benchmark File'); - WriteLn(FileBenchmark, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); - WriteLn(FileBenchmark, '-------------------'); - - Flush(FileBenchmark); - end; - end; - - if FileBenchmarkO then begin - Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000); - Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60; - Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60); -// ValueText := FloatToStr(BenchmarkTimeLength[Number]); - -{ ValueText := FloatToStr( - SecondOf(BenchmarkTimeLength[Number]) + MilliSecondOf(BenchmarkTimeLength[Number])/1000 - ); - if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then - ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText; - WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');} - - if (Minutes = 0) and (Seconds = 0) then begin - MilisecondsS := IntToStr(Miliseconds); - ValueText := MilisecondsS + ' miliseconds'; - end; - - if (Minutes = 0) and (Seconds >= 1) then begin - MilisecondsS := IntToStr(Miliseconds); - while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; - - SecondsS := IntToStr(Seconds); - - ValueText := SecondsS + ',' + MilisecondsS + ' seconds'; - end; - - if Minutes >= 1 then begin - MilisecondsS := IntToStr(Miliseconds); - while Length(MilisecondsS) < 3 do MilisecondsS := '0' + MilisecondsS; - - SecondsS := IntToStr(Seconds); - while Length(SecondsS) < 2 do SecondsS := '0' + SecondsS; - - MinutesS := IntToStr(Minutes); - - ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes'; - end; - - WriteLn(FileBenchmark, Text + ': ' + ValueText); - Flush(FileBenchmark); - end; - end; -end; - -procedure TLog.LogError(Text: string); -begin - if Enabled AND (not FileErrorO) then begin - //FileErrorO := true; - AssignFile(FileError, LogPath + 'Error.log'); - {$I-} - Rewrite(FileError); - if IOResult = 0 then FileErrorO := true; - {$I+} - - //If File is opened write Date to Error File - If (FileErrorO) then - begin - WriteLn(FileError, Title + ' Error Log'); - WriteLn(FileError, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); - WriteLn(FileError, '-------------------'); - - Flush(FileError); - end; - end; - - if FileErrorO then begin - try - WriteLn(FileError, Text); - Flush(FileError); - except - FileErrorO := false; - end; - end; - {$IFDEF DEBUG} - SafeWriteLn('Error: ' + Text); - {$ENDIF} -end; - -procedure TLog.LogVoice(SoundNr: integer); -var - FileVoice: File; - FS: TFileStream; - FileName: string; - Num: integer; - BL: 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); - - for BL := 0 to High(AudioInputProcessor.Sound[SoundNr].BufferLong) do begin - AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning); - FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong[BL], AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Size); - end; - - FS.Free; -end; - -procedure TLog.LogStatus(Log1, Log2: string); -begin - //Just for Debugging - //Comment for Release - //LogError(Log2 + ': ' + Log1); - - //If Debug => Write to Console Output - {$IFDEF DEBUG} - // SafeWriteLn(Log2 + ': ' + Log1); - {$ENDIF} -end; - -procedure TLog.LogError(Log1, Log2: string); -begin - LogError(Log1 + ' ['+Log2+']'); -end; - -procedure TLog.CriticalError(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} - - //Exit Application - Halt; -end; - -procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; filename: string); -var - f : TFileStream; -begin - f := nil; - - try - f := TFileStream.Create( filename, fmCreate); - f.Write( buf^, bufLength); - f.Free; - except - on e : Exception do begin - Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message); - f.Free; - end; - end; -end; - -end. - - -- cgit v1.2.3