aboutsummaryrefslogblamecommitdiffstats
path: root/Game/Code/Classes/ULog.pas
blob: 737364e83d27d9e42b7504f8be42da6053cb8c98 (plain) (tree)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16















                                                           


                                         
                               
                               
 



















                                                           
                                                                                        
 

                                                                                                            




                                                      



























                                              
    

                             

               



































































































































































































                                                                                                                   





                                                   

                                               




























































































                                                                                              
                    


















                                                                                  
                      


                                                             





                           
                                                                                         





                                  
 



                             
 







                            
 


                                     
                         









                                            

                         


                     
                    

                  
                









                                   
                    




         
    



                             
                            

                         



                                                              


                                                                                                                


                                           



                                                    



                

                                     
                                                                       
 
                                                
                                    


                                                    




                                                                                    
                        

     




                                                                                                             













                                    

      






                                                               



                           
                                                                                
 
                                 
          






                                                                                                     











                                               

                                                                                             











                                                                                                 

                                                                                                                                    














                                                                                                  

























                                                                   
unit ULog;

interface

uses Classes;

type
  TLog = class
    BenchmarkTimeStart:   array[0..7] of real;
    BenchmarkTimeLength:  array[0..7] of real;//TDateTime;

    FileBenchmark:    TextFile;
    FileBenchmarkO:   boolean; // opened
    FileError:        TextFile;
    FileErrorO:       boolean; // opened

    FileSession:      TextFile;
    FileSessionO:     boolean; // opened

    NumErrors:        integer;
    NumSungSongs:     integer;

    Title: String; //Application Title

    //Should Log Files be written
    Enabled:          Boolean;

    // destuctor
    destructor Free;

    // 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
    function LogVoice(SoundNr: Integer; Player, Artist, Title, Points: string): string;

    procedure LogSession(names: array of string; points: array of string; Artist, Title, singmode: string);

    // compability
    procedure LogStatus(Log1, Log2: string);
    procedure LogError(Log1, Log2: string); overload;
  end;

  TPerfLog = record
    starttime:  integer;
    stoptime:   integer;
    cycle: array of record
      starttime:  integer;
      stoptime:   integer;
      comment: array of record
        timestamp:  integer;
        text:       string;
      end;
    end;
  end;

  TPerformanceLog = class
    private
      active:   boolean;
      PerfLog:  TPerflog;
    public
      procedure StartNewLog;
      procedure StopLogging;

      procedure CycleStart;
      procedure CycleEnd;
      procedure AddComment(comment: string);

      property isActive: boolean read active;
  end;

var
  Log:      TLog;
  PerfLog:  TPerformanceLog;

implementation
uses UFiles, SysUtils, DateUtils, URecord, UTime, UIni, Windows, UCommandLine, SDL;

procedure TPerformanceLog.StartNewLog;
begin
  SetLength(PerfLog.cycle, 0);
  PerfLog.starttime := SDL_GetTicks();
  PerfLog.stoptime := -1;
  active := true;
end;

procedure TPerformanceLog.StopLogging;
var
  i, j:       integer;
  LogFile:    TextFile;
  CsvFile:    TextFile;
  TimeTemp:   integer;
  pos:        integer;

  FileName:   string;
  FileNameCSV:string;
  Num:        integer;
  Year, Month, Day:     word;
  Hour, Min, Sec, MSec: word;
  timestamp:  integer;
  datestr:    string;
  timestr:    string;

  function Fill(w: word): string;
  begin
    Result := '';
    if (w<10) then
      Result := '0';

    Result := Result + IntToStr(w);
  end;

  function duration(t1, t2: integer): integer; //ms
  begin
    result := round(t2-t1);
  end;
begin
  if  not active then
    exit;

  Timetemp := SDL_GetTicks();
  PerfLog.stoptime := TimeTemp;

  pos := Length(PerfLog.cycle);
  if (pos>0) then
  begin
    if (PerfLog.cycle[pos-1].stoptime<0) then
      PerfLog.cycle[pos-1].stoptime := TimeTemp;
  end;

  timestamp := DateTimeToUnix(Now());
  DecodeDate(UnixToDateTime(timestamp), Year, Month, Day);
  DecodeTime(UnixToDateTime(timestamp), Hour, Min, Sec, MSec);

  datestr := IntToStr(Year) + Fill(Month) + Fill(Day);
  timestr := Fill(Hour) + Fill(Min) + Fill(Sec);

  FileName := GamePath + 'PerfLog_' + datestr + '-' + timestr + '.log';

  if FileExists(FileName) then
  begin
    for Num := 1 to 9999 do
    begin
      FileName := IntToStr(Num);
      while Length(FileName) < 4 do FileName := '0' + FileName;
      FileName := GamePath + 'PerfLog_' + datestr + '-' + timestr + '_' + FileName + '.log';
      if not FileExists(FileName) then break
    end;
  end;

  AssignFile(LogFile, FileName);
  {$I-}
  Rewrite(LogFile);
  if IOResult <> 0 then exit;
  {$I+}


  FileNameCSV := GamePath + 'PerfLog_' + datestr + '-' + timestr + '.csv';

  if FileExists(FileNameCSV) then
  begin
    for Num := 1 to 9999 do
    begin
      FileNameCSV := IntToStr(Num);
      while Length(FileNameCSV) < 4 do FileNameCSV := '0' + FileNameCSV;
      FileNameCSV := GamePath + 'PerfLog_' + datestr + '-' + timestr + '_' + FileNameCSV + '.csv';
      if not FileExists(FileNameCSV) then break
    end;
  end;

  AssignFile(CsvFile, FileNameCSV);
  {$I-}
  Rewrite(CsvFile);
  if IOResult <> 0 then exit;
  {$I+}

  //If File is opened write Date to File
  WriteLn(LogFile, 'Performance Log');
  WriteLn(LogFile, 'Date: ' + IntToStr(Year) + '-' + Fill(Month) + '-' + Fill(Day) +
    ' Time: ' + Fill(Hour) + ':' + Fill(Min) + ':' + Fill(Sec));
  WriteLn(LogFile, '');
  WriteLn(LogFile, '# Start    : ' + IntToStr(duration(PerfLog.starttime, PerfLog.starttime)));
  WriteLn(LogFile, '# End      : ' + IntToStr(duration(PerfLog.starttime, PerfLog.stoptime)));
  WriteLn(LogFile, '# Duration : ' + IntToStr(duration(PerfLog.starttime, PerfLog.stoptime)));
  Flush(LogFile);

  for i := 0 to Length(PerfLog.cycle) - 1 do
  begin
    WriteLn(LogFile, '');
    WriteLn(LogFile, '');
    WriteLn(LogFile, '#----------------------------------------------------------------');
    WriteLn(LogFile, '# Cycle-Nr.:  ' + IntToStr(i+1));
    WriteLn(LogFile, '# Start    : ' + IntToStr(duration(PerfLog.starttime, PerfLog.cycle[i].starttime)));
    WriteLn(LogFile, '# End      : ' + IntToStr(duration(PerfLog.starttime, PerfLog.cycle[i].stoptime)));
    WriteLn(LogFile, '# Duration : ' + IntToStr(duration(PerfLog.cycle[i].starttime, PerfLog.cycle[i].stoptime)));
    WriteLn(LogFile, '#----------------------------------------------------------------');

    WriteLn(CsvFile, IntToStr(duration(PerfLog.starttime, PerfLog.cycle[i].starttime))+';'+
      IntToStr(duration(PerfLog.cycle[i].starttime, PerfLog.cycle[i].stoptime)));
    for j := 0 to Length(PerfLog.cycle[i].comment) - 1 do
    begin
      WriteLn(LogFile, '# Comment ' + IntToStr(j) + ': ' + PerfLog.cycle[i].comment[j].text);
      WriteLn(LogFile, '# time: ' + IntToStr(duration(PerfLog.starttime, PerfLog.cycle[i].comment[j].timestamp)));
      WriteLn(LogFile, '#');
    end;
    WriteLn(LogFile, '#-----------------------------------------------------------------');

  end;
  Flush(LogFile);
  Flush(CsvFile);

  active := false;
end;

procedure TPerformanceLog.CycleStart;
var
  pos:      integer;
  TimeTemp: integer;
begin
  if  not active then
    exit;

  TimeTemp := SDL_GetTicks();

  pos := Length(PerfLog.cycle);
  if (pos>0) then
  begin
    if (PerfLog.cycle[pos-1].stoptime<0) then
      PerfLog.cycle[pos-1].stoptime := TimeTemp;
  end;
  
  SetLength(PerfLog.cycle, pos+1);
  PerfLog.cycle[pos].starttime := TimeTemp;
  PerfLog.cycle[pos].stoptime := -1;

  SetLength(PerfLog.cycle[pos].comment, 0);
end;

procedure TPerformanceLog.CycleEnd;
var
  pos:  integer;
begin
  if  not active then
    exit;

  pos := Length(PerfLog.cycle)-1;

  if (pos>=0) then
    PerfLog.cycle[pos].stoptime := SDL_GetTicks();
end;

procedure TPerformanceLog.AddComment(comment: string);
var
  pos:  integer;
  posc: integer;
begin
  if not active then
    exit;

  pos := Length(PerfLog.cycle)-1;
  if (pos<0) then
    exit;
    
  posc := Length(PerfLog.cycle[pos].comment);
  SetLength(PerfLog.cycle[pos].comment, posc+1);

  PerfLog.cycle[pos].comment[posc].text := comment;
  PerfLog.cycle[pos].comment[posc].timestamp := SDL_GetTicks();
end;




destructor TLog.Free;
begin
  if FileBenchmarkO then CloseFile(FileBenchmark);
//  if FileAnalyzeO then CloseFile(FileAnalyze);
  if FileErrorO then CloseFile(FileError);
  if FileSessionO then CloseFile(FileSession);

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;
    NumErrors := 0;
    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
      Inc(NumErrors);
      WriteLn(FileError, IntToStr(NumErrors) + ') ' + Text);
      WriteLn(FileError, '');
      Flush(FileError);
    except
      FileErrorO := false;
    end;
  end;
end;

function TLog.LogVoice(SoundNr: Integer; Player, Artist, Title, Points: string): string;
type
  TRiffHeader = record
    riff: Array[0..3] OF Char;
    filesize: LongInt;
    typeStr: Array[0..3] OF Char;
  end;

  TChunkRec = record
    id: Array[0..3] OF Char;
    size: LongInt;
  end;

  TWaveFormatRec = record
    tag: Word;
    channels: Word;
    samplesPerSec: LongInt;
    bytesPerSec: LongInt;
    blockAlign: Word;
    bitsPerSample: Word;
  end;

  TWAVHeader = record { WAV Format }
    riffHdr: TRiffHeader;
    fmtChunk: TChunkRec;
    fmt: TWaveFormatRec;
    dataChunk: TChunkRec;
    { data follows here }
  end;

procedure HeadInit(var Header: TWAVHeader);
begin
  with Header do
  begin
    with riffHdr do
    begin
      riff := 'RIFF';
      typeStr := 'WAVE';
    end;
    with fmtChunk do
    begin
      id := 'fmt ';
      size := 16;
    end;
    with fmt do
    begin
        //its 16 bit, 44.1kHz Mono
      tag := 1; channels := 1;
      samplesPerSec := 44100;
      bytesPerSec := 44100*2;
      blockAlign := 2;
      bitsPerSample := 16;
    end;
    with dataChunk do
    begin
      id := 'data';
    end;
  end;
end;


var
  FS:           TFileStream;
  FileName:     string;
  Num:          integer;
  BL:           integer;
  Header:       TWAVHeader;
  s:            LongInt;

begin
  for Num := 1 to 9999 do begin
    FileName := IntToStr(Num);
    while Length(FileName) < 4 do FileName := '0' + FileName;
    //FileName := RecordingsPath + Artist + '_' +
    //  Title + '_P' + Points + '_' + FileName + '_' + Player + '.wav'; //some characters are not allowed; TODO
    FileName := RecordingsPath + 'V_' + FileName + '.wav';
    if not FileExists(FileName) then break
  end;

  HeadInit(Header);
  s := 0;
  for BL := 0 to High(Sound[SoundNr].BufferLong) do
    s := s + Sound[SoundNr].BufferLong[BL].Size;

  if (s=0) then
    exit;

  Header.Datachunk.size := s;
  //FileSize = DataSize + HeaderSize
  Header.riffHdr.FileSize := Header.Datachunk.size + sizeof(Header)-8;

  FS := TFileStream.Create(FileName, fmCreate);
  FS.Write(Header, sizeof(header));

  for BL := 0 to High(Sound[SoundNr].BufferLong) do
  begin
    Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning);
    FS.CopyFrom(Sound[SoundNr].BufferLong[BL], Sound[SoundNr].BufferLong[BL].Size);
  end;

  FS.Free;
  LogVoice := FileName;
end;

procedure TLog.LogSession(names: array of string; points: array of string; Artist, Title, singmode: string);
var
  Num:      integer;
  FileName: string;
  I:        integer;
  Year, Month, Day:     word;
  Hour, Min, Sec, MSec: word;
  timestamp:  integer;
  datestr:    string;
  timestr:    string;

  function Fill(w: word): string;
  begin
    Result := '';
    if (w<10) then
      Result := '0';

    Result := Result + IntToStr(w);
  end;

begin
  timestamp := DateTimeToUnix(Now());
  DecodeDate(UnixToDateTime(timestamp), Year, Month, Day);
  DecodeTime(UnixToDateTime(timestamp), Hour, Min, Sec, MSec);

  datestr := IntToStr(Year) + Fill(Month) + Fill(Day);
  timestr := Fill(Hour) + Fill(Min) + Fill(Sec);

  if not FileSessionO then
  begin
    FileSessionO := false;
    NumSungSongs := 0;
    FileName := SessionLogPath + 'Session_' + datestr + '-' + timestr + '.log';

    if FileExists(FileName) then
    begin
      for Num := 1 to 9999 do
      begin
        FileName := IntToStr(Num);
        while Length(FileName) < 4 do FileName := '0' + FileName;
        FileName := SessionLogPath + 'Session_' + datestr + '-' + timestr + '_' + FileName + '.log';
        if not FileExists(FileName) then break
      end;
    end;

    AssignFile(FileSession, FileName);
    {$I-}
    Rewrite(FileSession);
    if IOResult = 0 then FileSessionO := true;
    {$I+}

    //If File is opened write Date to File
    If (FileSessionO) then
    begin
      WriteLn(FileSession, 'Session Log');
      WriteLn(FileSession, 'Date: ' + IntToStr(Year) + '-' + Fill(Month) + '-' + Fill(Day) +
         ' Time: ' + Fill(Hour) + ':' + Fill(Min) + ':' + Fill(Sec));

      Flush(FileSession);
    end;
  end;

  if FileSessionO then
  begin
    try
      Inc(NumSungSongs);
      WriteLn(FileSession, '');
      WriteLn(FileSession, '');
      WriteLn(FileSession, '#----------------------------------------------------------------');
      WriteLn(FileSession, '# ' + IntToStr(NumSungSongs) + ') ' + 'Date: ' + IntToStr(Year) + '-' + Fill(Month) + '-' + Fill(Day) +
        ' Time: ' + Fill(Hour) + ':' + Fill(Min) + ':' + Fill(Sec));
      WriteLn(FileSession, '# Sing mode: ' + singmode);
      WriteLn(FileSession, '#----------------------------------------------------------------');
      WriteLn(FileSession, '# Song: ' + Artist + ' - ' + Title + ':');
      for I := 0 to Length(names) - 1 do
      begin
        WriteLn(FileSession, '# ' + names[I] + ' - ' + points[I]);
      end;
      WriteLn(FileSession, '#-----------------------------------------------------------------');
      Flush(FileSession);
    except
      FileSessionO := false;
    end;
  end;
end;

procedure TLog.LogStatus(Log1, Log2: string);
begin
  //Just for Debugging
  //Comment for Release
    //LogAnalyze (Log2 + ': ' + Log1);
end;

procedure TLog.LogError(Log1, Log2: string);
begin
//asd
end;

procedure TLog.CriticalError(Text: string);
begin
  //Write Error to Logfile:
  LogError (Text);

  //Show Errormessage
  Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK);

  //Exit Application
  Halt;
end;

end.