From 99955c78f63d1cb0d8bec666bc33953590a74c8a Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 1 Nov 2007 23:22:01 +0000 Subject: fixed failed builds build:USDX-LAZLIN-75 build:USDX-LAZLIN-76 for some reason we can not use {$MODE Delphi} in an included file. ( Probably because of the way the compier scopes this switch to each pas file ) ive had to revert this part of eddies changes. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@548 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 4 + Game/Code/Classes/UAudio_FFMpeg.pas | 77 +- Game/Code/Classes/UAudio_bass.pas | 4 + Game/Code/Classes/UCommon.pas | 4 + Game/Code/Classes/UCore.pas | 21 +- Game/Code/Classes/UCoreModule.pas | 248 +++-- Game/Code/Classes/UCovers.pas | 526 ++++----- Game/Code/Classes/UDLLManager.pas | 4 + Game/Code/Classes/UDataBase.pas | 4 + Game/Code/Classes/UDraw.pas | 4 + Game/Code/Classes/UFiles.pas | 6 + Game/Code/Classes/UGraphic.pas | 4 + Game/Code/Classes/UGraphicClasses.pas | 4 + Game/Code/Classes/UHooks.pas | 855 +++++++------- Game/Code/Classes/UIni.pas | 4 + Game/Code/Classes/ULanguage.pas | 4 + Game/Code/Classes/ULight.pas | 4 + Game/Code/Classes/ULog.pas | 4 + Game/Code/Classes/ULyrics.pas | 4 + Game/Code/Classes/ULyrics_bak.pas | 852 +++++++------- Game/Code/Classes/UMain.pas | 8 +- Game/Code/Classes/UMedia_dummy.pas | 4 + Game/Code/Classes/UMusic.pas | 4 + Game/Code/Classes/UParty.pas | 757 ++++++------- Game/Code/Classes/UPlaylist.pas | 930 ++++++++-------- Game/Code/Classes/URecord.pas | 4 + Game/Code/Classes/UServices.pas | 647 +++++------ Game/Code/Classes/USingScores.pas | 1976 +++++++++++++++++---------------- Game/Code/Classes/USkins.pas | 4 + Game/Code/Classes/USongs.pas | 9 +- Game/Code/Classes/UTexture.pas | 4 + Game/Code/Classes/UThemes.pas | 4 + Game/Code/Classes/UTime.pas | 3 + Game/Code/Classes/UVideo.pas | 7 +- Game/Code/Classes/uPluginLoader.pas | 4 + 35 files changed, 3579 insertions(+), 3423 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index af60c4ff..aaee50a0 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -2,6 +2,10 @@ unit TextGL; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas index 675dfd3c..afbb23c1 100644 --- a/Game/Code/Classes/UAudio_FFMpeg.pas +++ b/Game/Code/Classes/UAudio_FFMpeg.pas @@ -13,6 +13,10 @@ This unit is primarily based upon - interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} @@ -59,7 +63,7 @@ var // audio_buf : array[ 0 .. AVCODEC_MAX_AUDIO_FRAME_SIZE ] of byte; //pUInt8{$ifndef fpc};{$else} = nil;{$endif} type - Taudiobuff = array[ 0 .. AVCODEC_MAX_AUDIO_FRAME_SIZE ] of byte; + Taudiobuff = array[ 0 .. AVCODEC_MAX_AUDIO_FRAME_SIZE-1 ] of byte; PAudioBuff = ^Taudiobuff; implementation @@ -376,6 +380,9 @@ end; procedure TAudio_ffMpeg.PlayStart; begin + + // LoadSoundFromFile(BassStart, SoundPath + 'foo fighters - best of you.mp3'); + // TODO : jb_linux replace with something other than bass // BASS_ChannelPlay(BassStart, True); end; @@ -458,10 +465,13 @@ var len1 , data_size : integer; begin + result := -1; + +(* {$ifdef win32} - FillChar(pkt, sizeof(pkt), #0); + FillChar(pkt, sizeof(TAVPacket), #0); {$else} - memset(@pkt, 0, sizeof(pkt)); // todo : jb memset + memset(@pkt, 0, sizeof(TAVPacket)); // todo : jb memset {$endif} audio_pkt_data := nil; @@ -469,7 +479,7 @@ begin while true do begin - + while ( audio_pkt_size > 0 ) do begin // writeln( 'got audio packet' ); @@ -479,22 +489,15 @@ begin if aAudio_buf <> nil then begin -// writeln( 'pre avcodec_decode_audio' ); - {$ifdef fpc} - len1 := avcodec_decode_audio(@aCodecCtx, PWord( aAudio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. - {$else} - len1 := avcodec_decode_audio(@aCodecCtx, Pointer( aAudio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. - {$endif} -// writeln( 'post avcodec_decode_audio' ); - + len1 := avcodec_decode_audio(@aCodecCtx, Pointer( aAudio_buf ), data_size, audio_pkt_data, audio_pkt_size); // Todo.. should be avcodec_decode_audio2 but this wont link on my ubuntu box. end; -// writeln('avcodec_decode_audio'); +// writeln('avcodec_decode_audio : ' + inttostr( len1 )); if(len1 < 0) then begin //* if error, skip frame */ -// writeln( 'Skip audio frame' ); + writeln( 'Skip audio frame' ); audio_pkt_size := 0; break; end; @@ -532,7 +535,7 @@ begin audio_pkt_data := pchar( pkt.data ); audio_pkt_size := pkt.size; // writeln( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); - end; + end; *) end; procedure audio_callback( userdata: Pointer; stream: PUInt8; len: Integer ); @@ -558,41 +561,45 @@ begin while (len > 0) do begin - if(audio_buf_index >= audio_buf_size) then + + if (audio_buf_index >= audio_buf_size) then begin + // We have already sent all our data; get more */ - audio_size := audio_decode_frame(aCodecCtx, pUInt8( laudio_buf ), sizeof(laudio_buf)); + audio_size := audio_decode_frame(aCodecCtx, pUInt8( laudio_buf ), sizeof(Taudiobuff)); + writeln( 'audio_decode_frame : ' + inttostr( audio_size ) + ' / ' + inttostr( sizeof(Taudiobuff) ) ); - if(audio_size < 0) then + if(audio_size > 0) then begin - // If error, output silence */ - audio_buf_size := 1024; // arbitrary? - - {$ifdef win32} - FillChar(laudio_buf, audio_buf_size, #0); - {$else} - memset(laudio_buf, 0, audio_buf_size); // todo : jb memset - {$endif} + audio_buf_size := audio_size; end else begin - audio_buf_size := audio_size; + // If error, output silence */ + +// audio_buf_size := 1024; // arbitrary? + +// {$ifdef win32} +// FillChar(laudio_buf, audio_buf_size, #0); +// {$else} +// memset(laudio_buf, 0, audio_buf_size); // todo : jb memset +// {$endif} + + writeln( 'Silence' ); end; audio_buf_index := 0; // Todo : jb - SegFault ? end; - - len1 := audio_buf_size - audio_buf_index; + len1 := audio_buf_size - audio_buf_index; if (len1 > len) then len1 := len; - + lSrc := PUInt8( integer( laudio_buf ) + audio_buf_index ); {$ifdef WIN32} - lSrc := PUInt8( integer( laudio_buf ) + audio_buf_index ); CopyMemory(stream, lSrc , len1); {$else} - memcpy(stream, PUInt8( laudio_buf ) + audio_buf_index , len1); + memcpy(stream, lSrc , len1); {$endif} len := len - len1; @@ -620,7 +627,7 @@ begin if FileExists(Name) then begin -// writeln('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); + writeln('Loading Sound: "' + Name + '"', 'LoadSoundFromFile'); // Open video file if (av_open_input_file(pFormatCtx, pchar(Name), nil, 0, nil) > 0) then @@ -697,6 +704,7 @@ begin // Free the packet that was allocated by av_read_frame SDL_PollEvent(@event); + (* if event.type_ = SDL_QUIT the begin @@ -706,8 +714,9 @@ begin else break; *) - end; + + writeln( 'Done filling buffer' ); // halt(0); diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas index 463a6c7f..9ef3b789 100644 --- a/Game/Code/Classes/UAudio_bass.pas +++ b/Game/Code/Classes/UAudio_bass.pas @@ -2,6 +2,10 @@ unit UAudio_bass; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index b532f775..43017aff 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -2,6 +2,10 @@ unit UCommon; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index 091868f2..acd9ead7 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -2,9 +2,17 @@ unit UCore; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} -uses uPluginDefs, uCoreModule, UHooks, UServices, UModules; +uses uPluginDefs, + uCoreModule, + UHooks, + UServices, + UModules; {********************* TCore Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process @@ -103,10 +111,11 @@ var Core: TCore; implementation -uses SysUtils, -{$IFDEF win32} -Windows -{$ENDIF}; + +uses {$IFDEF win32} + Windows, + {$ENDIF} + SysUtils; //------------- // Create - Creates Class + Hook and Service Manager @@ -489,4 +498,4 @@ begin Result := hInstance; end; -end. \ No newline at end of file +end. diff --git a/Game/Code/Classes/UCoreModule.pas b/Game/Code/Classes/UCoreModule.pas index b135089c..c8c54161 100644 --- a/Game/Code/Classes/UCoreModule.pas +++ b/Game/Code/Classes/UCoreModule.pas @@ -1,122 +1,126 @@ -unit UCoreModule; - -interface - -{$I switches.inc} - -{********************* - TCoreModule - Dummy Class that has Methods that will be called from Core - In the Best case every Piece of this Software is a Module -*********************} -uses UPluginDefs; - -type - PCoreModule = ^TCoreModule; - TCoreModule = class - public - Constructor Create; virtual; - - //Function that gives some Infos about the Module to the Core - Procedure Info(const pInfo: PModuleInfo); virtual; - - //Is Called on Loading. - //In this Method only Events and Services should be created - //to offer them to other Modules or Plugins during the Init process - //If False is Returned this will cause a Forced Exit - Function Load: Boolean; virtual; - - //Is Called on Init Process - //In this Method you can Hook some Events and Create + Init - //your Classes, Variables etc. - //If False is Returned this will cause a Forced Exit - Function Init: Boolean; virtual; - - //Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing - //If False is Returned this will cause a Forced Exit - Function MainLoop: Boolean; virtual; - - //Is Called if this Module has been Inited and there is a Exit. - //Deinit is in backwards Initing Order - //If False is Returned this will cause a Forced Exit - Procedure DeInit; virtual; - - //Is Called if this Module will be unloaded and has been created - //Should be used to Free Memory - Procedure Free; virtual; - end; - cCoreModule = class of TCoreModule; - -implementation - -//------------- -// Just the Constructor -//------------- -Constructor TCoreModule.Create; -begin - //Dummy maaaan ;) -end; - -//------------- -// Function that gives some Infos about the Module to the Core -//------------- -Procedure TCoreModule.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'Not Set'; - pInfo^.Version := 0; - pInfo^.Description := 'Not Set'; -end; - -//------------- -//Is Called on Loading. -//In this Method only Events and Services should be created -//to offer them to other Modules or Plugins during the Init process -//If False is Returned this will cause a Forced Exit -//------------- -Function TCoreModule.Load: Boolean; -begin - //Dummy ftw!! - Result := True; -end; - -//------------- -//Is Called on Init Process -//In this Method you can Hook some Events and Create + Init -//your Classes, Variables etc. -//If False is Returned this will cause a Forced Exit -//------------- -Function TCoreModule.Init: Boolean; -begin - //Dummy ftw!! - Result := True; -end; - -//------------- -//Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing -//If False is Returned this will cause a Forced Exit -//------------- -Function TCoreModule.MainLoop: Boolean; -begin - //Dummy ftw!! - Result := True; -end; - -//------------- -//Is Called if this Module has been Inited and there is a Exit. -//Deinit is in backwards Initing Order -//------------- -Procedure TCoreModule.DeInit; -begin - //Dummy ftw!! -end; - -//------------- -//Is Called if this Module will be unloaded and has been created -//Should be used to Free Memory -//------------- -Procedure TCoreModule.Free; -begin - //Dummy ftw!! -end; - -end. \ No newline at end of file +unit UCoreModule; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{********************* + TCoreModule + Dummy Class that has Methods that will be called from Core + In the Best case every Piece of this Software is a Module +*********************} +uses UPluginDefs; + +type + PCoreModule = ^TCoreModule; + TCoreModule = class + public + Constructor Create; virtual; + + //Function that gives some Infos about the Module to the Core + Procedure Info(const pInfo: PModuleInfo); virtual; + + //Is Called on Loading. + //In this Method only Events and Services should be created + //to offer them to other Modules or Plugins during the Init process + //If False is Returned this will cause a Forced Exit + Function Load: Boolean; virtual; + + //Is Called on Init Process + //In this Method you can Hook some Events and Create + Init + //your Classes, Variables etc. + //If False is Returned this will cause a Forced Exit + Function Init: Boolean; virtual; + + //Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing + //If False is Returned this will cause a Forced Exit + Function MainLoop: Boolean; virtual; + + //Is Called if this Module has been Inited and there is a Exit. + //Deinit is in backwards Initing Order + //If False is Returned this will cause a Forced Exit + Procedure DeInit; virtual; + + //Is Called if this Module will be unloaded and has been created + //Should be used to Free Memory + Procedure Free; virtual; + end; + cCoreModule = class of TCoreModule; + +implementation + +//------------- +// Just the Constructor +//------------- +Constructor TCoreModule.Create; +begin + //Dummy maaaan ;) +end; + +//------------- +// Function that gives some Infos about the Module to the Core +//------------- +Procedure TCoreModule.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'Not Set'; + pInfo^.Version := 0; + pInfo^.Description := 'Not Set'; +end; + +//------------- +//Is Called on Loading. +//In this Method only Events and Services should be created +//to offer them to other Modules or Plugins during the Init process +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.Load: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called on Init Process +//In this Method you can Hook some Events and Create + Init +//your Classes, Variables etc. +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.Init: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.MainLoop: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +Procedure TCoreModule.DeInit; +begin + //Dummy ftw!! +end; + +//------------- +//Is Called if this Module will be unloaded and has been created +//Should be used to Free Memory +//------------- +Procedure TCoreModule.Free; +begin + //Dummy ftw!! +end; + +end. diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas index f4ede329..9cc2a5e9 100644 --- a/Game/Code/Classes/UCovers.pas +++ b/Game/Code/Classes/UCovers.pas @@ -1,261 +1,265 @@ -unit UCovers; - -interface - -{$I switches.inc} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - {$IFNDEF FPC} - Graphics, - {$ENDIF} - UThemes, - UTexture; - -type - TCover = record - Name: string; - W: word; - H: word; - Size: integer; - Position: integer; // position of picture in the cache file -// Data: array of byte; - end; - - TCovers = class - Cover: array of TCover; - W: word; - H: word; - Size: integer; - Data: array of byte; - WritetoFile: Boolean; - - constructor Create; - procedure Load; - procedure Save; - procedure AddCover(Name: string); - function CoverExists(Name: string): boolean; - function CoverNumber(Name: string): integer; - procedure PrepareData(Name: string); - end; - -var - Covers: TCovers; - -implementation - -uses UMain, - // UFiles, - ULog, - DateUtils; - -constructor TCovers.Create; -begin - W := 128; - H := 128; - Size := W*H*3; - Load; - WritetoFile := True; -end; - -procedure TCovers.Load; -var - F: File; - C: integer; // cover number - W: word; - H: word; - Bits: byte; - NLen: word; - Name: string; -// Data: array of byte; -begin - if FileExists(GamePath + 'covers.cache') then - begin - AssignFile(F, GamePath + 'covers.cache'); - Reset(F, 1); - - WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); - - SetLength(Cover, 0); - - while not EOF(F) do - begin - SetLength(Cover, Length(Cover)+1); - - BlockRead(F, W, 2); - Cover[High(Cover)].W := W; - - BlockRead(F, H, 2); - Cover[High(Cover)].H := H; - - BlockRead(F, Bits, 1); - - Cover[High(Cover)].Size := W * H * (Bits div 8); - - // test - // W := 128; - // H := 128; - // Bits := 24; - // Seek(F, FilePos(F) + 3); - - BlockRead(F, NLen, 2); - SetLength(Name, NLen); - - BlockRead(F, Name[1], NLen); - Cover[High(Cover)].Name := Name; - - Cover[High(Cover)].Position := FilePos(F); - Seek(F, FilePos(F) + W*H*(Bits div 8)); - - // SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); - // BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); - - end; // While - - CloseFile(F); - end; // fileexists -end; - -procedure TCovers.Save; -var - F: File; - C: integer; // cover number - W: word; - H: word; - NLen: word; - Bits: byte; -begin -{ AssignFile(F, GamePath + 'covers.cache'); - Rewrite(F, 1); - - Bits := 24; - for C := 0 to High(Cover) do begin - W := Cover[C].W; - H := Cover[C].H; - - BlockWrite(F, W, 2); - BlockWrite(F, H, 2); - BlockWrite(F, Bits, 1); - - NLen := Length(Cover[C].Name); - BlockWrite(F, NLen, 2); - BlockWrite(F, Cover[C].Name[1], NLen); - BlockWrite(F, Cover[C].Data[0], W*H*(Bits div 8)); - end; - - CloseFile(F);} -end; - -procedure TCovers.AddCover(Name: string); -var - B: integer; - F: File; - C: integer; // cover number - NLen: word; - Bits: byte; -begin - if not CoverExists(Name) then - begin - SetLength(Cover, Length(Cover)+1); - Cover[High(Cover)].Name := Name; - - Cover[High(Cover)].W := W; - Cover[High(Cover)].H := H; - Cover[High(Cover)].Size := Size; - - // do not copy data. write them directly to file -// SetLength(Cover[High(Cover)].Data, Size); -// for B := 0 to Size-1 do -// Cover[High(Cover)].Data[B] := CacheMipmap[B]; - - if WritetoFile then - begin - AssignFile(F, GamePath + 'covers.cache'); - - if FileExists(GamePath + 'covers.cache') then - begin - Reset(F, 1); - Seek(F, FileSize(F)); - end - else - begin - Rewrite(F, 1); - end; - - Bits := 24; - - BlockWrite(F, W, 2); - BlockWrite(F, H, 2); - BlockWrite(F, Bits, 1); - - NLen := Length(Name); - BlockWrite(F, NLen, 2); - BlockWrite(F, Name[1], NLen); - - Cover[High(Cover)].Position := FilePos(F); - BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8)); - - CloseFile(F); - end; - end - else - Cover[High(Cover)].Position := 0; -end; - -function TCovers.CoverExists(Name: string): boolean; -var - C: integer; // cover -begin - Result := false; - C := 0; - - while (C <= High(Cover)) and (Result = false) do - begin - if Cover[C].Name = Name then - Result := true; - - Inc(C); - end; -end; - -function TCovers.CoverNumber(Name: string): integer; -var - C: integer; -begin - Result := -1; - C := 0; - - while (C <= High(Cover)) and (Result = -1) do - begin - if Cover[C].Name = Name then - Result := C; - - Inc(C); - end; -end; - -procedure TCovers.PrepareData(Name: string); -var - F: File; - C: integer; -begin - if FileExists(GamePath + 'covers.cache') then - begin - AssignFile(F, GamePath + 'covers.cache'); - Reset(F, 1); - - C := CoverNumber(Name); - SetLength(Data, Cover[C].Size); - if Length(Data) < 6 then beep; - Seek(F, Cover[C].Position); - BlockRead(F, Data[0], Cover[C].Size); - CloseFile(F); - end; -end; - -end. +unit UCovers; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + UThemes, + UTexture; + +type + TCover = record + Name: string; + W: word; + H: word; + Size: integer; + Position: integer; // position of picture in the cache file +// Data: array of byte; + end; + + TCovers = class + Cover: array of TCover; + W: word; + H: word; + Size: integer; + Data: array of byte; + WritetoFile: Boolean; + + constructor Create; + procedure Load; + procedure Save; + procedure AddCover(Name: string); + function CoverExists(Name: string): boolean; + function CoverNumber(Name: string): integer; + procedure PrepareData(Name: string); + end; + +var + Covers: TCovers; + +implementation + +uses UMain, + // UFiles, + ULog, + DateUtils; + +constructor TCovers.Create; +begin + W := 128; + H := 128; + Size := W*H*3; + Load; + WritetoFile := True; +end; + +procedure TCovers.Load; +var + F: File; + C: integer; // cover number + W: word; + H: word; + Bits: byte; + NLen: word; + Name: string; +// Data: array of byte; +begin + if FileExists(GamePath + 'covers.cache') then + begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); + + SetLength(Cover, 0); + + while not EOF(F) do + begin + SetLength(Cover, Length(Cover)+1); + + BlockRead(F, W, 2); + Cover[High(Cover)].W := W; + + BlockRead(F, H, 2); + Cover[High(Cover)].H := H; + + BlockRead(F, Bits, 1); + + Cover[High(Cover)].Size := W * H * (Bits div 8); + + // test + // W := 128; + // H := 128; + // Bits := 24; + // Seek(F, FilePos(F) + 3); + + BlockRead(F, NLen, 2); + SetLength(Name, NLen); + + BlockRead(F, Name[1], NLen); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].Position := FilePos(F); + Seek(F, FilePos(F) + W*H*(Bits div 8)); + + // SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); + // BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); + + end; // While + + CloseFile(F); + end; // fileexists +end; + +procedure TCovers.Save; +var + F: File; + C: integer; // cover number + W: word; + H: word; + NLen: word; + Bits: byte; +begin +{ AssignFile(F, GamePath + 'covers.cache'); + Rewrite(F, 1); + + Bits := 24; + for C := 0 to High(Cover) do begin + W := Cover[C].W; + H := Cover[C].H; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Cover[C].Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Cover[C].Name[1], NLen); + BlockWrite(F, Cover[C].Data[0], W*H*(Bits div 8)); + end; + + CloseFile(F);} +end; + +procedure TCovers.AddCover(Name: string); +var + B: integer; + F: File; + C: integer; // cover number + NLen: word; + Bits: byte; +begin + if not CoverExists(Name) then + begin + SetLength(Cover, Length(Cover)+1); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].W := W; + Cover[High(Cover)].H := H; + Cover[High(Cover)].Size := Size; + + // do not copy data. write them directly to file +// SetLength(Cover[High(Cover)].Data, Size); +// for B := 0 to Size-1 do +// Cover[High(Cover)].Data[B] := CacheMipmap[B]; + + if WritetoFile then + begin + AssignFile(F, GamePath + 'covers.cache'); + + if FileExists(GamePath + 'covers.cache') then + begin + Reset(F, 1); + Seek(F, FileSize(F)); + end + else + begin + Rewrite(F, 1); + end; + + Bits := 24; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Name[1], NLen); + + Cover[High(Cover)].Position := FilePos(F); + BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8)); + + CloseFile(F); + end; + end + else + Cover[High(Cover)].Position := 0; +end; + +function TCovers.CoverExists(Name: string): boolean; +var + C: integer; // cover +begin + Result := false; + C := 0; + + while (C <= High(Cover)) and (Result = false) do + begin + if Cover[C].Name = Name then + Result := true; + + Inc(C); + end; +end; + +function TCovers.CoverNumber(Name: string): integer; +var + C: integer; +begin + Result := -1; + C := 0; + + while (C <= High(Cover)) and (Result = -1) do + begin + if Cover[C].Name = Name then + Result := C; + + Inc(C); + end; +end; + +procedure TCovers.PrepareData(Name: string); +var + F: File; + C: integer; +begin + if FileExists(GamePath + 'covers.cache') then + begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + C := CoverNumber(Name); + SetLength(Data, Cover[C].Size); + if Length(Data) < 6 then beep; + Seek(F, Cover[C].Position); + BlockRead(F, Data[0], Cover[C].Size); + CloseFile(F); + end; +end; + +end. diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas index 358be9af..cbe79c3c 100644 --- a/Game/Code/Classes/UDLLManager.pas +++ b/Game/Code/Classes/UDLLManager.pas @@ -2,6 +2,10 @@ unit UDLLManager; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses ModiSDK, diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas index 0cafc9fd..e99cb891 100644 --- a/Game/Code/Classes/UDataBase.pas +++ b/Game/Code/Classes/UDataBase.pas @@ -2,6 +2,10 @@ unit UDataBase; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses USongs, diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index 350926d8..efc3494b 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -2,6 +2,10 @@ unit UDraw; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses UThemes, diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas index 5f168ead..e4f83b7a 100644 --- a/Game/Code/Classes/UFiles.pas +++ b/Game/Code/Classes/UFiles.pas @@ -2,6 +2,9 @@ unit UFiles; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} {$I switches.inc} uses SysUtils, @@ -329,8 +332,11 @@ Result := False; //Reset LineNo FileLineNo := 0; + writeln( 'Assign File : ' + Song.Path + Song.FileName ); + //Open File and set File Pointer to the beginning AssignFile(SongFile, Song.Path + Song.FileName); + // if assinged( SongFile ) then begin try diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 26601f2d..bfad2d73 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -2,6 +2,10 @@ unit UGraphic; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index 2acd5530..4dfc66ce 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -3,6 +3,10 @@ unit UGraphicClasses; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses UTexture; diff --git a/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas index ea31ec50..c30803f7 100644 --- a/Game/Code/Classes/UHooks.pas +++ b/Game/Code/Classes/UHooks.pas @@ -1,425 +1,430 @@ -unit UHooks; - -{********************* - THookManager - Class for saving, managing and calling of Hooks. - Saves all hookable events and their subscribers -*********************} -interface - -{$I switches.inc} - -uses uPluginDefs, SysUtils; - -type - //Record that saves info from Subscriber - PSubscriberInfo = ^TSubscriberInfo; - TSubscriberInfo = record - Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook) - Next: PSubscriberInfo; //Pointer to next Item in HookChain - - Owner: Integer; //For Error Handling and Plugin Unloading. - - //Here is s/t tricky - //To avoid writing of Wrapping Functions to Hook an Event with a Class - //We save a Normal Proc or a Method of a Class - Case isClass: boolean of - False: (Proc: TUS_Hook); //Proc that will be called on Event - True: (ProcOfClass: TUS_Hook_of_Object); - end; - - TEventInfo = record - Name: String[60]; //Name of Event - FirstSubscriber: PSubscriberInfo; //First subscriber in chain - LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding - end; - - THookManager = class - private - Events: array of TEventInfo; - SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items) - - Procedure FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); - public - constructor Create(const SpacetoAllocate: Word); - - Function AddEvent (const EventName: PChar): THandle; - Function DelEvent (hEvent: THandle): Integer; - - Function AddSubscriber (const EventName: PChar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; - Function DelSubscriber (const hSubscriber: THandle): Integer; - - Function CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; - Function EventExists (const EventName: PChar): Integer; - - Procedure DelbyOwner(const Owner: Integer); - end; - -function HookTest(wParam, lParam: DWord): integer; stdcall; - -var - HookManager: THookManager; - -implementation -uses UCore; - -//------------ -// Create - Creates Class and Set Standard Values -//------------ -constructor THookManager.Create(const SpacetoAllocate: Word); -var I: Integer; -begin - //Get the Space and "Zero" it - SetLength (Events, SpacetoAllocate); - For I := 0 to SpacetoAllocate do - Events[I].Name[1] := chr(0); - - SpaceinEvents := SpacetoAllocate; - - {$IFDEF DEBUG} - WriteLn('HookManager: Succesful Created.'); - {$ENDIF} -end; - -//------------ -// AddEvent - Adds an Event and return the Events Handle or 0 on Failure -//------------ -Function THookManager.AddEvent (const EventName: PChar): THandle; -var I: Integer; -begin - Result := 0; - - if (EventExists(EventName) = 0) then - begin - If (SpaceinEvents > 0) then - begin - //There is already Space available - //Go Search it! - For I := 0 to High(Events) do - If (Events[I].Name[1] = chr(0)) then - begin //Found Space - Result := I; - Dec(SpaceinEvents); - Break; - end; - - {$IFDEF DEBUG} - WriteLn('HookManager: Found Space for Event at Handle: ''' + InttoStr(Result+1) + ''); - {$ENDIF} - end - else - begin //There is no Space => Go make some! - Result := Length(Events); - SetLength(Events, Result + 1); - end; - - //Set Events Data - Events[Result].Name := EventName; - Events[Result].FirstSubscriber := nil; - Events[Result].LastSubscriber := nil; - - //Handle is Index + 1 - Inc(Result); - - {$IFDEF DEBUG} - WriteLn('HookManager: Add Event succesful: ''' + EventName + ''); - {$ENDIF} - end - {$IFDEF DEBUG} - else - WriteLn('HookManager: Trying to ReAdd Event: ''' + EventName + ''); - {$ENDIF} -end; - -//------------ -// DelEvent - Deletes an Event by Handle Returns False on Failure -//------------ -Function THookManager.DelEvent (hEvent: THandle): Integer; -var - Cur, Last: PSubscriberInfo; -begin - hEvent := hEvent - 1; //Arrayindex is Handle - 1 - Result := -1; - - - If (Length(Events) > hEvent) AND (Events[hEvent].Name[1] <> chr(0)) then - begin //Event exists - //Free the Space for all Subscribers - Cur := Events[hEvent].FirstSubscriber; - - While (Cur <> nil) do - begin - Last := Cur; - Cur := Cur.Next; - FreeMem(Last, SizeOf(TSubscriberInfo)); - end; - - {$IFDEF DEBUG} - WriteLn('HookManager: Removed Event succesful: ''' + Events[hEvent].Name + ''); - {$ENDIF} - - //Free the Event - Events[hEvent].Name[1] := chr(0); - Inc(SpaceinEvents); //There is one more space for new events - end - - {$IFDEF DEBUG} - else - WriteLn('HookManager: Try to Remove not Existing Event. Handle: ''' + InttoStr(hEvent) + ''); - {$ENDIF} -end; - -//------------ -// AddSubscriber - Adds an Subscriber to the Event by Name -// Returns Handle of the Subscribtion or 0 on Failure -//------------ -Function THookManager.AddSubscriber (const EventName: PChar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; -var - EventHandle: THandle; - EventIndex: Cardinal; - Cur: PSubscriberInfo; -begin - Result := 0; - - If (@Proc <> nil) or (@ProcOfClass <> nil) then - begin - EventHandle := EventExists(EventName); - - If (EventHandle <> 0) then - begin - EventIndex := EventHandle - 1; - - //Get Memory - GetMem(Cur, SizeOf(TSubscriberInfo)); - - //Fill it with Data - Cur.Next := nil; - - //Add Owner - Cur.Owner := Core.CurExecuted; - - If (@Proc = nil) then - begin //Use the ProcofClass Method - Cur.isClass := True; - Cur.ProcOfClass := ProcofClass; - end - else //Use the normal Proc - begin - Cur.isClass := False; - Cur.Proc := Proc; - end; - - //Create Handle (1st Word: Handle of Event; 2nd Word: unique ID - If (Events[EventIndex].LastSubscriber = nil) then - begin - If (Events[EventIndex].FirstSubscriber = nil) then - begin - Result := (EventHandle SHL 16); - Events[EventIndex].FirstSubscriber := Cur; - end - Else - begin - Result := Events[EventIndex].FirstSubscriber.Self + 1; - end; - end - Else - begin - Result := Events[EventIndex].LastSubscriber.Self + 1; - Events[EventIndex].LastSubscriber.Next := Cur; - end; - - Cur.Self := Result; - - //Add to Chain - Events[EventIndex].LastSubscriber := Cur; - - {$IFDEF DEBUG} - WriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner)); - {$ENDIF} - end; - end; -end; - -//------------ -// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory. -//------------ -Procedure THookManager.FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); -begin - //Delete from Chain - If (Last <> nil) then - begin - Last.Next := Cur.Next; - end - else //Was first Popup - begin - Events[EventIndex].FirstSubscriber := Cur.Next; - end; - - //Was this Last subscription ? - If (Cur = Events[EventIndex].LastSubscriber) then - begin //Change Last Subscriber - Events[EventIndex].LastSubscriber := Last; - end; - - //Free Space: - FreeMem(Cur, SizeOf(TSubscriberInfo)); -end; - -//------------ -// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure -//------------ -Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer; -var - EventIndex: Cardinal; - Cur, Last: PSubscriberInfo; -begin - Result := -1; - EventIndex := ((hSubscriber AND (High(THandle) xor High(Word))) SHR 16) - 1; - - //Existing Event ? - If (EventIndex < Length(Events)) AND (Events[EventIndex].Name[1] <> chr(0)) then - begin - Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription - - //Search for Subscription - Cur := Events[EventIndex].FirstSubscriber; - Last := nil; - - //go through the chain ... - While (Cur <> nil) do - begin - If (Cur.Self = hSubscriber) then - begin //Found Subscription we searched for - FreeSubscriber(EventIndex, Last, Cur); - - {$IFDEF DEBUG} - WriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + ''); - {$ENDIF} - - //Set Result and Break the Loop - Result := 0; - Break; - end; - - Last := Cur; - Cur := Cur.Next; - end; - - end; -end; - - -//------------ -// CallEventChain - Calls the Chain of a specified EventHandle -// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End -//------------ -Function THookManager.CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; -var - EventIndex: Cardinal; - Cur: PSubscriberInfo; - CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute -begin - Result := -1; - EventIndex := hEvent - 1; - - If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then - begin //Existing Event - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start calling the Chain !!!11 - Cur := Events[EventIndex].FirstSubscriber; - Result := 0; - //Call Hooks until the Chain is at the End or breaked - While ((Cur <> nil) AND (Result = 0)) do - begin - //Set CurExecuted - Core.CurExecuted := Cur.Owner; - if (Cur.isClass) then - Result := Cur.ProcOfClass(wParam, lParam) - else - Result := Cur.Proc(wParam, lParam); - - Cur := Cur.Next; - end; - - //Restore CurExecuted - Core.CurExecuted := CurExecutedBackup; - end; - - {$IFDEF DEBUG} - WriteLn('HookManager: Called Chain from Event ''' + Events[EventIndex].Name + ''' succesful. Result: ''' + InttoStr(Result) + ''); - {$ENDIF} -end; - -//------------ -// EventExists - Returns non Zero if an Event with the given Name exists -//------------ -Function THookManager.EventExists (const EventName: PChar): Integer; -var - I: Integer; - Name: String[60]; -begin - Result := 0; - //If (Length(EventName) < - Name := String(EventName); - - //Sure not to search for empty space - If (Name[1] <> chr(0)) then - begin - //Search for Event - For I := 0 to High(Events) do - If (Events[I].Name = Name) then - begin //Event found - Result := I + 1; - Break; - end; - end; -end; - -//------------ -// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading) -//------------ -Procedure THookManager.DelbyOwner(const Owner: Integer); -var - I: Integer; - Cur, Last: PSubscriberInfo; -begin - //Search for Owner in all Hooks Chains - For I := 0 to High(Events) do - begin - If (Events[I].Name[1] <> chr(0)) then - begin - - Last := nil; - Cur := Events[I].FirstSubscriber; - //Went Through Chain - While (Cur <> nil) do - begin - If (Cur.Owner = Owner) then - begin //Found Subscription by Owner -> Delete - FreeSubscriber(I, Last, Cur); - If (Last <> nil) then - Cur := Last.Next - else - Cur := Events[I].FirstSubscriber; - end - Else - begin - //Next Item: - Last := Cur; - Cur := Cur.Next; - end; - end; - end; - end; -end; - - -function HookTest(wParam, lParam: DWord): integer; stdcall; -begin - Result := 0; //Don't break the chain - Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam)))))); -end; - -end. +unit UHooks; + +{********************* + THookManager + Class for saving, managing and calling of Hooks. + Saves all hookable events and their subscribers +*********************} +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses uPluginDefs, + SysUtils; + +type + //Record that saves info from Subscriber + PSubscriberInfo = ^TSubscriberInfo; + TSubscriberInfo = record + Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook) + Next: PSubscriberInfo; //Pointer to next Item in HookChain + + Owner: Integer; //For Error Handling and Plugin Unloading. + + //Here is s/t tricky + //To avoid writing of Wrapping Functions to Hook an Event with a Class + //We save a Normal Proc or a Method of a Class + Case isClass: boolean of + False: (Proc: TUS_Hook); //Proc that will be called on Event + True: (ProcOfClass: TUS_Hook_of_Object); + end; + + TEventInfo = record + Name: String[60]; //Name of Event + FirstSubscriber: PSubscriberInfo; //First subscriber in chain + LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding + end; + + THookManager = class + private + Events: array of TEventInfo; + SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items) + + Procedure FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); + public + constructor Create(const SpacetoAllocate: Word); + + Function AddEvent (const EventName: PChar): THandle; + Function DelEvent (hEvent: THandle): Integer; + + Function AddSubscriber (const EventName: PChar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; + Function DelSubscriber (const hSubscriber: THandle): Integer; + + Function CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; + Function EventExists (const EventName: PChar): Integer; + + Procedure DelbyOwner(const Owner: Integer); + end; + +function HookTest(wParam, lParam: DWord): integer; stdcall; + +var + HookManager: THookManager; + +implementation +uses UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +constructor THookManager.Create(const SpacetoAllocate: Word); +var I: Integer; +begin + //Get the Space and "Zero" it + SetLength (Events, SpacetoAllocate); + For I := 0 to SpacetoAllocate do + Events[I].Name[1] := chr(0); + + SpaceinEvents := SpacetoAllocate; + + {$IFDEF DEBUG} + WriteLn('HookManager: Succesful Created.'); + {$ENDIF} +end; + +//------------ +// AddEvent - Adds an Event and return the Events Handle or 0 on Failure +//------------ +Function THookManager.AddEvent (const EventName: PChar): THandle; +var I: Integer; +begin + Result := 0; + + if (EventExists(EventName) = 0) then + begin + If (SpaceinEvents > 0) then + begin + //There is already Space available + //Go Search it! + For I := 0 to High(Events) do + If (Events[I].Name[1] = chr(0)) then + begin //Found Space + Result := I; + Dec(SpaceinEvents); + Break; + end; + + {$IFDEF DEBUG} + WriteLn('HookManager: Found Space for Event at Handle: ''' + InttoStr(Result+1) + ''); + {$ENDIF} + end + else + begin //There is no Space => Go make some! + Result := Length(Events); + SetLength(Events, Result + 1); + end; + + //Set Events Data + Events[Result].Name := EventName; + Events[Result].FirstSubscriber := nil; + Events[Result].LastSubscriber := nil; + + //Handle is Index + 1 + Inc(Result); + + {$IFDEF DEBUG} + WriteLn('HookManager: Add Event succesful: ''' + EventName + ''); + {$ENDIF} + end + {$IFDEF DEBUG} + else + WriteLn('HookManager: Trying to ReAdd Event: ''' + EventName + ''); + {$ENDIF} +end; + +//------------ +// DelEvent - Deletes an Event by Handle Returns False on Failure +//------------ +Function THookManager.DelEvent (hEvent: THandle): Integer; +var + Cur, Last: PSubscriberInfo; +begin + hEvent := hEvent - 1; //Arrayindex is Handle - 1 + Result := -1; + + + If (Length(Events) > hEvent) AND (Events[hEvent].Name[1] <> chr(0)) then + begin //Event exists + //Free the Space for all Subscribers + Cur := Events[hEvent].FirstSubscriber; + + While (Cur <> nil) do + begin + Last := Cur; + Cur := Cur.Next; + FreeMem(Last, SizeOf(TSubscriberInfo)); + end; + + {$IFDEF DEBUG} + WriteLn('HookManager: Removed Event succesful: ''' + Events[hEvent].Name + ''); + {$ENDIF} + + //Free the Event + Events[hEvent].Name[1] := chr(0); + Inc(SpaceinEvents); //There is one more space for new events + end + + {$IFDEF DEBUG} + else + WriteLn('HookManager: Try to Remove not Existing Event. Handle: ''' + InttoStr(hEvent) + ''); + {$ENDIF} +end; + +//------------ +// AddSubscriber - Adds an Subscriber to the Event by Name +// Returns Handle of the Subscribtion or 0 on Failure +//------------ +Function THookManager.AddSubscriber (const EventName: PChar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; +var + EventHandle: THandle; + EventIndex: Cardinal; + Cur: PSubscriberInfo; +begin + Result := 0; + + If (@Proc <> nil) or (@ProcOfClass <> nil) then + begin + EventHandle := EventExists(EventName); + + If (EventHandle <> 0) then + begin + EventIndex := EventHandle - 1; + + //Get Memory + GetMem(Cur, SizeOf(TSubscriberInfo)); + + //Fill it with Data + Cur.Next := nil; + + //Add Owner + Cur.Owner := Core.CurExecuted; + + If (@Proc = nil) then + begin //Use the ProcofClass Method + Cur.isClass := True; + Cur.ProcOfClass := ProcofClass; + end + else //Use the normal Proc + begin + Cur.isClass := False; + Cur.Proc := Proc; + end; + + //Create Handle (1st Word: Handle of Event; 2nd Word: unique ID + If (Events[EventIndex].LastSubscriber = nil) then + begin + If (Events[EventIndex].FirstSubscriber = nil) then + begin + Result := (EventHandle SHL 16); + Events[EventIndex].FirstSubscriber := Cur; + end + Else + begin + Result := Events[EventIndex].FirstSubscriber.Self + 1; + end; + end + Else + begin + Result := Events[EventIndex].LastSubscriber.Self + 1; + Events[EventIndex].LastSubscriber.Next := Cur; + end; + + Cur.Self := Result; + + //Add to Chain + Events[EventIndex].LastSubscriber := Cur; + + {$IFDEF DEBUG} + WriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner)); + {$ENDIF} + end; + end; +end; + +//------------ +// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory. +//------------ +Procedure THookManager.FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); +begin + //Delete from Chain + If (Last <> nil) then + begin + Last.Next := Cur.Next; + end + else //Was first Popup + begin + Events[EventIndex].FirstSubscriber := Cur.Next; + end; + + //Was this Last subscription ? + If (Cur = Events[EventIndex].LastSubscriber) then + begin //Change Last Subscriber + Events[EventIndex].LastSubscriber := Last; + end; + + //Free Space: + FreeMem(Cur, SizeOf(TSubscriberInfo)); +end; + +//------------ +// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure +//------------ +Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer; +var + EventIndex: Cardinal; + Cur, Last: PSubscriberInfo; +begin + Result := -1; + EventIndex := ((hSubscriber AND (High(THandle) xor High(Word))) SHR 16) - 1; + + //Existing Event ? + If (EventIndex < Length(Events)) AND (Events[EventIndex].Name[1] <> chr(0)) then + begin + Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription + + //Search for Subscription + Cur := Events[EventIndex].FirstSubscriber; + Last := nil; + + //go through the chain ... + While (Cur <> nil) do + begin + If (Cur.Self = hSubscriber) then + begin //Found Subscription we searched for + FreeSubscriber(EventIndex, Last, Cur); + + {$IFDEF DEBUG} + WriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + ''); + {$ENDIF} + + //Set Result and Break the Loop + Result := 0; + Break; + end; + + Last := Cur; + Cur := Cur.Next; + end; + + end; +end; + + +//------------ +// CallEventChain - Calls the Chain of a specified EventHandle +// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End +//------------ +Function THookManager.CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; +var + EventIndex: Cardinal; + Cur: PSubscriberInfo; + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute +begin + Result := -1; + EventIndex := hEvent - 1; + + If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then + begin //Existing Event + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start calling the Chain !!!11 + Cur := Events[EventIndex].FirstSubscriber; + Result := 0; + //Call Hooks until the Chain is at the End or breaked + While ((Cur <> nil) AND (Result = 0)) do + begin + //Set CurExecuted + Core.CurExecuted := Cur.Owner; + if (Cur.isClass) then + Result := Cur.ProcOfClass(wParam, lParam) + else + Result := Cur.Proc(wParam, lParam); + + Cur := Cur.Next; + end; + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; + + {$IFDEF DEBUG} + WriteLn('HookManager: Called Chain from Event ''' + Events[EventIndex].Name + ''' succesful. Result: ''' + InttoStr(Result) + ''); + {$ENDIF} +end; + +//------------ +// EventExists - Returns non Zero if an Event with the given Name exists +//------------ +Function THookManager.EventExists (const EventName: PChar): Integer; +var + I: Integer; + Name: String[60]; +begin + Result := 0; + //If (Length(EventName) < + Name := String(EventName); + + //Sure not to search for empty space + If (Name[1] <> chr(0)) then + begin + //Search for Event + For I := 0 to High(Events) do + If (Events[I].Name = Name) then + begin //Event found + Result := I + 1; + Break; + end; + end; +end; + +//------------ +// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading) +//------------ +Procedure THookManager.DelbyOwner(const Owner: Integer); +var + I: Integer; + Cur, Last: PSubscriberInfo; +begin + //Search for Owner in all Hooks Chains + For I := 0 to High(Events) do + begin + If (Events[I].Name[1] <> chr(0)) then + begin + + Last := nil; + Cur := Events[I].FirstSubscriber; + //Went Through Chain + While (Cur <> nil) do + begin + If (Cur.Owner = Owner) then + begin //Found Subscription by Owner -> Delete + FreeSubscriber(I, Last, Cur); + If (Last <> nil) then + Cur := Last.Next + else + Cur := Events[I].FirstSubscriber; + end + Else + begin + //Next Item: + Last := Cur; + Cur := Cur.Next; + end; + end; + end; + end; +end; + + +function HookTest(wParam, lParam: DWord): integer; stdcall; +begin + Result := 0; //Don't break the chain + Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam)))))); +end; + +end. diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas index 36ba2180..998a1d4b 100644 --- a/Game/Code/Classes/UIni.pas +++ b/Game/Code/Classes/UIni.pas @@ -2,6 +2,10 @@ unit UIni; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses IniFiles, ULog, SysUtils; diff --git a/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas index 25986263..dc07c298 100644 --- a/Game/Code/Classes/ULanguage.pas +++ b/Game/Code/Classes/ULanguage.pas @@ -2,6 +2,10 @@ unit ULanguage; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} diff --git a/Game/Code/Classes/ULight.pas b/Game/Code/Classes/ULight.pas index 6621cf59..b0ff9d6b 100644 --- a/Game/Code/Classes/ULight.pas +++ b/Game/Code/Classes/ULight.pas @@ -2,6 +2,10 @@ unit ULight; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} type diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 2ce70a11..7f0b82c4 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -2,6 +2,10 @@ unit ULog; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses Classes; diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 96b9d43b..8eaa2a5f 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -2,6 +2,10 @@ unit ULyrics; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses OpenGL12, diff --git a/Game/Code/Classes/ULyrics_bak.pas b/Game/Code/Classes/ULyrics_bak.pas index b5a9d798..703ee270 100644 --- a/Game/Code/Classes/ULyrics_bak.pas +++ b/Game/Code/Classes/ULyrics_bak.pas @@ -1,424 +1,428 @@ -unit ULyrics_bak; - -interface - -{$I switches.inc} - -uses SysUtils, - OpenGL12, - UMusic, - UTexture; - -type - TWord = record - X: real; - Y: real; - Size: real; - Width: real; - Text: string; - ColR: real; - ColG: real; - ColB: real; - Scale: real; - Done: real; - FontStyle: integer; - Italic: boolean; - Selected: boolean; - end; - - TLyric = class - private - AlignI: integer; - XR: real; - YR: real; - SizeR: real; - SelectedI: integer; - ScaleR: real; - StyleI: integer; // 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left - FontStyleI: integer; // font number - Word: array of TWord; - - //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled - PlayerIconTex: array[0..5] of array [0..1] of TTexture; - - procedure SetX(Value: real); - procedure SetY(Value: real); - function GetClientX: real; - procedure SetAlign(Value: integer); - function GetSize: real; - procedure SetSize(Value: real); - procedure SetSelected(Value: integer); - procedure SetDone(Value: real); - procedure SetScale(Value: real); - procedure SetStyle(Value: integer); - procedure SetFStyle(Value: integer); - procedure Refresh; - - procedure DrawNormal(W: integer); - procedure DrawPlain(W: integer); - procedure DrawScaled(W: integer); - procedure DrawSlide(W: integer); - - procedure DrawPlayerIcons; - public - //Array containing Players Singing the Next Sentence - // 1: Player 1 Active - // 2: Player 2 Active - // 3: Player 3 Active - PlayersActive: Byte; - - //Dark or Light Colors - Enabled: Boolean; - - ColR: real; - ColG: real; - ColB: real; - ColSR: real; - ColSG: real; - ColSB: real; - Italic: boolean; - Text: string; // LCD - - constructor Create; - - procedure AddWord(Text: string); - procedure AddCzesc(NrCzesci: integer); - - function SelectedLetter: integer; // LCD - function SelectedLength: integer; // LCD - - procedure Clear; - procedure Draw; - published - property X: real write SetX; - property Y: real write SetY; - property ClientX: real read GetClientX; - property Align: integer write SetAlign; - property Size: real read GetSize write SetSize; - property Selected: integer read SelectedI write SetSelected; - property Done: real write SetDone; - property Scale: real write SetScale; - property Style: integer write SetStyle; - property FontStyle: integer write SetFStyle; - end; - -var - Lyric: TLyric; - -implementation -uses TextGL, UGraphic, UDrawTexture, Math, USkins; - -Constructor TLyric.Create; -var - I: Integer; -begin - //Only 2 Players for now - For I := 0 to 1 do - begin - PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); - PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); - end; - PlayersActive := Trunc(Power(2, 1)) + 1; -end; - -procedure TLyric.SetX(Value: real); -begin - XR := Value; -end; - -procedure TLyric.SetY(Value: real); -begin - YR := Value; -end; - -function TLyric.GetClientX: real; -begin - Result := Word[0].X; -end; - -procedure TLyric.SetAlign(Value: integer); -begin - AlignI := Value; -// if AlignInt = 0 then beep; -end; - -function TLyric.GetSize: real; -begin - Result := SizeR; -end; - -procedure TLyric.SetSize(Value: real); -begin - SizeR := Value; -end; - -procedure TLyric.SetSelected(Value: integer); -var - W: integer; -begin - if (StyleI = 0) or (StyleI = 2) or (StyleI = 4) then begin - if (SelectedI > -1) and (SelectedI <= High(Word)) then begin - Word[SelectedI].Selected := false; - Word[SelectedI].ColR := ColR; - Word[SelectedI].ColG := ColG; - Word[SelectedI].ColB := ColB; - Word[SelectedI].Done := 0; - end; - - SelectedI := Value; - if (Value > -1) and (Value <= High(Word)) then begin - Word[Value].Selected := true; - Word[Value].ColR := ColSR; - Word[Value].ColG := ColSG; - Word[Value].ColB := ColSB; - Word[Value].Scale := ScaleR; - end; - end; - - if (StyleI = 1) or (StyleI = 3) then begin - if (SelectedI > -1) and (SelectedI <= High(Word)) then begin - for W := SelectedI to High(Word) do begin - Word[W].Selected := false; - Word[W].ColR := ColR; - Word[W].ColG := ColG; - Word[W].ColB := ColB; - Word[W].Done := 0; - end; - end; - - SelectedI := Value; - if (Value > -1) and (Value <= High(Word)) then begin - for W := 0 to Value do begin - Word[W].Selected := true; - Word[W].ColR := ColSR; - Word[W].ColG := ColSG; - Word[W].ColB := ColSB; - Word[W].Scale := ScaleR; - Word[W].Done := 1; - end; - end; - end; - - Refresh; -end; - -procedure TLyric.SetDone(Value: real); -var - W: integer; -begin - W := SelectedI; - if W > -1 then - Word[W].Done := Value; -end; - -procedure TLyric.SetScale(Value: real); -begin - ScaleR := Value; -end; - -procedure TLyric.SetStyle(Value: integer); -begin - StyleI := Value; -end; - -procedure TLyric.SetFStyle(Value: integer); -begin - FontStyleI := Value; -end; - -procedure TLyric.AddWord(Text: string); -var - WordNum: integer; -begin - WordNum := Length(Word); - SetLength(Word, WordNum + 1); - if WordNum = 0 then begin - Word[WordNum].X := XR; - end else begin - Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; - end; - - Word[WordNum].Y := YR; - Word[WordNum].Size := SizeR; - Word[WordNum].FontStyle := FontStyleI; // new - SetFontStyle(FontStyleI); - SetFontSize(SizeR); - Word[WordNum].Width := glTextWidth(pchar(Text)); - Word[WordNum].Text := Text; - Word[WordNum].ColR := ColR; - Word[WordNum].ColG := ColG; - Word[WordNum].ColB := ColB; - Word[WordNum].Scale := 1; - Word[WordNum].Done := 0; - Word[WordNum].Italic := Italic; - - Refresh; -end; - -procedure TLyric.AddCzesc(NrCzesci: integer); -var - N: integer; -begin - Clear; - for N := 0 to Czesci[0].Czesc[NrCzesci].HighNut do begin - Italic := Czesci[0].Czesc[NrCzesci].Nuta[N].FreeStyle; - AddWord(Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst); - Text := Text + Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst; - end; - Selected := -1; -end; - -procedure TLyric.Clear; -begin -{ ColR := Skin_FontR; - ColG := Skin_FontG; - ColB := Skin_FontB;} - SetLength(Word, 0); - Text := ''; - SelectedI := -1; -end; - -procedure TLyric.Refresh; -var - W: integer; - TotWidth: real; -begin - if AlignI = 1 then begin - TotWidth := 0; - for W := 0 to High(Word) do - TotWidth := TotWidth + Word[W].Width; - - Word[0].X := XR - TotWidth / 2; - for W := 1 to High(Word) do - Word[W].X := Word[W - 1].X + Word[W - 1].Width; - end; -end; - -procedure TLyric.DrawPlayerIcons; -begin - -end; - -procedure TLyric.Draw; -var - W: integer; -begin - case StyleI of - 0: - begin - for W := 0 to High(Word) do - DrawNormal(W); - end; - 1: - begin - for W := 0 to High(Word) do - DrawPlain(W); - end; - 2: // zoom - begin - for W := 0 to High(Word) do - if not Word[W].Selected then - DrawNormal(W); - - for W := 0 to High(Word) do - if Word[W].Selected then - DrawScaled(W); - end; - 3: // slide - begin - for W := 0 to High(Word) do begin - if not Word[W].Selected then - DrawNormal(W) - else - DrawSlide(W); - end; - end; - 4: // ball - begin - for W := 0 to High(Word) do - DrawNormal(W); - - for W := 0 to High(Word) do - if Word[W].Selected then begin - Tex_Ball.X := (Word[W].X - 10) + Word[W].Done * Word[W].Width; - Tex_Ball.Y := 480 - 10*sin(Word[W].Done * pi); - Tex_Ball.W := 20; - Tex_Ball.H := 20; - DrawTexture(Tex_Ball); - end; - end; - end; // case -end; - -procedure TLyric.DrawNormal(W: integer); -begin - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(pchar(Word[W].Text)); -end; - -procedure TLyric.DrawPlain(W: integer); -var - D: real; -begin - D := Word[W].Done; // przyrost - - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - - if D = 0 then - glColor3f(ColR, ColG, ColB) - else - glColor3f(ColSR, ColSG, ColSB); - - glPrint(pchar(Word[W].Text)); -end; - -procedure TLyric.DrawScaled(W: integer); -var - D: real; -begin - // previous plus dynamic scaling effect - D := 1-Word[W].Done; // przyrost - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X - D * Word[W].Width * (Word[W].Scale - 1) / 2 + (D+1)*10*ScreenX, Word[W].Y - D * 1.5 * Word[W].Size *(Word[W].Scale - 1)); - SetFontSize(Word[W].Size + D * (Word[W].Size * Word[W].Scale - Word[W].Size)); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(pchar(Word[W].Text)) -end; - -procedure TLyric.DrawSlide(W: integer); -var - D: real; -begin - D := Word[W].Done; // przyrost - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrintDone(pchar(Word[W].Text), D, ColR, ColG, ColB); -end; - -function TLyric.SelectedLetter; // LCD -var - W: integer; -begin - Result := 1; - - for W := 0 to SelectedI-1 do - Result := Result + Length(Word[W].Text); -end; - -function TLyric.SelectedLength: integer; // LCD -begin - Result := Length(Word[SelectedI].Text); -end; - -end. +unit ULyrics_bak; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses SysUtils, + OpenGL12, + UMusic, + UTexture; + +type + TWord = record + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + Scale: real; + Done: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; + end; + + TLyric = class + private + AlignI: integer; + XR: real; + YR: real; + SizeR: real; + SelectedI: integer; + ScaleR: real; + StyleI: integer; // 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left + FontStyleI: integer; // font number + Word: array of TWord; + + //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled + PlayerIconTex: array[0..5] of array [0..1] of TTexture; + + procedure SetX(Value: real); + procedure SetY(Value: real); + function GetClientX: real; + procedure SetAlign(Value: integer); + function GetSize: real; + procedure SetSize(Value: real); + procedure SetSelected(Value: integer); + procedure SetDone(Value: real); + procedure SetScale(Value: real); + procedure SetStyle(Value: integer); + procedure SetFStyle(Value: integer); + procedure Refresh; + + procedure DrawNormal(W: integer); + procedure DrawPlain(W: integer); + procedure DrawScaled(W: integer); + procedure DrawSlide(W: integer); + + procedure DrawPlayerIcons; + public + //Array containing Players Singing the Next Sentence + // 1: Player 1 Active + // 2: Player 2 Active + // 3: Player 3 Active + PlayersActive: Byte; + + //Dark or Light Colors + Enabled: Boolean; + + ColR: real; + ColG: real; + ColB: real; + ColSR: real; + ColSG: real; + ColSB: real; + Italic: boolean; + Text: string; // LCD + + constructor Create; + + procedure AddWord(Text: string); + procedure AddCzesc(NrCzesci: integer); + + function SelectedLetter: integer; // LCD + function SelectedLength: integer; // LCD + + procedure Clear; + procedure Draw; + published + property X: real write SetX; + property Y: real write SetY; + property ClientX: real read GetClientX; + property Align: integer write SetAlign; + property Size: real read GetSize write SetSize; + property Selected: integer read SelectedI write SetSelected; + property Done: real write SetDone; + property Scale: real write SetScale; + property Style: integer write SetStyle; + property FontStyle: integer write SetFStyle; + end; + +var + Lyric: TLyric; + +implementation +uses TextGL, UGraphic, UDrawTexture, Math, USkins; + +Constructor TLyric.Create; +var + I: Integer; +begin + //Only 2 Players for now + For I := 0 to 1 do + begin + PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + end; + PlayersActive := Trunc(Power(2, 1)) + 1; +end; + +procedure TLyric.SetX(Value: real); +begin + XR := Value; +end; + +procedure TLyric.SetY(Value: real); +begin + YR := Value; +end; + +function TLyric.GetClientX: real; +begin + Result := Word[0].X; +end; + +procedure TLyric.SetAlign(Value: integer); +begin + AlignI := Value; +// if AlignInt = 0 then beep; +end; + +function TLyric.GetSize: real; +begin + Result := SizeR; +end; + +procedure TLyric.SetSize(Value: real); +begin + SizeR := Value; +end; + +procedure TLyric.SetSelected(Value: integer); +var + W: integer; +begin + if (StyleI = 0) or (StyleI = 2) or (StyleI = 4) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + Word[SelectedI].Selected := false; + Word[SelectedI].ColR := ColR; + Word[SelectedI].ColG := ColG; + Word[SelectedI].ColB := ColB; + Word[SelectedI].Done := 0; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + Word[Value].Selected := true; + Word[Value].ColR := ColSR; + Word[Value].ColG := ColSG; + Word[Value].ColB := ColSB; + Word[Value].Scale := ScaleR; + end; + end; + + if (StyleI = 1) or (StyleI = 3) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + for W := SelectedI to High(Word) do begin + Word[W].Selected := false; + Word[W].ColR := ColR; + Word[W].ColG := ColG; + Word[W].ColB := ColB; + Word[W].Done := 0; + end; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + for W := 0 to Value do begin + Word[W].Selected := true; + Word[W].ColR := ColSR; + Word[W].ColG := ColSG; + Word[W].ColB := ColSB; + Word[W].Scale := ScaleR; + Word[W].Done := 1; + end; + end; + end; + + Refresh; +end; + +procedure TLyric.SetDone(Value: real); +var + W: integer; +begin + W := SelectedI; + if W > -1 then + Word[W].Done := Value; +end; + +procedure TLyric.SetScale(Value: real); +begin + ScaleR := Value; +end; + +procedure TLyric.SetStyle(Value: integer); +begin + StyleI := Value; +end; + +procedure TLyric.SetFStyle(Value: integer); +begin + FontStyleI := Value; +end; + +procedure TLyric.AddWord(Text: string); +var + WordNum: integer; +begin + WordNum := Length(Word); + SetLength(Word, WordNum + 1); + if WordNum = 0 then begin + Word[WordNum].X := XR; + end else begin + Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; + end; + + Word[WordNum].Y := YR; + Word[WordNum].Size := SizeR; + Word[WordNum].FontStyle := FontStyleI; // new + SetFontStyle(FontStyleI); + SetFontSize(SizeR); + Word[WordNum].Width := glTextWidth(pchar(Text)); + Word[WordNum].Text := Text; + Word[WordNum].ColR := ColR; + Word[WordNum].ColG := ColG; + Word[WordNum].ColB := ColB; + Word[WordNum].Scale := 1; + Word[WordNum].Done := 0; + Word[WordNum].Italic := Italic; + + Refresh; +end; + +procedure TLyric.AddCzesc(NrCzesci: integer); +var + N: integer; +begin + Clear; + for N := 0 to Czesci[0].Czesc[NrCzesci].HighNut do begin + Italic := Czesci[0].Czesc[NrCzesci].Nuta[N].FreeStyle; + AddWord(Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst); + Text := Text + Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst; + end; + Selected := -1; +end; + +procedure TLyric.Clear; +begin +{ ColR := Skin_FontR; + ColG := Skin_FontG; + ColB := Skin_FontB;} + SetLength(Word, 0); + Text := ''; + SelectedI := -1; +end; + +procedure TLyric.Refresh; +var + W: integer; + TotWidth: real; +begin + if AlignI = 1 then begin + TotWidth := 0; + for W := 0 to High(Word) do + TotWidth := TotWidth + Word[W].Width; + + Word[0].X := XR - TotWidth / 2; + for W := 1 to High(Word) do + Word[W].X := Word[W - 1].X + Word[W - 1].Width; + end; +end; + +procedure TLyric.DrawPlayerIcons; +begin + +end; + +procedure TLyric.Draw; +var + W: integer; +begin + case StyleI of + 0: + begin + for W := 0 to High(Word) do + DrawNormal(W); + end; + 1: + begin + for W := 0 to High(Word) do + DrawPlain(W); + end; + 2: // zoom + begin + for W := 0 to High(Word) do + if not Word[W].Selected then + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then + DrawScaled(W); + end; + 3: // slide + begin + for W := 0 to High(Word) do begin + if not Word[W].Selected then + DrawNormal(W) + else + DrawSlide(W); + end; + end; + 4: // ball + begin + for W := 0 to High(Word) do + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then begin + Tex_Ball.X := (Word[W].X - 10) + Word[W].Done * Word[W].Width; + Tex_Ball.Y := 480 - 10*sin(Word[W].Done * pi); + Tex_Ball.W := 20; + Tex_Ball.H := 20; + DrawTexture(Tex_Ball); + end; + end; + end; // case +end; + +procedure TLyric.DrawNormal(W: integer); +begin + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawPlain(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + + if D = 0 then + glColor3f(ColR, ColG, ColB) + else + glColor3f(ColSR, ColSG, ColSB); + + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawScaled(W: integer); +var + D: real; +begin + // previous plus dynamic scaling effect + D := 1-Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X - D * Word[W].Width * (Word[W].Scale - 1) / 2 + (D+1)*10*ScreenX, Word[W].Y - D * 1.5 * Word[W].Size *(Word[W].Scale - 1)); + SetFontSize(Word[W].Size + D * (Word[W].Size * Word[W].Scale - Word[W].Size)); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)) +end; + +procedure TLyric.DrawSlide(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrintDone(pchar(Word[W].Text), D, ColR, ColG, ColB); +end; + +function TLyric.SelectedLetter; // LCD +var + W: integer; +begin + Result := 1; + + for W := 0 to SelectedI-1 do + Result := Result + Length(Word[W].Text); +end; + +function TLyric.SelectedLength: integer; // LCD +begin + Result := Length(Word[SelectedI].Text); +end; + +end. diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas index 80305b35..d3b65e2f 100644 --- a/Game/Code/Classes/UMain.pas +++ b/Game/Code/Classes/UMain.pas @@ -2,6 +2,10 @@ unit UMain; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses @@ -141,7 +145,7 @@ uses USongs, UJoystick, math, UCommandLine, ULanguage, SDL_ttf, const Version = 'UltraStar Deluxe V 1.10 Alpha Build'; -{$IFDEF WIN32} +//{$IFDEF WIN32} Procedure Main; var WndTitle: string; @@ -401,7 +405,7 @@ begin Log.Free; end; -{$ENDIF} +//{$ENDIF} procedure MainLoop; var diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index 37e311af..0c788677 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -12,6 +12,10 @@ unit UMedia_dummy; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} implementation diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas index e2d2cc60..3fc1136b 100644 --- a/Game/Code/Classes/UMusic.pas +++ b/Game/Code/Classes/UMusic.pas @@ -2,6 +2,10 @@ unit UMusic; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses Classes ; diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index 4f351dc5..36a40858 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -1,376 +1,381 @@ -unit UParty; - -interface - -{$I switches.inc} - -uses ModiSDK; - -type - TRoundInfo = record - Plugin: Word; - Winner: Byte; - end; - - TeamOrderEntry = record - Teamnum: Byte; - Score: Byte; - end; - - TeamOrderArray = Array[0..5] of Byte; - - TParty_Session = class - private - function GetRandomPlayer(Team: Byte): Byte; - function IsWinner(Player, Winner: Byte): boolean; - procedure GenScores; - public - Teams: TTeamInfo; - Rounds: array of TRoundInfo; - CurRound: Byte; - - constructor Create; - - procedure StartNewParty(NumRounds: Byte); - procedure StartRound; - procedure EndRound; - function GetTeamOrder: TeamOrderArray; - function GetWinnerString(Round: Byte): String; - end; - -var - PartySession: TParty_Session; - -implementation - -uses UDLLManager, UGraphic, UMain, ULanguage, ULog; - -//---------- -//Constructor - Prepares the Class -//---------- -constructor TParty_Session.Create; -begin -// - Nothing in here atm -end; - -//---------- -//StartNewParty - Clears the Class and Prepares for new Party -//---------- -procedure TParty_Session.StartNewParty(NumRounds: Byte); -var - Plugins: Array of record - ID: Byte; - TimesPlayed: Byte; - end; - TeamMode: Boolean; - Len: Integer; - I, J: Integer; - - function GetRandomPlugin: Byte; - var - LowestTP: Byte; - NumPwithLTP: Word; - I: Integer; - R: Word; - begin - LowestTP := high(Byte); - NumPwithLTP := 0; - - //Search for Plugins not often played yet - For I := 0 to high(Plugins) do - begin - if (Plugins[I].TimesPlayed < lowestTP) then - begin - lowestTP := Plugins[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Plugins[I].TimesPlayed = lowestTP) then - begin - Inc(NumPwithLTP); - end; - end; - - //Create Random No - R := Random(NumPwithLTP); - - //Search for Random Plugin - For I := 0 to high(Plugins) do - begin - if Plugins[I].TimesPlayed = lowestTP then - begin - //Plugin Found - if (R = 0) then - begin - Result := Plugins[I].ID; - Inc(Plugins[I].TimesPlayed); - Break; - end; - - Dec(R); - end; - end; - end; -begin - //Set cur Round to Round 1 - CurRound := 255; - - PlayersPlay := Teams.NumTeams; - - //Get Teammode and Set Joker, also set TimesPlayed - TeamMode := True; - For I := 0 to Teams.NumTeams-1 do - begin - if Teams.Teaminfo[I].NumPlayers < 2 then - begin - TeamMode := False; - end; - //Set Player Attributes - For J := 0 to Teams.TeamInfo[I].NumPlayers-1 do - begin - Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0; - end; - Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); - Teams.Teaminfo[I].Score := 0; - end; - - //Fill Plugin Array - SetLength(Plugins, 0); - For I := 0 to high(DLLMan.Plugins) do - begin - if TeamMode or (Not DLLMan.Plugins[I].TeamModeOnly) then - begin //Add only Plugins Playable with cur. PlayerConfiguration - Len := Length(Plugins); - SetLength(Plugins, Len + 1); - Plugins[Len].ID := I; - Plugins[Len].TimesPlayed := 0; - end; - end; - - //Set Rounds - If (Length(Plugins) >= 1) then - begin - SetLength (Rounds, NumRounds); - For I := 0 to NumRounds-1 do - begin - PartySession.Rounds[I].Plugin := GetRandomPlugin; - PartySession.Rounds[I].Winner := 255; - end; - end - else SetLength (Rounds, 0); -end; - -//---------- -//GetRandomPlayer - Gives back a Random Player to Play next Round -//---------- -function TParty_Session.GetRandomPlayer(Team: Byte): Byte; -var - I, R: Integer; - lowestTP: Byte; - NumPwithLTP: Byte; -begin - LowestTP := high(Byte); - NumPwithLTP := 0; - Result := 0; - - //Search for Players that have not often played yet - For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do - begin - if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then - begin - lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then - begin - Inc(NumPwithLTP); - end; - end; - - //Create Random No - R := Random(NumPwithLTP); - - //Search for Random Player - For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do - begin - if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then - begin - //Player Found - if (R = 0) then - begin - Result := I; - Break; - end; - - Dec(R); - end; - end; - {//Get lowest TimesPlayed - lowestTP := high(Byte); - J := -1; - for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do - begin - if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then - begin - lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; - J := I; - end - else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then - begin - J := -1; - end; - end; - - //If more than one Person has lowestTP then Select Random Player - if (J < 0) then - repeat - Result := Random(Teams.Teaminfo[Team].NumPlayers); - until (Teams.Teaminfo[Team].Playerinfo[Result].TimesPlayed = lowestTP) - else //Else Select the one with lowest TP - Result:= J;} -end; - -//---------- -//StartNextRound - Prepares ScreenSingModi for Next Round And Load Plugin -//---------- -procedure TParty_Session.StartRound; -var - I: Integer; -begin - if ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then - begin - //Increase Current Round - Inc (CurRound); - - Rounds[CurRound].Winner := 255; - DllMan.LoadPlugin(Rounds[CurRound].Plugin); - - //Select Players - for I := 0 to Teams.NumTeams-1 do - Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); - - //Set ScreenSingModie Variables - ScreenSingModi.TeamInfo := Teams; - - //Set - end; -end; - -//---------- -//IsWinner - Returns True if the Players Bit is set in the Winner Byte -//---------- -function TParty_Session.IsWinner(Player, Winner: Byte): boolean; -var - Bit: Byte; -begin - Case Player of - 0: Bit := 1; - 1: Bit := 2; - 2: Bit := 4; - 3: Bit := 8; - 4: Bit := 16; - 5: Bit := 32; - end; - - Result := ((Winner AND Bit) = Bit); -end; - -//---------- -//GenScores - Inc Scores for Cur. Round -//---------- -procedure TParty_Session.GenScores; -var - I: Byte; -begin - for I := 0 to Teams.NumTeams-1 do - begin - if isWinner(I, Rounds[CurRound].Winner) then - Inc(Teams.Teaminfo[I].Score); - end; -end; - -//---------- -//GetWinnerString - Get String with WinnerTeam Name, when there is more than one Winner than Connect with and or , -//---------- -function TParty_Session.GetWinnerString(Round: Byte): String; -var - Winners: Array of String; - I: Integer; -begin - Result := Language.Translate('PARTY_NOBODY'); - - if (Round > High(Rounds)) then - exit; - - if (Rounds[Round].Winner = 0) then - begin - exit; - end; - - if (Rounds[Round].Winner = 255) then - begin - Result := Language.Translate('PARTY_NOTPLAYEDYET'); - exit; - end; - - SetLength(Winners, 0); - for I := 0 to Teams.NumTeams-1 do - begin - if isWinner(I, Rounds[Round].Winner) then - begin - SetLength(Winners, Length(Winners) + 1); - Winners[high(Winners)] := Teams.TeamInfo[I].Name; - end; - end; - Result := Language.Implode(Winners); -end; - -//---------- -//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray -//---------- -procedure TParty_Session.EndRound; -var - I: Integer; -begin - //Copy Winner - Rounds[CurRound].Winner := ScreenSingModi.Winner; - //Set Scores - GenScores; - - //Increase TimesPlayed 4 all Players - For I := 0 to Teams.NumTeams-1 do - Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed); - -end; - -//---------- -//GetTeamOrder - Gives back the Placing of eacb Team [First Position of Array is Teamnum of first placed Team, ...] -//---------- -function TParty_Session.GetTeamOrder: TeamOrderArray; -var - I, J: Integer; - ATeams: array [0..5] of TeamOrderEntry; - TempTeam: TeamOrderEntry; -begin - //Fill Team Array - For I := 0 to Teams.NumTeams-1 do - begin - ATeams[I].Teamnum := I; - ATeams[I].Score := Teams.Teaminfo[I].Score; - end; - - //Sort Teams - for J := 0 to Teams.NumTeams-1 do - for I := 1 to Teams.NumTeams-1 do - if ATeams[I].Score > ATeams[I-1].Score then - begin - TempTeam := ATeams[I-1]; - ATeams[I-1] := ATeams[I]; - ATeams[I] := TempTeam; - end; - - //Copy to Result - For I := 0 to Teams.NumTeams-1 do - Result[I] := ATeams[I].TeamNum; -end; - -end. +unit UParty; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + + +{$I switches.inc} + +uses ModiSDK; + +type + TRoundInfo = record + Plugin: Word; + Winner: Byte; + end; + + TeamOrderEntry = record + Teamnum: Byte; + Score: Byte; + end; + + TeamOrderArray = Array[0..5] of Byte; + + TParty_Session = class + private + function GetRandomPlayer(Team: Byte): Byte; + function IsWinner(Player, Winner: Byte): boolean; + procedure GenScores; + public + Teams: TTeamInfo; + Rounds: array of TRoundInfo; + CurRound: Byte; + + constructor Create; + + procedure StartNewParty(NumRounds: Byte); + procedure StartRound; + procedure EndRound; + function GetTeamOrder: TeamOrderArray; + function GetWinnerString(Round: Byte): String; + end; + +var + PartySession: TParty_Session; + +implementation + +uses UDLLManager, UGraphic, UMain, ULanguage, ULog; + +//---------- +//Constructor - Prepares the Class +//---------- +constructor TParty_Session.Create; +begin +// - Nothing in here atm +end; + +//---------- +//StartNewParty - Clears the Class and Prepares for new Party +//---------- +procedure TParty_Session.StartNewParty(NumRounds: Byte); +var + Plugins: Array of record + ID: Byte; + TimesPlayed: Byte; + end; + TeamMode: Boolean; + Len: Integer; + I, J: Integer; + + function GetRandomPlugin: Byte; + var + LowestTP: Byte; + NumPwithLTP: Word; + I: Integer; + R: Word; + begin + LowestTP := high(Byte); + NumPwithLTP := 0; + + //Search for Plugins not often played yet + For I := 0 to high(Plugins) do + begin + if (Plugins[I].TimesPlayed < lowestTP) then + begin + lowestTP := Plugins[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Plugins[I].TimesPlayed = lowestTP) then + begin + Inc(NumPwithLTP); + end; + end; + + //Create Random No + R := Random(NumPwithLTP); + + //Search for Random Plugin + For I := 0 to high(Plugins) do + begin + if Plugins[I].TimesPlayed = lowestTP then + begin + //Plugin Found + if (R = 0) then + begin + Result := Plugins[I].ID; + Inc(Plugins[I].TimesPlayed); + Break; + end; + + Dec(R); + end; + end; + end; +begin + //Set cur Round to Round 1 + CurRound := 255; + + PlayersPlay := Teams.NumTeams; + + //Get Teammode and Set Joker, also set TimesPlayed + TeamMode := True; + For I := 0 to Teams.NumTeams-1 do + begin + if Teams.Teaminfo[I].NumPlayers < 2 then + begin + TeamMode := False; + end; + //Set Player Attributes + For J := 0 to Teams.TeamInfo[I].NumPlayers-1 do + begin + Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0; + end; + Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); + Teams.Teaminfo[I].Score := 0; + end; + + //Fill Plugin Array + SetLength(Plugins, 0); + For I := 0 to high(DLLMan.Plugins) do + begin + if TeamMode or (Not DLLMan.Plugins[I].TeamModeOnly) then + begin //Add only Plugins Playable with cur. PlayerConfiguration + Len := Length(Plugins); + SetLength(Plugins, Len + 1); + Plugins[Len].ID := I; + Plugins[Len].TimesPlayed := 0; + end; + end; + + //Set Rounds + If (Length(Plugins) >= 1) then + begin + SetLength (Rounds, NumRounds); + For I := 0 to NumRounds-1 do + begin + PartySession.Rounds[I].Plugin := GetRandomPlugin; + PartySession.Rounds[I].Winner := 255; + end; + end + else SetLength (Rounds, 0); +end; + +//---------- +//GetRandomPlayer - Gives back a Random Player to Play next Round +//---------- +function TParty_Session.GetRandomPlayer(Team: Byte): Byte; +var + I, R: Integer; + lowestTP: Byte; + NumPwithLTP: Byte; +begin + LowestTP := high(Byte); + NumPwithLTP := 0; + Result := 0; + + //Search for Players that have not often played yet + For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then + begin + lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then + begin + Inc(NumPwithLTP); + end; + end; + + //Create Random No + R := Random(NumPwithLTP); + + //Search for Random Player + For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then + begin + //Player Found + if (R = 0) then + begin + Result := I; + Break; + end; + + Dec(R); + end; + end; + {//Get lowest TimesPlayed + lowestTP := high(Byte); + J := -1; + for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then + begin + lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; + J := I; + end + else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then + begin + J := -1; + end; + end; + + //If more than one Person has lowestTP then Select Random Player + if (J < 0) then + repeat + Result := Random(Teams.Teaminfo[Team].NumPlayers); + until (Teams.Teaminfo[Team].Playerinfo[Result].TimesPlayed = lowestTP) + else //Else Select the one with lowest TP + Result:= J;} +end; + +//---------- +//StartNextRound - Prepares ScreenSingModi for Next Round And Load Plugin +//---------- +procedure TParty_Session.StartRound; +var + I: Integer; +begin + if ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then + begin + //Increase Current Round + Inc (CurRound); + + Rounds[CurRound].Winner := 255; + DllMan.LoadPlugin(Rounds[CurRound].Plugin); + + //Select Players + for I := 0 to Teams.NumTeams-1 do + Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); + + //Set ScreenSingModie Variables + ScreenSingModi.TeamInfo := Teams; + + //Set + end; +end; + +//---------- +//IsWinner - Returns True if the Players Bit is set in the Winner Byte +//---------- +function TParty_Session.IsWinner(Player, Winner: Byte): boolean; +var + Bit: Byte; +begin + Case Player of + 0: Bit := 1; + 1: Bit := 2; + 2: Bit := 4; + 3: Bit := 8; + 4: Bit := 16; + 5: Bit := 32; + end; + + Result := ((Winner AND Bit) = Bit); +end; + +//---------- +//GenScores - Inc Scores for Cur. Round +//---------- +procedure TParty_Session.GenScores; +var + I: Byte; +begin + for I := 0 to Teams.NumTeams-1 do + begin + if isWinner(I, Rounds[CurRound].Winner) then + Inc(Teams.Teaminfo[I].Score); + end; +end; + +//---------- +//GetWinnerString - Get String with WinnerTeam Name, when there is more than one Winner than Connect with and or , +//---------- +function TParty_Session.GetWinnerString(Round: Byte): String; +var + Winners: Array of String; + I: Integer; +begin + Result := Language.Translate('PARTY_NOBODY'); + + if (Round > High(Rounds)) then + exit; + + if (Rounds[Round].Winner = 0) then + begin + exit; + end; + + if (Rounds[Round].Winner = 255) then + begin + Result := Language.Translate('PARTY_NOTPLAYEDYET'); + exit; + end; + + SetLength(Winners, 0); + for I := 0 to Teams.NumTeams-1 do + begin + if isWinner(I, Rounds[Round].Winner) then + begin + SetLength(Winners, Length(Winners) + 1); + Winners[high(Winners)] := Teams.TeamInfo[I].Name; + end; + end; + Result := Language.Implode(Winners); +end; + +//---------- +//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray +//---------- +procedure TParty_Session.EndRound; +var + I: Integer; +begin + //Copy Winner + Rounds[CurRound].Winner := ScreenSingModi.Winner; + //Set Scores + GenScores; + + //Increase TimesPlayed 4 all Players + For I := 0 to Teams.NumTeams-1 do + Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed); + +end; + +//---------- +//GetTeamOrder - Gives back the Placing of eacb Team [First Position of Array is Teamnum of first placed Team, ...] +//---------- +function TParty_Session.GetTeamOrder: TeamOrderArray; +var + I, J: Integer; + ATeams: array [0..5] of TeamOrderEntry; + TempTeam: TeamOrderEntry; +begin + //Fill Team Array + For I := 0 to Teams.NumTeams-1 do + begin + ATeams[I].Teamnum := I; + ATeams[I].Score := Teams.Teaminfo[I].Score; + end; + + //Sort Teams + for J := 0 to Teams.NumTeams-1 do + for I := 1 to Teams.NumTeams-1 do + if ATeams[I].Score > ATeams[I-1].Score then + begin + TempTeam := ATeams[I-1]; + ATeams[I-1] := ATeams[I]; + ATeams[I] := TempTeam; + end; + + //Copy to Result + For I := 0 to Teams.NumTeams-1 do + Result[I] := ATeams[I].TeamNum; +end; + +end. diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas index b18d4833..8d981065 100644 --- a/Game/Code/Classes/UPlaylist.pas +++ b/Game/Code/Classes/UPlaylist.pas @@ -1,463 +1,467 @@ -unit UPlaylist; - -interface - -{$I switches.inc} - - -type - TPlaylistItem = record - Artist: String; - Title: String; - SongID: Integer; - end; - - APlaylistItem = array of TPlaylistItem; - - TPlaylist = record - Name: String; - Filename: String; - Items: APlaylistItem; - end; - - APlaylist = array of TPlaylist; - - //---------- - //TPlaylistManager - Class for Managing Playlists (Loading, Displaying, Saving) - //---------- - TPlaylistManager = class - private - - public - Mode: Byte; //Current Playlist Mode for SongScreen - CurPlayList: Cardinal; - CurItem: Cardinal; - - Playlists: APlaylist; - - constructor Create; - Procedure LoadPlayLists; - Function LoadPlayList(Index: Cardinal; Filename: String): Boolean; - Procedure SavePlayList(Index: Cardinal); - - Procedure SetPlayList(Index: Cardinal); - - Function AddPlaylist(Name: String): Cardinal; - Procedure DelPlaylist(const Index: Cardinal); - - Procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1); - Procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1); - - Procedure GetNames(var PLNames: array of String); - Function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer; - end; - - {Modes: - 0: Standard Mode - 1: Category Mode - 2: PlayList Mode} - - var - PlayListMan: TPlaylistManager; - - -implementation - -uses USongs, - ULog, - UMain, - //UFiles, - UGraphic, - UThemes, - SysUtils; - -//---------- -//Create - Construct Class - Dummy for now -//---------- -constructor TPlayListManager.Create; -begin - LoadPlayLists; -end; - -//---------- -//LoadPlayLists - Load list of Playlists from PlayList Folder -//---------- -Procedure TPlayListManager.LoadPlayLists; -var - SR: TSearchRec; - Len: Integer; -begin - SetLength(Playlists, 0); - - if FindFirst(PlayListPath + '*.upl', 0, SR) = 0 then - begin - repeat - Len := Length(Playlists); - SetLength(Playlists, Len +1); - - if not LoadPlayList (Len, Sr.Name) then - SetLength(Playlists, Len); - - until FindNext(SR) <> 0; - FindClose(SR); - end; -end; - -//---------- -//LoadPlayList - Load a Playlist in the Array -//---------- -Function TPlayListManager.LoadPlayList(Index: Cardinal; Filename: String): Boolean; - var - F: TextFile; - Line: String; - PosDelimiter: Integer; - SongID: Integer; - Len: Integer; - - Function FindSong(Artist, Title: String): Integer; - var I: Integer; - begin - Result := -1; - - For I := low(CatSongs.Song) to high(CatSongs.Song) do - begin - if (CatSongs.Song[I].Title = Title) AND (CatSongs.Song[I].Artist = Artist) then - begin - Result := I; - Break; - end; - end; - end; -begin - if not FileExists(PlayListPath + Filename) then - begin - Log.LogError('Could not load Playlist: ' + Filename); - Result := False; - Exit; - end; - Result := True; - - //Load File - AssignFile(F, PlayListPath + FileName); - Reset(F); - - //Set Filename - PlayLists[Index].Filename := Filename; - PlayLists[Index].Name := ''; - - //Read Until End of File - While not Eof(F) do - begin - //Read Curent Line - Readln(F, Line); - - if (Length(Line) > 0) then - begin - PosDelimiter := Pos(':', Line); - if (PosDelimiter <> 0) then - begin - //Comment or Name String - if (Line[1] = '#') then - begin - //Found Name Value - if (Uppercase(Trim(copy(Line, 2, PosDelimiter - 2))) = 'NAME') then - PlayLists[Index].Name := Trim(copy(Line, PosDelimiter + 1,Length(Line) - PosDelimiter)) - - end - //Song Entry - else - begin - SongID := FindSong(Trim(copy(Line, 1, PosDelimiter - 1)), Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter))); - if (SongID <> -1) then - begin - Len := Length(PlayLists[Index].Items); - SetLength(PlayLists[Index].Items, Len + 1); - - PlayLists[Index].Items[Len].SongID := SongID; - - PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1)); - PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)); - end - else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename + ', ' + Line); - end; - end; - end; - end; - - //If no special name is given, use Filename - if PlayLists[Index].Name = '' then - begin - PlayLists[Index].Name := ChangeFileExt(FileName, ''); - end; - - //Finish (Close File) - CloseFile(F); -end; - -//---------- -//SavePlayList - Saves the specified Playlist -//---------- -Procedure TPlayListManager.SavePlayList(Index: Cardinal); -var - F: TextFile; - I: Integer; -begin - if (Not FileExists(PlaylistPath + Playlists[Index].Filename)) OR (Not FileisReadOnly(PlaylistPath + Playlists[Index].Filename)) then - begin - - //open File for Rewriting - AssignFile(F, PlaylistPath + Playlists[Index].Filename); - try - try - Rewrite(F); - - //Write Version (not nessecary but helpful) - WriteLn(F, '######################################'); - WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0'); - WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.'); - WriteLn(F, '######################################'); - - //Write Name Information - WriteLn(F, '#Name: ' + Playlists[Index].Name); - - //Write Song Information - WriteLn(F, '#Songs:'); - - For I := 0 to high(Playlists[Index].Items) do - begin - WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title); - end; - except - log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"'); - end; - finally - CloseFile(F); - end; - end; -end; - -//---------- -//SetPlayList - Display a Playlist in CatSongs -//---------- -Procedure TPlayListManager.SetPlayList(Index: Cardinal); -var - I: Integer; -begin - If (Index > High(PlayLists)) then - exit; - - //Hide all Songs - For I := 0 to high(CatSongs.Song) do - CatSongs.Song[I].Visible := False; - - //Show Songs in PL - For I := 0 to high(PlayLists[Index].Items) do - begin - CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True; - end; - - //Set CatSongsMode + Playlist Mode - CatSongs.CatNumShow := -3; - Mode := 2; - - //Set CurPlaylist - CurPlaylist := Index; - - //Show Cat in Topleft: - ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name])); - - //Fix SongSelection - ScreenSong.Interaction := 0; - ScreenSong.SelectNext; - ScreenSong.FixSelected; - - //Play correct Music - ScreenSong.ChangeMusic; -end; - -//---------- -//AddPlaylist - Adds a Playlist and Returns the Index -//---------- -Function TPlayListManager.AddPlaylist(Name: String): Cardinal; -var I: Integer; -begin - Result := Length(Playlists); - SetLength(Playlists, Result + 1); - - Playlists[Result].Name := Name; - - I := 1; - - if (not FileExists(PlaylistPath + Name + '.upl')) then - Playlists[Result].Filename := Name + '.upl' - else - begin - repeat - Inc(I); - until not FileExists(PlaylistPath + Name + InttoStr(I) + '.upl'); - Playlists[Result].Filename := Name + InttoStr(I) + '.upl'; - end; - - //Save new Playlist - SavePlayList(Result); -end; - -//---------- -//DelPlaylist - Deletes a Playlist -//---------- -Procedure TPlayListManager.DelPlaylist(const Index: Cardinal); -var - I: Integer; - Filename: String; -begin - If Index > High(Playlists) then - Exit; - - Filename := PlaylistPath + Playlists[Index].Filename; - - //If not FileExists or File is not Writeable then exit - If (Not FileExists(Filename)) OR (FileisReadOnly(Filename)) then - Exit; - - - //Delete Playlist from FileSystem - if Not DeleteFile(Filename) then - Exit; - - //Delete Playlist from Array - //move all PLs to the Hole - For I := Index to High(Playlists)-1 do - PlayLists[I] := PlayLists[I+1]; - - //Delete last Playlist - SetLength (Playlists, High(Playlists)); - - //If Playlist is Displayed atm - //-> Display Songs - if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then - begin - ScreenSong.UnLoadDetailedCover; - ScreenSong.HideCatTL; - CatSongs.SetFilter('', 0); - ScreenSong.Interaction := 0; - ScreenSong.FixSelected; - ScreenSong.ChangeMusic; - end; -end; - -//---------- -//AddItem - Adds an Item to a specific Playlist -//---------- -Procedure TPlayListManager.AddItem(const SongID: Cardinal; const iPlaylist: Integer); -var - P: Cardinal; - Len: Cardinal; -begin - if iPlaylist = -1 then - P := CurPlaylist - else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then - P := iPlaylist - else - exit; - - if (SongID <= High(CatSongs.Song)) AND (NOT CatSongs.Song[SongID].Main) then - begin - Len := Length(Playlists[P].Items); - SetLength(Playlists[P].Items, Len + 1); - - Playlists[P].Items[Len].SongID := SongID; - Playlists[P].Items[Len].Title := CatSongs.Song[SongID].Title; - Playlists[P].Items[Len].Artist := CatSongs.Song[SongID].Artist; - - //Save Changes - SavePlayList(P); - - //Correct Display when Editing current Playlist - if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then - SetPlaylist(P); - end; -end; - -//---------- -//DelItem - Deletes an Item from a specific Playlist -//---------- -Procedure TPlayListManager.DelItem(const iItem: Cardinal; const iPlaylist: Integer); -var - I: Integer; - P: Cardinal; -begin - if iPlaylist = -1 then - P := CurPlaylist - else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then - P := iPlaylist - else - exit; - - if (iItem <= high(Playlists[P].Items)) then - begin - //Move all entrys behind deleted one to Front - For I := iItem to High(Playlists[P].Items) - 1 do - Playlists[P].Items[I] := Playlists[P].Items[I + 1]; - - //Delete Last Entry - SetLength(PlayLists[P].Items, Length(PlayLists[P].Items) - 1); - - //Save Changes - SavePlayList(P); - end; - - //Delete Playlist if Last Song is deleted - if (Length(PlayLists[P].Items) = 0) then - begin - DelPlaylist(P); - end - //Correct Display when Editing current Playlist - else if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then - SetPlaylist(P); -end; - -//---------- -//GetNames - Writes Playlist Names in a Array -//---------- -Procedure TPlayListManager.GetNames(var PLNames: array of String); -var - I: Integer; - Len: Integer; -begin - Len := High(Playlists); - - if (Length(PLNames) <> Len + 1) then - exit; - - For I := 0 to Len do - PLNames[I] := Playlists[I].Name; -end; - -//---------- -//GetIndexbySongID - Returns Index in the specified Playlist of the given Song -//---------- -Function TPlayListManager.GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer): Integer; -var - P: Integer; - I: Integer; -begin - if iPlaylist = -1 then - P := CurPlaylist - else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then - P := iPlaylist - else - exit; - - Result := -1; - - For I := 0 to high(Playlists[P].Items) do - begin - if (Playlists[P].Items[I].SongID = SongID) then - begin - Result := I; - Break; - end; - end; -end; - -end. +unit UPlaylist; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +type + TPlaylistItem = record + Artist: String; + Title: String; + SongID: Integer; + end; + + APlaylistItem = array of TPlaylistItem; + + TPlaylist = record + Name: String; + Filename: String; + Items: APlaylistItem; + end; + + APlaylist = array of TPlaylist; + + //---------- + //TPlaylistManager - Class for Managing Playlists (Loading, Displaying, Saving) + //---------- + TPlaylistManager = class + private + + public + Mode: Byte; //Current Playlist Mode for SongScreen + CurPlayList: Cardinal; + CurItem: Cardinal; + + Playlists: APlaylist; + + constructor Create; + Procedure LoadPlayLists; + Function LoadPlayList(Index: Cardinal; Filename: String): Boolean; + Procedure SavePlayList(Index: Cardinal); + + Procedure SetPlayList(Index: Cardinal); + + Function AddPlaylist(Name: String): Cardinal; + Procedure DelPlaylist(const Index: Cardinal); + + Procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1); + Procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1); + + Procedure GetNames(var PLNames: array of String); + Function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer; + end; + + {Modes: + 0: Standard Mode + 1: Category Mode + 2: PlayList Mode} + + var + PlayListMan: TPlaylistManager; + + +implementation + +uses USongs, + ULog, + UMain, + //UFiles, + UGraphic, + UThemes, + SysUtils; + +//---------- +//Create - Construct Class - Dummy for now +//---------- +constructor TPlayListManager.Create; +begin + LoadPlayLists; +end; + +//---------- +//LoadPlayLists - Load list of Playlists from PlayList Folder +//---------- +Procedure TPlayListManager.LoadPlayLists; +var + SR: TSearchRec; + Len: Integer; +begin + SetLength(Playlists, 0); + + if FindFirst(PlayListPath + '*.upl', 0, SR) = 0 then + begin + repeat + Len := Length(Playlists); + SetLength(Playlists, Len +1); + + if not LoadPlayList (Len, Sr.Name) then + SetLength(Playlists, Len); + + until FindNext(SR) <> 0; + FindClose(SR); + end; +end; + +//---------- +//LoadPlayList - Load a Playlist in the Array +//---------- +Function TPlayListManager.LoadPlayList(Index: Cardinal; Filename: String): Boolean; + var + F: TextFile; + Line: String; + PosDelimiter: Integer; + SongID: Integer; + Len: Integer; + + Function FindSong(Artist, Title: String): Integer; + var I: Integer; + begin + Result := -1; + + For I := low(CatSongs.Song) to high(CatSongs.Song) do + begin + if (CatSongs.Song[I].Title = Title) AND (CatSongs.Song[I].Artist = Artist) then + begin + Result := I; + Break; + end; + end; + end; +begin + if not FileExists(PlayListPath + Filename) then + begin + Log.LogError('Could not load Playlist: ' + Filename); + Result := False; + Exit; + end; + Result := True; + + //Load File + AssignFile(F, PlayListPath + FileName); + Reset(F); + + //Set Filename + PlayLists[Index].Filename := Filename; + PlayLists[Index].Name := ''; + + //Read Until End of File + While not Eof(F) do + begin + //Read Curent Line + Readln(F, Line); + + if (Length(Line) > 0) then + begin + PosDelimiter := Pos(':', Line); + if (PosDelimiter <> 0) then + begin + //Comment or Name String + if (Line[1] = '#') then + begin + //Found Name Value + if (Uppercase(Trim(copy(Line, 2, PosDelimiter - 2))) = 'NAME') then + PlayLists[Index].Name := Trim(copy(Line, PosDelimiter + 1,Length(Line) - PosDelimiter)) + + end + //Song Entry + else + begin + SongID := FindSong(Trim(copy(Line, 1, PosDelimiter - 1)), Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter))); + if (SongID <> -1) then + begin + Len := Length(PlayLists[Index].Items); + SetLength(PlayLists[Index].Items, Len + 1); + + PlayLists[Index].Items[Len].SongID := SongID; + + PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1)); + PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)); + end + else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename + ', ' + Line); + end; + end; + end; + end; + + //If no special name is given, use Filename + if PlayLists[Index].Name = '' then + begin + PlayLists[Index].Name := ChangeFileExt(FileName, ''); + end; + + //Finish (Close File) + CloseFile(F); +end; + +//---------- +//SavePlayList - Saves the specified Playlist +//---------- +Procedure TPlayListManager.SavePlayList(Index: Cardinal); +var + F: TextFile; + I: Integer; +begin + if (Not FileExists(PlaylistPath + Playlists[Index].Filename)) OR (Not FileisReadOnly(PlaylistPath + Playlists[Index].Filename)) then + begin + + //open File for Rewriting + AssignFile(F, PlaylistPath + Playlists[Index].Filename); + try + try + Rewrite(F); + + //Write Version (not nessecary but helpful) + WriteLn(F, '######################################'); + WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0'); + WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.'); + WriteLn(F, '######################################'); + + //Write Name Information + WriteLn(F, '#Name: ' + Playlists[Index].Name); + + //Write Song Information + WriteLn(F, '#Songs:'); + + For I := 0 to high(Playlists[Index].Items) do + begin + WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title); + end; + except + log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"'); + end; + finally + CloseFile(F); + end; + end; +end; + +//---------- +//SetPlayList - Display a Playlist in CatSongs +//---------- +Procedure TPlayListManager.SetPlayList(Index: Cardinal); +var + I: Integer; +begin + If (Index > High(PlayLists)) then + exit; + + //Hide all Songs + For I := 0 to high(CatSongs.Song) do + CatSongs.Song[I].Visible := False; + + //Show Songs in PL + For I := 0 to high(PlayLists[Index].Items) do + begin + CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True; + end; + + //Set CatSongsMode + Playlist Mode + CatSongs.CatNumShow := -3; + Mode := 2; + + //Set CurPlaylist + CurPlaylist := Index; + + //Show Cat in Topleft: + ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name])); + + //Fix SongSelection + ScreenSong.Interaction := 0; + ScreenSong.SelectNext; + ScreenSong.FixSelected; + + //Play correct Music + ScreenSong.ChangeMusic; +end; + +//---------- +//AddPlaylist - Adds a Playlist and Returns the Index +//---------- +Function TPlayListManager.AddPlaylist(Name: String): Cardinal; +var I: Integer; +begin + Result := Length(Playlists); + SetLength(Playlists, Result + 1); + + Playlists[Result].Name := Name; + + I := 1; + + if (not FileExists(PlaylistPath + Name + '.upl')) then + Playlists[Result].Filename := Name + '.upl' + else + begin + repeat + Inc(I); + until not FileExists(PlaylistPath + Name + InttoStr(I) + '.upl'); + Playlists[Result].Filename := Name + InttoStr(I) + '.upl'; + end; + + //Save new Playlist + SavePlayList(Result); +end; + +//---------- +//DelPlaylist - Deletes a Playlist +//---------- +Procedure TPlayListManager.DelPlaylist(const Index: Cardinal); +var + I: Integer; + Filename: String; +begin + If Index > High(Playlists) then + Exit; + + Filename := PlaylistPath + Playlists[Index].Filename; + + //If not FileExists or File is not Writeable then exit + If (Not FileExists(Filename)) OR (FileisReadOnly(Filename)) then + Exit; + + + //Delete Playlist from FileSystem + if Not DeleteFile(Filename) then + Exit; + + //Delete Playlist from Array + //move all PLs to the Hole + For I := Index to High(Playlists)-1 do + PlayLists[I] := PlayLists[I+1]; + + //Delete last Playlist + SetLength (Playlists, High(Playlists)); + + //If Playlist is Displayed atm + //-> Display Songs + if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then + begin + ScreenSong.UnLoadDetailedCover; + ScreenSong.HideCatTL; + CatSongs.SetFilter('', 0); + ScreenSong.Interaction := 0; + ScreenSong.FixSelected; + ScreenSong.ChangeMusic; + end; +end; + +//---------- +//AddItem - Adds an Item to a specific Playlist +//---------- +Procedure TPlayListManager.AddItem(const SongID: Cardinal; const iPlaylist: Integer); +var + P: Cardinal; + Len: Cardinal; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + if (SongID <= High(CatSongs.Song)) AND (NOT CatSongs.Song[SongID].Main) then + begin + Len := Length(Playlists[P].Items); + SetLength(Playlists[P].Items, Len + 1); + + Playlists[P].Items[Len].SongID := SongID; + Playlists[P].Items[Len].Title := CatSongs.Song[SongID].Title; + Playlists[P].Items[Len].Artist := CatSongs.Song[SongID].Artist; + + //Save Changes + SavePlayList(P); + + //Correct Display when Editing current Playlist + if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then + SetPlaylist(P); + end; +end; + +//---------- +//DelItem - Deletes an Item from a specific Playlist +//---------- +Procedure TPlayListManager.DelItem(const iItem: Cardinal; const iPlaylist: Integer); +var + I: Integer; + P: Cardinal; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + if (iItem <= high(Playlists[P].Items)) then + begin + //Move all entrys behind deleted one to Front + For I := iItem to High(Playlists[P].Items) - 1 do + Playlists[P].Items[I] := Playlists[P].Items[I + 1]; + + //Delete Last Entry + SetLength(PlayLists[P].Items, Length(PlayLists[P].Items) - 1); + + //Save Changes + SavePlayList(P); + end; + + //Delete Playlist if Last Song is deleted + if (Length(PlayLists[P].Items) = 0) then + begin + DelPlaylist(P); + end + //Correct Display when Editing current Playlist + else if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then + SetPlaylist(P); +end; + +//---------- +//GetNames - Writes Playlist Names in a Array +//---------- +Procedure TPlayListManager.GetNames(var PLNames: array of String); +var + I: Integer; + Len: Integer; +begin + Len := High(Playlists); + + if (Length(PLNames) <> Len + 1) then + exit; + + For I := 0 to Len do + PLNames[I] := Playlists[I].Name; +end; + +//---------- +//GetIndexbySongID - Returns Index in the specified Playlist of the given Song +//---------- +Function TPlayListManager.GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer): Integer; +var + P: Integer; + I: Integer; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + Result := -1; + + For I := 0 to high(Playlists[P].Items) do + begin + if (Playlists[P].Items[I].SongID = SongID) then + begin + Result := I; + Break; + end; + end; +end; + +end. diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index 8d3fa5f7..87c35cd8 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -2,6 +2,10 @@ unit URecord; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses Classes, diff --git a/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas index 92b61e85..c8761df0 100644 --- a/Game/Code/Classes/UServices.pas +++ b/Game/Code/Classes/UServices.pas @@ -1,321 +1,326 @@ -unit UServices; - -interface - -{$I switches.inc} - -uses uPluginDefs, SysUtils; -{********************* - TServiceManager - Class for saving, managing and calling of Services. - Saves all Services and their Procs -*********************} - -type - TServiceName = String[60]; - PServiceInfo = ^TServiceInfo; - TServiceInfo = record - Self: THandle; //Handle of this Service - Hash: Integer; //4 Bit Hash of the Services Name - Name: TServiceName; //Name of this Service - - Owner: Integer; //If < 0 [-(DLLMan Pluginindex + 1)]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1] - - Next: PServiceInfo; //Pointer to the Next Service in teh list - - //Here is s/t tricky - //To avoid writing of Wrapping Functions to offer a Service from a Class - //We save a Normal Proc or a Method of a Class - Case isClass: boolean of - False: (Proc: TUS_Service); //Proc that will be called on Event - True: (ProcOfClass: TUS_Service_of_Object); - end; - - TServiceManager = class - private - //Managing Service List - FirstService: PServiceInfo; - LastService: PServiceInfo; - - //Some Speed improvement by caching the last 4 called Services - //Most of the time a Service is called multiple times - ServiceCache: Array[0..3] of PServiceInfo; - NextCacheItem: Byte; - - //Next Service added gets this Handle: - NextHandle: THandle; - public - Constructor Create; - - Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle; - Function DelService(const hService: THandle): integer; - - Function CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; - - Function NametoHash(const ServiceName: TServiceName): Integer; - Function ServiceExists(const ServiceName: PChar): Integer; - end; - -var - ServiceManager: TServiceManager; - -implementation -uses UCore; - -//------------ -// Create - Creates Class and Set Standard Values -//------------ -Constructor TServiceManager.Create; -begin - FirstService := nil; - LastService := nil; - - ServiceCache[0] := nil; - ServiceCache[1] := nil; - ServiceCache[2] := nil; - ServiceCache[3] := nil; - - NextCacheItem := 0; - - NextHandle := 1; - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Succesful created!'); - {$ENDIF} -end; - -//------------ -// Function Creates a new Service and Returns the Services Handle, -// 0 on Failure. (Name already exists) -//------------ -Function TServiceManager.AddService(const ServiceName: PChar; const Proc: TUS_Service; const ProcofClass: TUS_Service_of_Object): THandle; -var - Cur: PServiceInfo; -begin - Result := 0; - - If (@Proc <> nil) or (@ProcOfClass <> nil) then - begin - If (ServiceExists(ServiceName) = 0) then - begin //There is a Proc and the Service does not already exist - //Ok Add it! - - //Get Memory - GetMem(Cur, SizeOf(TServiceInfo)); - - //Fill it with Data - Cur.Next := nil; - - If (@Proc = nil) then - begin //Use the ProcofClass Method - Cur.isClass := True; - Cur.ProcOfClass := ProcofClass; - end - else //Use the normal Proc - begin - Cur.isClass := False; - Cur.Proc := Proc; - end; - - Cur.Self := NextHandle; - //Zero Name - Cur.Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; - Cur.Name := String(ServiceName); - Cur.Hash := NametoHash(Cur.Name); - - //Add Owner to Service - Cur.Owner := Core.CurExecuted; - - //Add Service to the List - If (FirstService = nil) then - FirstService := Cur; - - If (LastService <> nil) then - LastService.Next := Cur; - - LastService := Cur; - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); - {$ENDIF} - - //Inc Next Handle - Inc(NextHandle); - end - {$IFDEF DEBUG} - else WriteLn('ServiceManager: Try to readd Service: ' + ServiceName); - {$ENDIF} - end; -end; - -//------------ -// Function Destroys a Service, 0 on success, not 0 on Failure -//------------ -Function TServiceManager.DelService(const hService: THandle): integer; -var - Last, Cur: PServiceInfo; - I: Integer; -begin - Result := -1; - - Last := nil; - Cur := FirstService; - - //Search for Service to Delete - While (Cur <> nil) do - begin - If (Cur.Self = hService) then - begin //Found Service => Delete it - - //Delete from List - If (Last = nil) then //Found first Service - FirstService := Cur.Next - Else //Service behind the first - Last.Next := Cur.Next; - - //IF this is the LastService, correct LastService - If (Cur = LastService) then - LastService := Last; - - //Search for Service in Cache and delete it if found - For I := 0 to High(ServiceCache) do - If (ServiceCache[I] = Cur) then - begin - ServiceCache[I] := nil; - end; - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Removed Service succesful: ' + Cur.Name); - {$ENDIF} - - //Free Memory - Freemem(Cur, SizeOf(TServiceInfo)); - - //Break the Loop - Break; - end; - - //Go to Next Service - Last := Cur; - Cur := Cur.Next; - end; -end; - -//------------ -// Function Calls a Services Proc -// Returns Services Return Value or SERVICE_NOT_FOUND on Failure -//------------ -Function TServiceManager.CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; -var - SExists: Integer; - Service: PServiceInfo; - CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute -begin - Result := SERVICE_NOT_FOUND; - SExists := ServiceExists(ServiceName); - If (SExists <> 0) then - begin - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - Service := Pointer(SExists); - - If (Service.isClass) then - //Use Proc of Class - Result := Service.ProcOfClass(wParam, lParam) - Else - //Use normal Proc - Result := Service.Proc(wParam, lParam); - - //Restore CurExecuted - Core.CurExecuted := CurExecutedBackup; - end; - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); - {$ENDIF} -end; - -//------------ -// Generates the Hash for the given Name -//------------ -Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; -asm - { CL: Counter; EAX: Result; EDX: Current Memory Address } - Mov CL, 14 {Init Counter, Fold 14 Times to became 4 Bytes out of 60} - - Mov EDX, ServiceName {Save Address of String that should be "Hashed"} - - Mov EAX, [EDX] - - @FoldLoop: ADD EDX, 4 {jump 4 Byte(32 Bit) to the next tile } - ADD EAX, [EDX] {Add the Value of the next 4 Byte of the String to the Hash} - - LOOP @FoldLoop {Fold again if there are Chars Left} -end; - - -//------------ -// Function Returns Non Zero if a Service with the given Name Exists, otherwise 0 -//------------ -Function TServiceManager.ServiceExists(const ServiceName: PChar): Integer; -var - Name: TServiceName; - Hash: Integer; - Cur: PServiceInfo; - I: Byte; -begin - Result := 0; - // to-do : Write a Metbod (in ASM) to Zero and Add in one turn (faster then this dirty hack ;) - //Zero Name: - Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; - //Add Service Name - Name := String(ServiceName); - Hash := NametoHash(Name); - - //First of all Look for the Service in Cache - For I := 0 to High(ServiceCache) do - begin - If (ServiceCache[I] <> nil) AND (ServiceCache[I].Hash = Hash) then - begin - If (ServiceCache[I].Name = Name) then - begin //Found Service in Cache - Result := Integer(ServiceCache[I]); - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Found Service in Cache: ''' + ServiceName + ''''); - {$ENDIF} - - Break; - end; - end; - end; - - If (Result = 0) then - begin - Cur := FirstService; - While (Cur <> nil) do - begin - If (Cur.Hash = Hash) then - begin - If (Cur.Name = Name) then - begin //Found the Service - Result := Integer(Cur); - - {$IFDEF DEBUG} - WriteLn('ServiceManager: Found Service in List: ''' + ServiceName + ''''); - {$ENDIF} - - //Add to Cache - ServiceCache[NextCacheItem] := Cur; - NextCacheItem := (NextCacheItem + 1) AND 3; - Break; - end; - end; - - Cur := Cur.Next; - end; - end; -end; - -end. \ No newline at end of file +unit UServices; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses uPluginDefs, + SysUtils; +{********************* + TServiceManager + Class for saving, managing and calling of Services. + Saves all Services and their Procs +*********************} + +type + TServiceName = String[60]; + PServiceInfo = ^TServiceInfo; + TServiceInfo = record + Self: THandle; //Handle of this Service + Hash: Integer; //4 Bit Hash of the Services Name + Name: TServiceName; //Name of this Service + + Owner: Integer; //If < 0 [-(DLLMan Pluginindex + 1)]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1] + + Next: PServiceInfo; //Pointer to the Next Service in teh list + + //Here is s/t tricky + //To avoid writing of Wrapping Functions to offer a Service from a Class + //We save a Normal Proc or a Method of a Class + Case isClass: boolean of + False: (Proc: TUS_Service); //Proc that will be called on Event + True: (ProcOfClass: TUS_Service_of_Object); + end; + + TServiceManager = class + private + //Managing Service List + FirstService: PServiceInfo; + LastService: PServiceInfo; + + //Some Speed improvement by caching the last 4 called Services + //Most of the time a Service is called multiple times + ServiceCache: Array[0..3] of PServiceInfo; + NextCacheItem: Byte; + + //Next Service added gets this Handle: + NextHandle: THandle; + public + Constructor Create; + + Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle; + Function DelService(const hService: THandle): integer; + + Function CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; + + Function NametoHash(const ServiceName: TServiceName): Integer; + Function ServiceExists(const ServiceName: PChar): Integer; + end; + +var + ServiceManager: TServiceManager; + +implementation +uses UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +Constructor TServiceManager.Create; +begin + FirstService := nil; + LastService := nil; + + ServiceCache[0] := nil; + ServiceCache[1] := nil; + ServiceCache[2] := nil; + ServiceCache[3] := nil; + + NextCacheItem := 0; + + NextHandle := 1; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Succesful created!'); + {$ENDIF} +end; + +//------------ +// Function Creates a new Service and Returns the Services Handle, +// 0 on Failure. (Name already exists) +//------------ +Function TServiceManager.AddService(const ServiceName: PChar; const Proc: TUS_Service; const ProcofClass: TUS_Service_of_Object): THandle; +var + Cur: PServiceInfo; +begin + Result := 0; + + If (@Proc <> nil) or (@ProcOfClass <> nil) then + begin + If (ServiceExists(ServiceName) = 0) then + begin //There is a Proc and the Service does not already exist + //Ok Add it! + + //Get Memory + GetMem(Cur, SizeOf(TServiceInfo)); + + //Fill it with Data + Cur.Next := nil; + + If (@Proc = nil) then + begin //Use the ProcofClass Method + Cur.isClass := True; + Cur.ProcOfClass := ProcofClass; + end + else //Use the normal Proc + begin + Cur.isClass := False; + Cur.Proc := Proc; + end; + + Cur.Self := NextHandle; + //Zero Name + Cur.Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; + Cur.Name := String(ServiceName); + Cur.Hash := NametoHash(Cur.Name); + + //Add Owner to Service + Cur.Owner := Core.CurExecuted; + + //Add Service to the List + If (FirstService = nil) then + FirstService := Cur; + + If (LastService <> nil) then + LastService.Next := Cur; + + LastService := Cur; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); + {$ENDIF} + + //Inc Next Handle + Inc(NextHandle); + end + {$IFDEF DEBUG} + else WriteLn('ServiceManager: Try to readd Service: ' + ServiceName); + {$ENDIF} + end; +end; + +//------------ +// Function Destroys a Service, 0 on success, not 0 on Failure +//------------ +Function TServiceManager.DelService(const hService: THandle): integer; +var + Last, Cur: PServiceInfo; + I: Integer; +begin + Result := -1; + + Last := nil; + Cur := FirstService; + + //Search for Service to Delete + While (Cur <> nil) do + begin + If (Cur.Self = hService) then + begin //Found Service => Delete it + + //Delete from List + If (Last = nil) then //Found first Service + FirstService := Cur.Next + Else //Service behind the first + Last.Next := Cur.Next; + + //IF this is the LastService, correct LastService + If (Cur = LastService) then + LastService := Last; + + //Search for Service in Cache and delete it if found + For I := 0 to High(ServiceCache) do + If (ServiceCache[I] = Cur) then + begin + ServiceCache[I] := nil; + end; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Removed Service succesful: ' + Cur.Name); + {$ENDIF} + + //Free Memory + Freemem(Cur, SizeOf(TServiceInfo)); + + //Break the Loop + Break; + end; + + //Go to Next Service + Last := Cur; + Cur := Cur.Next; + end; +end; + +//------------ +// Function Calls a Services Proc +// Returns Services Return Value or SERVICE_NOT_FOUND on Failure +//------------ +Function TServiceManager.CallService(const ServiceName: PChar; const wParam, lParam: dWord): integer; +var + SExists: Integer; + Service: PServiceInfo; + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute +begin + Result := SERVICE_NOT_FOUND; + SExists := ServiceExists(ServiceName); + If (SExists <> 0) then + begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + Service := Pointer(SExists); + + If (Service.isClass) then + //Use Proc of Class + Result := Service.ProcOfClass(wParam, lParam) + Else + //Use normal Proc + Result := Service.Proc(wParam, lParam); + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); + {$ENDIF} +end; + +//------------ +// Generates the Hash for the given Name +//------------ +Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; +asm + { CL: Counter; EAX: Result; EDX: Current Memory Address } + Mov CL, 14 {Init Counter, Fold 14 Times to became 4 Bytes out of 60} + + Mov EDX, ServiceName {Save Address of String that should be "Hashed"} + + Mov EAX, [EDX] + + @FoldLoop: ADD EDX, 4 {jump 4 Byte(32 Bit) to the next tile } + ADD EAX, [EDX] {Add the Value of the next 4 Byte of the String to the Hash} + + LOOP @FoldLoop {Fold again if there are Chars Left} +end; + + +//------------ +// Function Returns Non Zero if a Service with the given Name Exists, otherwise 0 +//------------ +Function TServiceManager.ServiceExists(const ServiceName: PChar): Integer; +var + Name: TServiceName; + Hash: Integer; + Cur: PServiceInfo; + I: Byte; +begin + Result := 0; + // to-do : Write a Metbod (in ASM) to Zero and Add in one turn (faster then this dirty hack ;) + //Zero Name: + Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; + //Add Service Name + Name := String(ServiceName); + Hash := NametoHash(Name); + + //First of all Look for the Service in Cache + For I := 0 to High(ServiceCache) do + begin + If (ServiceCache[I] <> nil) AND (ServiceCache[I].Hash = Hash) then + begin + If (ServiceCache[I].Name = Name) then + begin //Found Service in Cache + Result := Integer(ServiceCache[I]); + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Found Service in Cache: ''' + ServiceName + ''''); + {$ENDIF} + + Break; + end; + end; + end; + + If (Result = 0) then + begin + Cur := FirstService; + While (Cur <> nil) do + begin + If (Cur.Hash = Hash) then + begin + If (Cur.Name = Name) then + begin //Found the Service + Result := Integer(Cur); + + {$IFDEF DEBUG} + WriteLn('ServiceManager: Found Service in List: ''' + ServiceName + ''''); + {$ENDIF} + + //Add to Cache + ServiceCache[NextCacheItem] := Cur; + NextCacheItem := (NextCacheItem + 1) AND 3; + Break; + end; + end; + + Cur := Cur.Next; + end; + end; +end; + +end. diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas index d5256dc9..c7213180 100644 --- a/Game/Code/Classes/USingScores.pas +++ b/Game/Code/Classes/USingScores.pas @@ -1,986 +1,990 @@ -unit USingScores; - -interface - -{$I switches.inc} - -uses UThemes, - OpenGl12, - UTexture; - -////////////////////////////////////////////////////////////// -// ATTENTION: // -// Enabled Flag does not Work atm. This should cause Popups // -// Not to Move and Scores to stay until Renenabling. // -// To use e.g. in Pause Mode // -// Also InVisible Flag causes Attributes not to change. // -// This should be fixed after next Draw when Visible = True,// -// but not testet yet // -////////////////////////////////////////////////////////////// - -//Some Constances containing Options that could change by time -const - MaxPlayers = 6; //Maximum of Players that could be added - MaxPositions = 6; //Maximum of Score Positions that could be added - -type - //----------- - // TScorePlayer - Record Containing Information about a Players Score - //----------- - TScorePlayer = record - Position: Byte; //Index of the Position where the Player should be Drawn - Enabled: Boolean; //Is the Score Display Enabled - Visible: Boolean; //Is the Score Display Visible - Score: Word; //Current Score of the Player - ScoreDisplayed: Word; //Score cur. Displayed(for counting up) - ScoreBG: TTexture;//Texture of the Players Scores BG - Color: TRGB; //Teh Players Color - RBPos: Real; //Cur. Percentille of the Rating Bar - RBTarget: Real; //Target Position of Rating Bar - RBVisible:Boolean; //Is Rating bar Drawn - end; - aScorePlayer = array[0..MaxPlayers-1] of TScorePlayer; - - //----------- - // TScorePosition - Record Containing Information about a Score Position, that can be used - //----------- - PScorePosition = ^TScorePosition; - TScorePosition = record - //The Position is Used for Which Playercount - PlayerCount: Byte; - // 1 - One Player per Screen - // 2 - 2 Players per Screen - // 4 - 3 Players per Screen - // 6 would be 2 and 3 Players per Screen - - BGX: Real; //X Position of the Score BG - BGY: Real; //Y Position of the Score BG - BGW: Real; //Width of the Score BG - BGH: Real; //Height of the Score BG - - RBX: Real; //X Position of the Rating Bar - RBY: Real; //Y Position of the Rating Bar - RBW: Real; //Width of the Rating Bar - RBH: Real; //Height of the Rating Bar - - TextX: Real; //X Position of the Score Text - TextY: Real; //Y Position of the Score Text - TextFont: Byte; //Font of the Score Text - TextSize: Byte; //Size of the Score Text - - PUW: Real; //Width of the LineBonus Popup - PUH: Real; //Height of the LineBonus Popup - PUFont: Byte; //Font for the PopUps - PUFontSize: Byte; //FontSize for the PopUps - PUStartX: Real; //X Start Position of the LineBonus Popup - PUStartY: Real; //Y Start Position of the LineBonus Popup - PUTargetX: Real; //X Target Position of the LineBonus Popup - PUTargetY: Real; //Y Target Position of the LineBonus Popup - end; - aScorePosition = array[0..MaxPositions-1] of TScorePosition; - - //----------- - // TScorePopUp - Record Containing Information about a LineBonus Popup - // List, Next Item is Saved in Next attribute - //----------- - PScorePopUp = ^TScorePopUp; - TScorePopUp = record - Player: Byte; //Index of the PopUps Player - TimeStamp: Cardinal; //Timestamp of Popups Spawn - Rating: Byte; //0 to 8, Type of Rating (Cool, bad, etc.) - ScoreGiven:Word; //Score that has already been given to the Player - ScoreDiff: Word; //Difference Between Cur Score at Spawn and Old Score - Next: PScorePopUp; //Next Item in List - end; - aScorePopUp = array of TScorePopUp; - - //----------- - // TSingScores - Class containing Scores Positions and Drawing Scores, Rating Bar + Popups - //----------- - TSingScores = class - private - Positions: aScorePosition; - aPlayers: aScorePlayer; - oPositionCount: Byte; - oPlayerCount: Byte; - - //Saves the First and Last Popup of the List - FirstPopUp: PScorePopUp; - LastPopUp: PScorePopUp; - - //Procedure Draws a Popup by Pointer - Procedure DrawPopUp(const PopUp: PScorePopUp); - - //Procedure Draws a Score by Playerindex - Procedure DrawScore(const Index: Integer); - - //Procedure Draws the RatingBar by Playerindex - Procedure DrawRatingBar(const Index: Integer); - - //Procedure Removes a PopUp w/o destroying the List - Procedure KillPopUp(const last, cur: PScorePopUp); - public - Settings: record //Record containing some Displaying Options - Phase1Time: Real; //time for Phase 1 to complete (in msecs) - //The Plop Up of the PopUp - Phase2Time: Real; //time for Phase 2 to complete (in msecs) - //The Moving (mainly Upwards) of the Popup - Phase3Time: Real; //time for Phase 3 to complete (in msecs) - //The Fade out and Score adding - - PopUpTex: Array [0..8] of TTexture; //Textures for every Popup Rating - - RatingBar_BG_Tex: TTexture; //Rating Bar Texs - RatingBar_FG_Tex: TTexture; - RatingBar_Bar_Tex: TTexture; - - end; - - Visible: Boolean; //Visibility of all Scores - Enabled: Boolean; //Scores are changed, PopUps are Moved etc. - RBVisible: Boolean; //Visibility of all Rating Bars - - //Propertys for Reading Position and Playercount - Property PositionCount: Byte read oPositionCount; - Property PlayerCount: Byte read oPlayerCount; - Property Players: aScorePlayer read aPlayers; - - //Constructor just sets some standard Settings - Constructor Create; - - //Procedure Adds a Position to Array and Increases Position Count - Procedure AddPosition(const pPosition: PScorePosition); - - //Procedure Adds a Player to Array and Increases Player Count - Procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True); - - //Change a Players Visibility, Enable - Procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); - Procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); - - //Procedure Deletes all Player Information - Procedure ClearPlayers; - - //Procedure Deletes Positions and Playerinformation - Procedure Clear; - - //Procedure Loads some Settings and the Positions from Theme - Procedure LoadfromTheme; - - //Procedure has to be called after Positions and Players have been added, before first call of Draw - //It gives every Player a Score Position - Procedure Init; - - //Spawns a new Line Bonus PopUp for the Player - Procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); - - //Removes all PopUps from Mem - Procedure KillAllPopUps; - - //Procedure Draws Scores and Linebonus PopUps - Procedure Draw; - end; - - -implementation - -uses SDL, - SysUtils, - ULog, - UGraphic, - TextGL; - -//----------- -//Constructor just sets some standard Settings -//----------- -Constructor TSingScores.Create; -begin - //Clear PopupList Pointers - FirstPopUp := nil; - LastPopUp := nil; - - //Clear Variables - Visible := True; - Enabled := True; - RBVisible := True; - - //Clear Position Index - oPositionCount := 0; - oPlayerCount := 0; - - Settings.Phase1Time := 1000; - Settings.Phase2Time := 2000; - Settings.Phase3Time := 2000; - - Settings.PopUpTex[0].TexNum := High(gluInt); - Settings.PopUpTex[1].TexNum := High(gluInt); - Settings.PopUpTex[2].TexNum := High(gluInt); - Settings.PopUpTex[3].TexNum := High(gluInt); - Settings.PopUpTex[4].TexNum := High(gluInt); - Settings.PopUpTex[5].TexNum := High(gluInt); - Settings.PopUpTex[6].TexNum := High(gluInt); - Settings.PopUpTex[7].TexNum := High(gluInt); - Settings.PopUpTex[8].TexNum := High(gluInt); - - Settings.RatingBar_BG_Tex.TexNum := High(gluInt); - Settings.RatingBar_FG_Tex.TexNum := High(gluInt); - Settings.RatingBar_Bar_Tex.TexNum := High(gluInt); -end; - -//----------- -//Procedure Adds a Position to Array and Increases Position Count -//----------- -Procedure TSingScores.AddPosition(const pPosition: PScorePosition); -begin - if (PositionCount < MaxPositions) then - begin - Positions[PositionCount] := pPosition^; - - Inc(oPositionCount); - end; -end; - -//----------- -//Procedure Adds a Player to Array and Increases Player Count -//----------- -Procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word; const Enabled: Boolean; const Visible: Boolean); -begin - if (PlayerCount < MaxPlayers) then - begin - aPlayers[PlayerCount].Position := High(byte); - aPlayers[PlayerCount].Enabled := Enabled; - aPlayers[PlayerCount].Visible := Visible; - aPlayers[PlayerCount].Score := Score; - aPlayers[PlayerCount].ScoreDisplayed := Score; - aPlayers[PlayerCount].ScoreBG := ScoreBG; - aPlayers[PlayerCount].Color := Color; - aPlayers[PlayerCount].RBPos := 0.5; - aPlayers[PlayerCount].RBTarget := 0.5; - aPlayers[PlayerCount].RBVisible := True; - - Inc(oPlayerCount); - end; -end; - -//----------- -//Change a Players Visibility -//----------- -Procedure TSingScores.ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); -begin - if (Index < MaxPlayers) then - aPlayers[Index].Visible := pVisible; -end; - -//----------- -//Change Player Enabled -//----------- -Procedure TSingScores.ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); -begin - if (Index < MaxPlayers) then - aPlayers[Index].Enabled := pEnabled; -end; - -//----------- -//Procedure Deletes all Player Information -//----------- -Procedure TSingScores.ClearPlayers; -begin - KillAllPopUps; - oPlayerCount := 0; -end; - -//----------- -//Procedure Deletes Positions and Playerinformation -//----------- -Procedure TSingScores.Clear; -begin - KillAllPopUps; - oPlayerCount := 0; - oPositionCount := 0; -end; - -//----------- -//Procedure Loads some Settings and the Positions from Theme -//----------- -Procedure TSingScores.LoadfromTheme; -var I: Integer; - Procedure AddbyStatics(const PC: Byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText); - var nPosition: TScorePosition; - begin - nPosition.PlayerCount := PC; //Only for one Player Playing - - nPosition.BGX := ScoreStatic.X; - nPosition.BGY := ScoreStatic.Y; - nPosition.BGW := ScoreStatic.W; - nPosition.BGH := ScoreStatic.H; - - nPosition.TextX := ScoreText.X; - nPosition.TextY := ScoreText.Y; - nPosition.TextFont := ScoreText.Font; - nPosition.TextSize := ScoreText.Size; - - nPosition.RBX := SingBarStatic.X; - nPosition.RBY := SingBarStatic.Y; - nPosition.RBW := SingBarStatic.W; - nPosition.RBH := SingBarStatic.H; - - nPosition.PUW := nPosition.BGW; - nPosition.PUH := nPosition.BGH; - - nPosition.PUFont := 2; - nPosition.PUFontSize := 6; - - nPosition.PUStartX := nPosition.BGX; - nPosition.PUStartY := nPosition.TextY + 65; - - nPosition.PUTargetX := nPosition.BGX; - nPosition.PUTargetY := nPosition.TextY; - - AddPosition(@nPosition); - end; -begin - Clear; - - //Set Textures - //Popup Tex - For I := 0 to 8 do - Settings.PopUpTex[I] := Tex_SingLineBonusBack[I]; - - //Rating Bar Tex - Settings.RatingBar_BG_Tex := Tex_SingBar_Back; - Settings.RatingBar_FG_Tex := Tex_SingBar_Front; - Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar; - - //Load Positions from Theme - - // Player1: - AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score); - AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore); - AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore); - - // Player2: - AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore); - AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore); - - // Player3: - AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RScoreBG, Theme.Sing.TextP3RScore); -end; - -//----------- -//Spawns a new Line Bonus PopUp for the Player -//----------- -Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); -var Cur: PScorePopUp; -begin - if (PlayerIndex < PlayerCount) then - begin - //Get Memory and Add Data - GetMem(Cur, SizeOf(TScorePopUp)); - - Cur.Player := PlayerIndex; - Cur.TimeStamp := SDL_GetTicks; - Cur.Rating := Rating; - Cur.ScoreGiven:= 0; - If (Players[PlayerIndex].Score < Score) then - begin - Cur.ScoreDiff := Score - Players[PlayerIndex].Score; - aPlayers[PlayerIndex].Score := Score; - end - else - Cur.ScoreDiff := 0; - Cur.Next := nil; - - //Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff)); - - //Add it to the Chain - if (FirstPopUp = nil) then - //the first PopUp in the List - FirstPopUp := Cur - else - //second or earlier popup - LastPopUp.Next := Cur; - - //Set new Popup to Last PopUp in the List - LastPopUp := Cur; - end - else - Log.LogError('TSingScores: Try to add PopUp for not existing player'); -end; - -//----------- -// Removes a PopUp w/o destroying the List -//----------- -Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); -var - lTempA , - lTempB : real; -begin - //Give Player the Last Points that missing till now - aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; - - //Change Bars Position - - // TODO : JB_Lazarus - Exception=Invalid floating point operation - // AT THIS LINE ! - - {$IFDEF LAZARUS} -(* - writeln( 'USINGSCORES-aPlayers[Cur.Player].RBTarget : ' + floattostr( aPlayers[Cur.Player].RBTarget ) ); - writeln( 'USINGSCORES-(Cur.ScoreDiff - Cur.ScoreGiven) : ' + floattostr( (Cur.ScoreDiff - Cur.ScoreGiven) ) ); - writeln( 'USINGSCORES-Cur.ScoreDiff : ' + floattostr( Cur.ScoreDiff ) ); - writeln( 'USINGSCORES-(Cur.Rating / 20 - 0.26) : ' + floattostr( (Cur.Rating / 20 - 0.26) ) ); - writeln( '' ); -*) - {$ENDIF} - - lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); - lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); - - {$IFDEF LAZARUS} -(* - writeln( 'USINGSCORES-lTempA : ' + floattostr( lTempA ) ); - writeln( 'USINGSCORES-lTempB : ' + floattostr( lTempB ) ); - writeln( '----------------------------------------------------------' ); -*) - {$ENDIF} - - if ( lTempA > 0 ) AND - ( lTempB > 0 ) THEN - begin - aPlayers[Cur.Player].RBTarget := lTempA / lTempB; - end; - - If (aPlayers[Cur.Player].RBTarget > 1) then - aPlayers[Cur.Player].RBTarget := 1 - else - If (aPlayers[Cur.Player].RBTarget < 0) then - aPlayers[Cur.Player].RBTarget := 0; - - //If this is the First PopUp => Make Next PopUp the First - If (Cur = FirstPopUp) then - FirstPopUp := Cur.Next - //Else => Remove Curent Popup from Chain - else - Last.Next := Cur.Next; - - //If this is the Last PopUp, Make PopUp before the Last - If (Cur = LastPopUp) then - LastPopUp := Last; - - //Free the Memory - FreeMem(Cur, SizeOf(TScorePopUp)); -end; - -//----------- -//Removes all PopUps from Mem -//----------- -Procedure TSingScores.KillAllPopUps; -var - Cur: PScorePopUp; - Last: PScorePopUp; -begin - Cur := FirstPopUp; - - //Remove all PopUps: - While (Cur <> nil) do - begin - Last := Cur; - Cur := Cur.Next; - FreeMem(Last, SizeOf(TScorePopUp)); - end; - - FirstPopUp := nil; - LastPopUp := nil; -end; - -//----------- -//Init - has to be called after Positions and Players have been added, before first call of Draw -//It gives every Player a Score Position -//----------- -Procedure TSingScores.Init; -var - PlC: Array [0..1] of Byte; //Playercount First Screen and Second Screen - I, J: Integer; - MaxPlayersperScreen: Byte; - CurPlayer: Byte; - - Function GetPositionCountbyPlayerCount(bPlayerCount: Byte): Byte; - var I: Integer; - begin - Result := 0; - bPlayerCount := 1 shl (bPlayerCount - 1); - - For I := 0 to PositionCount-1 do - begin - If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then - Inc(Result); - end; - end; - - Function GetPositionbyPlayernum(bPlayerCount, bPlayer: Byte): Byte; - var I: Integer; - begin - bPlayerCount := 1 shl (bPlayerCount - 1); - Result := High(Byte); - - For I := 0 to PositionCount-1 do - begin - If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then - begin - If (bPlayer = 0) then - begin - Result := I; - Break; - end - else - Dec(bPlayer); - end; - end; - end; - -begin - - For I := 1 to 6 do - begin - //If there are enough Positions -> Write to MaxPlayers - If (GetPositionCountbyPlayerCount(I) = I) then - MaxPlayersperScreen := I - else - Break; - end; - - - //Split Players to both Screen or Display on One Screen - if (Screens = 2) and (MaxPlayersperScreen < PlayerCount) then - begin - PlC[0] := PlayerCount div 2 + PlayerCount mod 2; - PlC[1] := PlayerCount div 2; - end - else - begin - PlC[0] := PlayerCount; - PlC[1] := 0; - end; - - - //Check if there are enough Positions for all Players - For I := 0 to Screens - 1 do - begin - if (PlC[I] > MaxPlayersperScreen) then - begin - PlC[I] := MaxPlayersperScreen; - Log.LogError('More Players than available Positions, TSingScores'); - end; - end; - - CurPlayer := 0; - //Give every Player a Position - For I := 0 to Screens - 1 do - For J := 0 to PlC[I]-1 do - begin - aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) OR (I shl 7); - //Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position)); - Inc(CurPlayer); - end; -end; - -//----------- -//Procedure Draws Scores and Linebonus PopUps -//----------- -Procedure TSingScores.Draw; -var - I: Integer; - CurTime: Cardinal; - CurPopUp, LastPopUp: PScorePopUp; -begin - CurTime := SDL_GetTicks; - - If Visible then - begin - //Draw Popups - LastPopUp := nil; - CurPopUp := FirstPopUp; - - While (CurPopUp <> nil) do - begin - if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then - begin - KillPopUp(LastPopUp, CurPopUp); - if (LastPopUp = nil) then - CurPopUp := FirstPopUp - else - CurPopUp := LastPopUp.Next; - end - else - begin - DrawPopUp(CurPopUp); - LastPopUp := CurPopUp; - CurPopUp := LastPopUp.Next; - end; - end; - - - IF (RBVisible) then - //Draw Players w/ Rating Bar - For I := 0 to PlayerCount-1 do - begin - DrawScore(I); - DrawRatingBar(I); - end - else - //Draw Players w/o Rating Bar - For I := 0 to PlayerCount-1 do - begin - DrawScore(I); - end; - - end; //eo Visible -end; - -//----------- -//Procedure Draws a Popup by Pointer -//----------- -Procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp); -var - Progress: Real; - CurTime: Cardinal; - X, Y, W, H, Alpha: Real; - FontSize: Byte; - TimeDiff: Cardinal; - PIndex: Byte; - TextLen: Real; - ScoretoAdd: Word; - PosDiff: Real; -begin - if (PopUp <> nil) then - begin - //Only Draw if Player has a Position - PIndex := Players[PopUp.Player].Position; - If PIndex <> high(byte) then - begin - //Only Draw if Player is on Cur Screen - If ((Players[PopUp.Player].Position AND 128) = 0) = (ScreenAct = 1) then - begin - CurTime := SDL_GetTicks; - If Not (Enabled AND Players[PopUp.Player].Enabled) then - //Increase Timestamp with TIem where there is no Movement ... - begin - //Inc(PopUp.TimeStamp, LastRender); - end; - TimeDiff := CurTime - PopUp.TimeStamp; - - //Get Position of PopUp - PIndex := PIndex AND 127; - - - //Check for Phase ... - If (TimeDiff <= Settings.Phase1Time) then - begin - //Phase 1 - The Ploping up - Progress := TimeDiff / Settings.Phase1Time; - - - W := Positions[PIndex].PUW * Sin(Progress/2*Pi); - H := Positions[PIndex].PUH * Sin(Progress/2*Pi); - - X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2; - Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; - - FontSize := Round(Progress * Positions[PIndex].PUFontSize); - Alpha := 1; - end - - Else If (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then - begin - //Phase 2 - The Moving - Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time; - - W := Positions[PIndex].PUW; - H := Positions[PIndex].PUH; - - PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; - If PosDiff > 0 then - PosDiff := PosDiff + W; - X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress); - - PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; - If PosDiff < 0 then - PosDiff := PosDiff + Positions[PIndex].BGH; - Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); - - FontSize := Positions[PIndex].PUFontSize; - Alpha := 1 - 0.3 * Progress; - end - - else - begin - //Phase 3 - The Fading out + Score adding - Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time; - - If (PopUp.Rating > 0) then - begin - //Add Scores if Player Enabled - If (Enabled AND Players[PopUp.Player].Enabled) then - begin - ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven; - Inc(PopUp.ScoreGiven, ScoreToAdd); - aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; - - //Change Bars Position - aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26); - If (aPlayers[PopUp.Player].RBTarget > 1) then - aPlayers[PopUp.Player].RBTarget := 1 - else If (aPlayers[PopUp.Player].RBTarget < 0) then - aPlayers[PopUp.Player].RBTarget := 0; - end; - - //Set Positions etc. - Alpha := 0.7 - 0.7 * Progress; - - W := Positions[PIndex].PUW; - H := Positions[PIndex].PUH; - - PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; - If (PosDiff > 0) then - PosDiff := W - else - PosDiff := 0; - X := Positions[PIndex].PUTargetX + PosDiff * Progress; - - PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; - If (PosDiff < 0) then - PosDiff := -Positions[PIndex].BGH - else - PosDiff := 0; - Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress); - - FontSize := Positions[PIndex].PUFontSize; - end - else - begin - //Here the Effect that Should be shown if a PopUp without Score is Drawn - //And or Spawn with the GraphicObjects etc. - //Some Work for Blindy to do :P - - //ATM: Just Let it Slide in the Scores just like the Normal PopUp - Alpha := 0; - end; - end; - - //Draw PopUp - - if (Alpha > 0) AND (Players[PopUp.Player].Visible) then - begin - //Draw BG: - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - glColor4f(1,1,1, Alpha); - glBindTexture(GL_TEXTURE_2D, Settings.PopUpTex[PopUp.Rating].TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X, Y + H); - glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X + W, Y + H); - glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, 0); glVertex2f(X + W, Y); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - //Set FontStyle and Size - SetFontStyle(Positions[PIndex].PUFont); - SetFontItalic(False); - SetFontSize(FontSize); - - //Draw Text - TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); - - //Color and Pos - SetFontPos (X + (W - TextLen) / 2, Y + 12); - glColor4f(1, 1, 1, Alpha); - - //Draw - glPrint(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); - end; //eo Alpha check - end; //eo Right Screen - end; //eo Player has Position - end - else - Log.LogError('TSingScores: Try to Draw a not existing PopUp'); -end; - -//----------- -//Procedure Draws a Score by Playerindex -//----------- -Procedure TSingScores.DrawScore(const Index: Integer); -var - Position: PScorePosition; - ScoreStr: String; -begin - //Only Draw if Player has a Position - If Players[Index].Position <> high(byte) then - begin - //Only Draw if Player is on Cur Screen - If (((Players[Index].Position AND 128) = 0) = (ScreenAct = 1)) AND Players[Index].Visible then - begin - Position := @Positions[Players[Index].Position and 127]; - - //Draw ScoreBG - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - glColor4f(1,1,1, 1); - glBindTexture(GL_TEXTURE_2D, Players[Index].ScoreBG.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Position.BGX, Position.BGY); - glTexCoord2f(0, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX, Position.BGY + Position.BGH); - glTexCoord2f(Players[Index].ScoreBG.TexW, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX + Position.BGW, Position.BGY + Position.BGH); - glTexCoord2f(Players[Index].ScoreBG.TexW, 0); glVertex2f(Position.BGX + Position.BGW, Position.BGY); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - //Draw Score Text - SetFontStyle(Position.TextFont); - SetFontItalic(False); - SetFontSize(Position.TextSize); - SetFontPos(Position.TextX, Position.TextY); - - ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0'; - While (Length(ScoreStr) < 5) do - ScoreStr := '0' + ScoreStr; - - glPrint(PChar(ScoreStr)); - - end; //eo Right Screen - end; //eo Player has Position -end; - - -Procedure TSingScores.DrawRatingBar(const Index: Integer); -var - Position: PScorePosition; - R,G,B, Size: Real; - Diff: Real; -begin - //Only Draw if Player has a Position - If Players[Index].Position <> high(byte) then - begin - //Only Draw if Player is on Cur Screen - If ((Players[Index].Position AND 128) = 0) = (ScreenAct = 1) AND (Players[index].RBVisible AND Players[index].Visible) then - begin - Position := @Positions[Players[Index].Position and 127]; - - If (Enabled AND Players[Index].Enabled) then - begin - //Move Position if Enabled - Diff := Players[Index].RBTarget - Players[Index].RBPos; - If(Abs(Diff) < 0.02) then - aPlayers[Index].RBPos := aPlayers[Index].RBTarget - else - aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1; - end; - - //Get Colors for RatingBar - If Players[index].RBPos <=0.22 then - begin - R := 1; - G := 0; - B := 0; - end - Else If Players[index].RBPos <=0.42 then - begin - R := 1; - G := Players[index].RBPos*5; - B := 0; - end - Else If Players[index].RBPos <=0.57 then - begin - R := 1; - G := 1; - B := 0; - end - Else If Players[index].RBPos <=0.77 then - begin - R := 1-(Players[index].RBPos-0.57)*5; - G := 1; - B := 0; - end - else - begin - R := 0; - G := 1; - B := 0; - end; - - //Enable all glFuncs Needed - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - //Draw RatingBar BG - glColor4f(1, 1, 1, 0.8); - glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(Position.RBX, Position.RBY); - - glTexCoord2f(0, Settings.RatingBar_BG_Tex.TexH); - glVertex2f(Position.RBX, Position.RBY+Position.RBH); - - glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, Settings.RatingBar_BG_Tex.TexH); - glVertex2f(Position.RBX+Position.RBW, Position.RBY+Position.RBH); - - glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, 0); - glVertex2f(Position.RBX+Position.RBW, Position.RBY); - glEnd; - - //Draw Rating bar itself - Size := Position.RBX + Position.RBW * Players[Index].RBPos; - glColor4f(R, G, B, 1); - glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(Position.RBX, Position.RBY); - - glTexCoord2f(0, Settings.RatingBar_Bar_Tex.TexH); - glVertex2f(Position.RBX, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, Settings.RatingBar_Bar_Tex.TexH); - glVertex2f(Size, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, 0); - glVertex2f(Size, Position.RBY); - glEnd; - - //Draw Ratingbar FG (Teh thing with the 3 lines to get better readability) - glColor4f(1, 1, 1, 0.6); - glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(Position.RBX, Position.RBY); - - glTexCoord2f(0, Settings.RatingBar_FG_Tex.TexH); - glVertex2f(Position.RBX, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, Settings.RatingBar_FG_Tex.TexH); - glVertex2f(Position.RBX + Position.RBW, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, 0); - glVertex2f(Position.RBX + Position.RBW, Position.RBY); - glEnd; - - //Disable all Enabled glFuncs - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - end; //eo Right Screen - end; //eo Player has Position -end; - -end. +unit USingScores; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses UThemes, + OpenGl12, + UTexture; + +////////////////////////////////////////////////////////////// +// ATTENTION: // +// Enabled Flag does not Work atm. This should cause Popups // +// Not to Move and Scores to stay until Renenabling. // +// To use e.g. in Pause Mode // +// Also InVisible Flag causes Attributes not to change. // +// This should be fixed after next Draw when Visible = True,// +// but not testet yet // +////////////////////////////////////////////////////////////// + +//Some Constances containing Options that could change by time +const + MaxPlayers = 6; //Maximum of Players that could be added + MaxPositions = 6; //Maximum of Score Positions that could be added + +type + //----------- + // TScorePlayer - Record Containing Information about a Players Score + //----------- + TScorePlayer = record + Position: Byte; //Index of the Position where the Player should be Drawn + Enabled: Boolean; //Is the Score Display Enabled + Visible: Boolean; //Is the Score Display Visible + Score: Word; //Current Score of the Player + ScoreDisplayed: Word; //Score cur. Displayed(for counting up) + ScoreBG: TTexture;//Texture of the Players Scores BG + Color: TRGB; //Teh Players Color + RBPos: Real; //Cur. Percentille of the Rating Bar + RBTarget: Real; //Target Position of Rating Bar + RBVisible:Boolean; //Is Rating bar Drawn + end; + aScorePlayer = array[0..MaxPlayers-1] of TScorePlayer; + + //----------- + // TScorePosition - Record Containing Information about a Score Position, that can be used + //----------- + PScorePosition = ^TScorePosition; + TScorePosition = record + //The Position is Used for Which Playercount + PlayerCount: Byte; + // 1 - One Player per Screen + // 2 - 2 Players per Screen + // 4 - 3 Players per Screen + // 6 would be 2 and 3 Players per Screen + + BGX: Real; //X Position of the Score BG + BGY: Real; //Y Position of the Score BG + BGW: Real; //Width of the Score BG + BGH: Real; //Height of the Score BG + + RBX: Real; //X Position of the Rating Bar + RBY: Real; //Y Position of the Rating Bar + RBW: Real; //Width of the Rating Bar + RBH: Real; //Height of the Rating Bar + + TextX: Real; //X Position of the Score Text + TextY: Real; //Y Position of the Score Text + TextFont: Byte; //Font of the Score Text + TextSize: Byte; //Size of the Score Text + + PUW: Real; //Width of the LineBonus Popup + PUH: Real; //Height of the LineBonus Popup + PUFont: Byte; //Font for the PopUps + PUFontSize: Byte; //FontSize for the PopUps + PUStartX: Real; //X Start Position of the LineBonus Popup + PUStartY: Real; //Y Start Position of the LineBonus Popup + PUTargetX: Real; //X Target Position of the LineBonus Popup + PUTargetY: Real; //Y Target Position of the LineBonus Popup + end; + aScorePosition = array[0..MaxPositions-1] of TScorePosition; + + //----------- + // TScorePopUp - Record Containing Information about a LineBonus Popup + // List, Next Item is Saved in Next attribute + //----------- + PScorePopUp = ^TScorePopUp; + TScorePopUp = record + Player: Byte; //Index of the PopUps Player + TimeStamp: Cardinal; //Timestamp of Popups Spawn + Rating: Byte; //0 to 8, Type of Rating (Cool, bad, etc.) + ScoreGiven:Word; //Score that has already been given to the Player + ScoreDiff: Word; //Difference Between Cur Score at Spawn and Old Score + Next: PScorePopUp; //Next Item in List + end; + aScorePopUp = array of TScorePopUp; + + //----------- + // TSingScores - Class containing Scores Positions and Drawing Scores, Rating Bar + Popups + //----------- + TSingScores = class + private + Positions: aScorePosition; + aPlayers: aScorePlayer; + oPositionCount: Byte; + oPlayerCount: Byte; + + //Saves the First and Last Popup of the List + FirstPopUp: PScorePopUp; + LastPopUp: PScorePopUp; + + //Procedure Draws a Popup by Pointer + Procedure DrawPopUp(const PopUp: PScorePopUp); + + //Procedure Draws a Score by Playerindex + Procedure DrawScore(const Index: Integer); + + //Procedure Draws the RatingBar by Playerindex + Procedure DrawRatingBar(const Index: Integer); + + //Procedure Removes a PopUp w/o destroying the List + Procedure KillPopUp(const last, cur: PScorePopUp); + public + Settings: record //Record containing some Displaying Options + Phase1Time: Real; //time for Phase 1 to complete (in msecs) + //The Plop Up of the PopUp + Phase2Time: Real; //time for Phase 2 to complete (in msecs) + //The Moving (mainly Upwards) of the Popup + Phase3Time: Real; //time for Phase 3 to complete (in msecs) + //The Fade out and Score adding + + PopUpTex: Array [0..8] of TTexture; //Textures for every Popup Rating + + RatingBar_BG_Tex: TTexture; //Rating Bar Texs + RatingBar_FG_Tex: TTexture; + RatingBar_Bar_Tex: TTexture; + + end; + + Visible: Boolean; //Visibility of all Scores + Enabled: Boolean; //Scores are changed, PopUps are Moved etc. + RBVisible: Boolean; //Visibility of all Rating Bars + + //Propertys for Reading Position and Playercount + Property PositionCount: Byte read oPositionCount; + Property PlayerCount: Byte read oPlayerCount; + Property Players: aScorePlayer read aPlayers; + + //Constructor just sets some standard Settings + Constructor Create; + + //Procedure Adds a Position to Array and Increases Position Count + Procedure AddPosition(const pPosition: PScorePosition); + + //Procedure Adds a Player to Array and Increases Player Count + Procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True); + + //Change a Players Visibility, Enable + Procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); + Procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); + + //Procedure Deletes all Player Information + Procedure ClearPlayers; + + //Procedure Deletes Positions and Playerinformation + Procedure Clear; + + //Procedure Loads some Settings and the Positions from Theme + Procedure LoadfromTheme; + + //Procedure has to be called after Positions and Players have been added, before first call of Draw + //It gives every Player a Score Position + Procedure Init; + + //Spawns a new Line Bonus PopUp for the Player + Procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); + + //Removes all PopUps from Mem + Procedure KillAllPopUps; + + //Procedure Draws Scores and Linebonus PopUps + Procedure Draw; + end; + + +implementation + +uses SDL, + SysUtils, + ULog, + UGraphic, + TextGL; + +//----------- +//Constructor just sets some standard Settings +//----------- +Constructor TSingScores.Create; +begin + //Clear PopupList Pointers + FirstPopUp := nil; + LastPopUp := nil; + + //Clear Variables + Visible := True; + Enabled := True; + RBVisible := True; + + //Clear Position Index + oPositionCount := 0; + oPlayerCount := 0; + + Settings.Phase1Time := 1000; + Settings.Phase2Time := 2000; + Settings.Phase3Time := 2000; + + Settings.PopUpTex[0].TexNum := High(gluInt); + Settings.PopUpTex[1].TexNum := High(gluInt); + Settings.PopUpTex[2].TexNum := High(gluInt); + Settings.PopUpTex[3].TexNum := High(gluInt); + Settings.PopUpTex[4].TexNum := High(gluInt); + Settings.PopUpTex[5].TexNum := High(gluInt); + Settings.PopUpTex[6].TexNum := High(gluInt); + Settings.PopUpTex[7].TexNum := High(gluInt); + Settings.PopUpTex[8].TexNum := High(gluInt); + + Settings.RatingBar_BG_Tex.TexNum := High(gluInt); + Settings.RatingBar_FG_Tex.TexNum := High(gluInt); + Settings.RatingBar_Bar_Tex.TexNum := High(gluInt); +end; + +//----------- +//Procedure Adds a Position to Array and Increases Position Count +//----------- +Procedure TSingScores.AddPosition(const pPosition: PScorePosition); +begin + if (PositionCount < MaxPositions) then + begin + Positions[PositionCount] := pPosition^; + + Inc(oPositionCount); + end; +end; + +//----------- +//Procedure Adds a Player to Array and Increases Player Count +//----------- +Procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word; const Enabled: Boolean; const Visible: Boolean); +begin + if (PlayerCount < MaxPlayers) then + begin + aPlayers[PlayerCount].Position := High(byte); + aPlayers[PlayerCount].Enabled := Enabled; + aPlayers[PlayerCount].Visible := Visible; + aPlayers[PlayerCount].Score := Score; + aPlayers[PlayerCount].ScoreDisplayed := Score; + aPlayers[PlayerCount].ScoreBG := ScoreBG; + aPlayers[PlayerCount].Color := Color; + aPlayers[PlayerCount].RBPos := 0.5; + aPlayers[PlayerCount].RBTarget := 0.5; + aPlayers[PlayerCount].RBVisible := True; + + Inc(oPlayerCount); + end; +end; + +//----------- +//Change a Players Visibility +//----------- +Procedure TSingScores.ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); +begin + if (Index < MaxPlayers) then + aPlayers[Index].Visible := pVisible; +end; + +//----------- +//Change Player Enabled +//----------- +Procedure TSingScores.ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); +begin + if (Index < MaxPlayers) then + aPlayers[Index].Enabled := pEnabled; +end; + +//----------- +//Procedure Deletes all Player Information +//----------- +Procedure TSingScores.ClearPlayers; +begin + KillAllPopUps; + oPlayerCount := 0; +end; + +//----------- +//Procedure Deletes Positions and Playerinformation +//----------- +Procedure TSingScores.Clear; +begin + KillAllPopUps; + oPlayerCount := 0; + oPositionCount := 0; +end; + +//----------- +//Procedure Loads some Settings and the Positions from Theme +//----------- +Procedure TSingScores.LoadfromTheme; +var I: Integer; + Procedure AddbyStatics(const PC: Byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText); + var nPosition: TScorePosition; + begin + nPosition.PlayerCount := PC; //Only for one Player Playing + + nPosition.BGX := ScoreStatic.X; + nPosition.BGY := ScoreStatic.Y; + nPosition.BGW := ScoreStatic.W; + nPosition.BGH := ScoreStatic.H; + + nPosition.TextX := ScoreText.X; + nPosition.TextY := ScoreText.Y; + nPosition.TextFont := ScoreText.Font; + nPosition.TextSize := ScoreText.Size; + + nPosition.RBX := SingBarStatic.X; + nPosition.RBY := SingBarStatic.Y; + nPosition.RBW := SingBarStatic.W; + nPosition.RBH := SingBarStatic.H; + + nPosition.PUW := nPosition.BGW; + nPosition.PUH := nPosition.BGH; + + nPosition.PUFont := 2; + nPosition.PUFontSize := 6; + + nPosition.PUStartX := nPosition.BGX; + nPosition.PUStartY := nPosition.TextY + 65; + + nPosition.PUTargetX := nPosition.BGX; + nPosition.PUTargetY := nPosition.TextY; + + AddPosition(@nPosition); + end; +begin + Clear; + + //Set Textures + //Popup Tex + For I := 0 to 8 do + Settings.PopUpTex[I] := Tex_SingLineBonusBack[I]; + + //Rating Bar Tex + Settings.RatingBar_BG_Tex := Tex_SingBar_Back; + Settings.RatingBar_FG_Tex := Tex_SingBar_Front; + Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar; + + //Load Positions from Theme + + // Player1: + AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score); + AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore); + AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore); + + // Player2: + AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore); + AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore); + + // Player3: + AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RScoreBG, Theme.Sing.TextP3RScore); +end; + +//----------- +//Spawns a new Line Bonus PopUp for the Player +//----------- +Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); +var Cur: PScorePopUp; +begin + if (PlayerIndex < PlayerCount) then + begin + //Get Memory and Add Data + GetMem(Cur, SizeOf(TScorePopUp)); + + Cur.Player := PlayerIndex; + Cur.TimeStamp := SDL_GetTicks; + Cur.Rating := Rating; + Cur.ScoreGiven:= 0; + If (Players[PlayerIndex].Score < Score) then + begin + Cur.ScoreDiff := Score - Players[PlayerIndex].Score; + aPlayers[PlayerIndex].Score := Score; + end + else + Cur.ScoreDiff := 0; + Cur.Next := nil; + + //Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff)); + + //Add it to the Chain + if (FirstPopUp = nil) then + //the first PopUp in the List + FirstPopUp := Cur + else + //second or earlier popup + LastPopUp.Next := Cur; + + //Set new Popup to Last PopUp in the List + LastPopUp := Cur; + end + else + Log.LogError('TSingScores: Try to add PopUp for not existing player'); +end; + +//----------- +// Removes a PopUp w/o destroying the List +//----------- +Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); +var + lTempA , + lTempB : real; +begin + //Give Player the Last Points that missing till now + aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; + + //Change Bars Position + + // TODO : JB_Lazarus - Exception=Invalid floating point operation + // AT THIS LINE ! + + {$IFDEF LAZARUS} +(* + writeln( 'USINGSCORES-aPlayers[Cur.Player].RBTarget : ' + floattostr( aPlayers[Cur.Player].RBTarget ) ); + writeln( 'USINGSCORES-(Cur.ScoreDiff - Cur.ScoreGiven) : ' + floattostr( (Cur.ScoreDiff - Cur.ScoreGiven) ) ); + writeln( 'USINGSCORES-Cur.ScoreDiff : ' + floattostr( Cur.ScoreDiff ) ); + writeln( 'USINGSCORES-(Cur.Rating / 20 - 0.26) : ' + floattostr( (Cur.Rating / 20 - 0.26) ) ); + writeln( '' ); +*) + {$ENDIF} + + lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); + lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); + + {$IFDEF LAZARUS} +(* + writeln( 'USINGSCORES-lTempA : ' + floattostr( lTempA ) ); + writeln( 'USINGSCORES-lTempB : ' + floattostr( lTempB ) ); + writeln( '----------------------------------------------------------' ); +*) + {$ENDIF} + + if ( lTempA > 0 ) AND + ( lTempB > 0 ) THEN + begin + aPlayers[Cur.Player].RBTarget := lTempA / lTempB; + end; + + If (aPlayers[Cur.Player].RBTarget > 1) then + aPlayers[Cur.Player].RBTarget := 1 + else + If (aPlayers[Cur.Player].RBTarget < 0) then + aPlayers[Cur.Player].RBTarget := 0; + + //If this is the First PopUp => Make Next PopUp the First + If (Cur = FirstPopUp) then + FirstPopUp := Cur.Next + //Else => Remove Curent Popup from Chain + else + Last.Next := Cur.Next; + + //If this is the Last PopUp, Make PopUp before the Last + If (Cur = LastPopUp) then + LastPopUp := Last; + + //Free the Memory + FreeMem(Cur, SizeOf(TScorePopUp)); +end; + +//----------- +//Removes all PopUps from Mem +//----------- +Procedure TSingScores.KillAllPopUps; +var + Cur: PScorePopUp; + Last: PScorePopUp; +begin + Cur := FirstPopUp; + + //Remove all PopUps: + While (Cur <> nil) do + begin + Last := Cur; + Cur := Cur.Next; + FreeMem(Last, SizeOf(TScorePopUp)); + end; + + FirstPopUp := nil; + LastPopUp := nil; +end; + +//----------- +//Init - has to be called after Positions and Players have been added, before first call of Draw +//It gives every Player a Score Position +//----------- +Procedure TSingScores.Init; +var + PlC: Array [0..1] of Byte; //Playercount First Screen and Second Screen + I, J: Integer; + MaxPlayersperScreen: Byte; + CurPlayer: Byte; + + Function GetPositionCountbyPlayerCount(bPlayerCount: Byte): Byte; + var I: Integer; + begin + Result := 0; + bPlayerCount := 1 shl (bPlayerCount - 1); + + For I := 0 to PositionCount-1 do + begin + If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then + Inc(Result); + end; + end; + + Function GetPositionbyPlayernum(bPlayerCount, bPlayer: Byte): Byte; + var I: Integer; + begin + bPlayerCount := 1 shl (bPlayerCount - 1); + Result := High(Byte); + + For I := 0 to PositionCount-1 do + begin + If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then + begin + If (bPlayer = 0) then + begin + Result := I; + Break; + end + else + Dec(bPlayer); + end; + end; + end; + +begin + + For I := 1 to 6 do + begin + //If there are enough Positions -> Write to MaxPlayers + If (GetPositionCountbyPlayerCount(I) = I) then + MaxPlayersperScreen := I + else + Break; + end; + + + //Split Players to both Screen or Display on One Screen + if (Screens = 2) and (MaxPlayersperScreen < PlayerCount) then + begin + PlC[0] := PlayerCount div 2 + PlayerCount mod 2; + PlC[1] := PlayerCount div 2; + end + else + begin + PlC[0] := PlayerCount; + PlC[1] := 0; + end; + + + //Check if there are enough Positions for all Players + For I := 0 to Screens - 1 do + begin + if (PlC[I] > MaxPlayersperScreen) then + begin + PlC[I] := MaxPlayersperScreen; + Log.LogError('More Players than available Positions, TSingScores'); + end; + end; + + CurPlayer := 0; + //Give every Player a Position + For I := 0 to Screens - 1 do + For J := 0 to PlC[I]-1 do + begin + aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) OR (I shl 7); + //Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position)); + Inc(CurPlayer); + end; +end; + +//----------- +//Procedure Draws Scores and Linebonus PopUps +//----------- +Procedure TSingScores.Draw; +var + I: Integer; + CurTime: Cardinal; + CurPopUp, LastPopUp: PScorePopUp; +begin + CurTime := SDL_GetTicks; + + If Visible then + begin + //Draw Popups + LastPopUp := nil; + CurPopUp := FirstPopUp; + + While (CurPopUp <> nil) do + begin + if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then + begin + KillPopUp(LastPopUp, CurPopUp); + if (LastPopUp = nil) then + CurPopUp := FirstPopUp + else + CurPopUp := LastPopUp.Next; + end + else + begin + DrawPopUp(CurPopUp); + LastPopUp := CurPopUp; + CurPopUp := LastPopUp.Next; + end; + end; + + + IF (RBVisible) then + //Draw Players w/ Rating Bar + For I := 0 to PlayerCount-1 do + begin + DrawScore(I); + DrawRatingBar(I); + end + else + //Draw Players w/o Rating Bar + For I := 0 to PlayerCount-1 do + begin + DrawScore(I); + end; + + end; //eo Visible +end; + +//----------- +//Procedure Draws a Popup by Pointer +//----------- +Procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp); +var + Progress: Real; + CurTime: Cardinal; + X, Y, W, H, Alpha: Real; + FontSize: Byte; + TimeDiff: Cardinal; + PIndex: Byte; + TextLen: Real; + ScoretoAdd: Word; + PosDiff: Real; +begin + if (PopUp <> nil) then + begin + //Only Draw if Player has a Position + PIndex := Players[PopUp.Player].Position; + If PIndex <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If ((Players[PopUp.Player].Position AND 128) = 0) = (ScreenAct = 1) then + begin + CurTime := SDL_GetTicks; + If Not (Enabled AND Players[PopUp.Player].Enabled) then + //Increase Timestamp with TIem where there is no Movement ... + begin + //Inc(PopUp.TimeStamp, LastRender); + end; + TimeDiff := CurTime - PopUp.TimeStamp; + + //Get Position of PopUp + PIndex := PIndex AND 127; + + + //Check for Phase ... + If (TimeDiff <= Settings.Phase1Time) then + begin + //Phase 1 - The Ploping up + Progress := TimeDiff / Settings.Phase1Time; + + + W := Positions[PIndex].PUW * Sin(Progress/2*Pi); + H := Positions[PIndex].PUH * Sin(Progress/2*Pi); + + X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2; + Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; + + FontSize := Round(Progress * Positions[PIndex].PUFontSize); + Alpha := 1; + end + + Else If (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then + begin + //Phase 2 - The Moving + Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time; + + W := Positions[PIndex].PUW; + H := Positions[PIndex].PUH; + + PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; + If PosDiff > 0 then + PosDiff := PosDiff + W; + X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress); + + PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; + If PosDiff < 0 then + PosDiff := PosDiff + Positions[PIndex].BGH; + Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); + + FontSize := Positions[PIndex].PUFontSize; + Alpha := 1 - 0.3 * Progress; + end + + else + begin + //Phase 3 - The Fading out + Score adding + Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time; + + If (PopUp.Rating > 0) then + begin + //Add Scores if Player Enabled + If (Enabled AND Players[PopUp.Player].Enabled) then + begin + ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven; + Inc(PopUp.ScoreGiven, ScoreToAdd); + aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; + + //Change Bars Position + aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26); + If (aPlayers[PopUp.Player].RBTarget > 1) then + aPlayers[PopUp.Player].RBTarget := 1 + else If (aPlayers[PopUp.Player].RBTarget < 0) then + aPlayers[PopUp.Player].RBTarget := 0; + end; + + //Set Positions etc. + Alpha := 0.7 - 0.7 * Progress; + + W := Positions[PIndex].PUW; + H := Positions[PIndex].PUH; + + PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; + If (PosDiff > 0) then + PosDiff := W + else + PosDiff := 0; + X := Positions[PIndex].PUTargetX + PosDiff * Progress; + + PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; + If (PosDiff < 0) then + PosDiff := -Positions[PIndex].BGH + else + PosDiff := 0; + Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress); + + FontSize := Positions[PIndex].PUFontSize; + end + else + begin + //Here the Effect that Should be shown if a PopUp without Score is Drawn + //And or Spawn with the GraphicObjects etc. + //Some Work for Blindy to do :P + + //ATM: Just Let it Slide in the Scores just like the Normal PopUp + Alpha := 0; + end; + end; + + //Draw PopUp + + if (Alpha > 0) AND (Players[PopUp.Player].Visible) then + begin + //Draw BG: + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + glColor4f(1,1,1, Alpha); + glBindTexture(GL_TEXTURE_2D, Settings.PopUpTex[PopUp.Rating].TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X, Y + H); + glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X + W, Y + H); + glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, 0); glVertex2f(X + W, Y); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + //Set FontStyle and Size + SetFontStyle(Positions[PIndex].PUFont); + SetFontItalic(False); + SetFontSize(FontSize); + + //Draw Text + TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); + + //Color and Pos + SetFontPos (X + (W - TextLen) / 2, Y + 12); + glColor4f(1, 1, 1, Alpha); + + //Draw + glPrint(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); + end; //eo Alpha check + end; //eo Right Screen + end; //eo Player has Position + end + else + Log.LogError('TSingScores: Try to Draw a not existing PopUp'); +end; + +//----------- +//Procedure Draws a Score by Playerindex +//----------- +Procedure TSingScores.DrawScore(const Index: Integer); +var + Position: PScorePosition; + ScoreStr: String; +begin + //Only Draw if Player has a Position + If Players[Index].Position <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If (((Players[Index].Position AND 128) = 0) = (ScreenAct = 1)) AND Players[Index].Visible then + begin + Position := @Positions[Players[Index].Position and 127]; + + //Draw ScoreBG + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + glColor4f(1,1,1, 1); + glBindTexture(GL_TEXTURE_2D, Players[Index].ScoreBG.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Position.BGX, Position.BGY); + glTexCoord2f(0, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX, Position.BGY + Position.BGH); + glTexCoord2f(Players[Index].ScoreBG.TexW, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX + Position.BGW, Position.BGY + Position.BGH); + glTexCoord2f(Players[Index].ScoreBG.TexW, 0); glVertex2f(Position.BGX + Position.BGW, Position.BGY); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + //Draw Score Text + SetFontStyle(Position.TextFont); + SetFontItalic(False); + SetFontSize(Position.TextSize); + SetFontPos(Position.TextX, Position.TextY); + + ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0'; + While (Length(ScoreStr) < 5) do + ScoreStr := '0' + ScoreStr; + + glPrint(PChar(ScoreStr)); + + end; //eo Right Screen + end; //eo Player has Position +end; + + +Procedure TSingScores.DrawRatingBar(const Index: Integer); +var + Position: PScorePosition; + R,G,B, Size: Real; + Diff: Real; +begin + //Only Draw if Player has a Position + If Players[Index].Position <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If ((Players[Index].Position AND 128) = 0) = (ScreenAct = 1) AND (Players[index].RBVisible AND Players[index].Visible) then + begin + Position := @Positions[Players[Index].Position and 127]; + + If (Enabled AND Players[Index].Enabled) then + begin + //Move Position if Enabled + Diff := Players[Index].RBTarget - Players[Index].RBPos; + If(Abs(Diff) < 0.02) then + aPlayers[Index].RBPos := aPlayers[Index].RBTarget + else + aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1; + end; + + //Get Colors for RatingBar + If Players[index].RBPos <=0.22 then + begin + R := 1; + G := 0; + B := 0; + end + Else If Players[index].RBPos <=0.42 then + begin + R := 1; + G := Players[index].RBPos*5; + B := 0; + end + Else If Players[index].RBPos <=0.57 then + begin + R := 1; + G := 1; + B := 0; + end + Else If Players[index].RBPos <=0.77 then + begin + R := 1-(Players[index].RBPos-0.57)*5; + G := 1; + B := 0; + end + else + begin + R := 0; + G := 1; + B := 0; + end; + + //Enable all glFuncs Needed + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + //Draw RatingBar BG + glColor4f(1, 1, 1, 0.8); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_BG_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY+Position.RBH); + + glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, Settings.RatingBar_BG_Tex.TexH); + glVertex2f(Position.RBX+Position.RBW, Position.RBY+Position.RBH); + + glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, 0); + glVertex2f(Position.RBX+Position.RBW, Position.RBY); + glEnd; + + //Draw Rating bar itself + Size := Position.RBX + Position.RBW * Players[Index].RBPos; + glColor4f(R, G, B, 1); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_Bar_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, Settings.RatingBar_Bar_Tex.TexH); + glVertex2f(Size, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, 0); + glVertex2f(Size, Position.RBY); + glEnd; + + //Draw Ratingbar FG (Teh thing with the 3 lines to get better readability) + glColor4f(1, 1, 1, 0.6); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_FG_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, Settings.RatingBar_FG_Tex.TexH); + glVertex2f(Position.RBX + Position.RBW, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, 0); + glVertex2f(Position.RBX + Position.RBW, Position.RBY); + glEnd; + + //Disable all Enabled glFuncs + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + end; //eo Right Screen + end; //eo Player has Position +end; + +end. diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas index 5bab885b..2237c22a 100644 --- a/Game/Code/Classes/USkins.pas +++ b/Game/Code/Classes/USkins.pas @@ -2,6 +2,10 @@ unit USkins; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} type diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas index 9e0d6ca5..614363c8 100644 --- a/Game/Code/Classes/USongs.pas +++ b/Game/Code/Classes/USongs.pas @@ -2,6 +2,10 @@ unit USongs; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses SysUtils, @@ -225,8 +229,10 @@ begin ADirent := ReadDir(TheDir); if ( ADirent <> Nil ) AND - ( pos( '.txt', ADirent^.name ) > -1 ) then + ( pos( '.txt', ADirent^.name ) > 0 ) then begin + writeln ('***** FOUND TXT' + ADirent^.name ); + SLen := BrowsePos; Song[SLen].Path := Dir; @@ -244,7 +250,6 @@ begin //Change Length Only every 50 Entrys Inc(BrowsePos); - if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then begin SetLength(Song, Length(Song) + 50); diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 76d78f5b..f1f7fe47 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -17,6 +17,10 @@ unit UTexture; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses OpenGL12, diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index c27f9c9e..c212e7cb 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -2,6 +2,10 @@ unit UThemes; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses diff --git a/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas index f714fed5..3b7749a2 100644 --- a/Game/Code/Classes/UTime.pas +++ b/Game/Code/Classes/UTime.pas @@ -2,6 +2,9 @@ unit UTime; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} {$I switches.inc} {$UNDEF DebugDisplay} diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index c18eea6c..65dbc0a2 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -14,12 +14,16 @@ unit UVideo; //{$define DebugFrames} //{$define Info} -//{$define FFMpegAudio} +// {$define FFMpegAudio} {} interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} (* @@ -281,6 +285,7 @@ begin else if (AVPacket.stream_index = AudioStreamIndex ) then begin + writeln('Encue Audio packet'); UAudio_FFMpeg.packet_queue_put(UAudio_FFMpeg.audioq, AVPacket); {$endif} end; diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas index 55c89878..0fe5d51a 100644 --- a/Game/Code/Classes/uPluginLoader.pas +++ b/Game/Code/Classes/uPluginLoader.pas @@ -8,6 +8,10 @@ unit UPluginLoader; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses UPluginDefs, UCoreModule; -- cgit v1.2.3