From 16a6e6801fde495b2782e2e04a0cf055ce1e1516 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 27 Aug 2008 14:59:38 +0000 Subject: rename Classes part1 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1307 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/Classes/TextGL.pas | 462 ------ src/Classes/UAudioConverter.pas | 458 ------ src/Classes/UAudioCore_Bass.pas | 123 -- src/Classes/UAudioCore_Portaudio.pas | 257 ---- src/Classes/UAudioDecoder_Bass.pas | 242 ---- src/Classes/UAudioDecoder_FFmpeg.pas | 1114 -------------- src/Classes/UAudioInput_Bass.pas | 481 ------- src/Classes/UAudioInput_Portaudio.pas | 474 ------ src/Classes/UAudioPlaybackBase.pas | 292 ---- src/Classes/UAudioPlayback_Bass.pas | 731 ---------- src/Classes/UAudioPlayback_Portaudio.pas | 361 ----- src/Classes/UAudioPlayback_SDL.pas | 160 --- src/Classes/UAudioPlayback_SoftMixer.pas | 1132 --------------- src/Classes/UCatCovers.pas | 173 --- src/Classes/UCommandLine.pas | 339 ----- src/Classes/UCommon.pas | 774 ---------- src/Classes/UConfig.pas | 199 --- src/Classes/UCore.pas | 525 ------- src/Classes/UCoreModule.pas | 128 -- src/Classes/UCovers.pas | 430 ------ src/Classes/UDLLManager.pas | 253 ---- src/Classes/UDataBase.pas | 533 ------- src/Classes/UDraw.pas | 1390 ------------------ src/Classes/UEditorLyrics.pas | 229 --- src/Classes/UFiles.pas | 150 -- src/Classes/UGraphic.pas | 760 ---------- src/Classes/UGraphicClasses.pas | 673 --------- src/Classes/UHooks.pas | 434 ------ src/Classes/UImage.pas | 993 ------------- src/Classes/UIni.pas | 928 ------------ src/Classes/UJoystick.pas | 282 ---- src/Classes/ULCD.pas | 304 ---- src/Classes/ULanguage.pas | 240 ---- src/Classes/ULight.pas | 145 -- src/Classes/ULog.pas | 417 ------ src/Classes/ULyrics.pas | 884 ------------ src/Classes/UMain.pas | 1107 -------------- src/Classes/UMediaCore_FFmpeg.pas | 405 ------ src/Classes/UMediaCore_SDL.pas | 38 - src/Classes/UMedia_dummy.pas | 243 ---- src/Classes/UModules.pas | 26 - src/Classes/UMusic.pas | 1233 ---------------- src/Classes/UParty.pas | 630 -------- src/Classes/UPlatform.pas | 165 --- src/Classes/UPlatformLinux.pas | 160 --- src/Classes/UPlatformMacOSX.pas | 294 ---- src/Classes/UPlatformWindows.pas | 236 --- src/Classes/UPlaylist.pas | 490 ------- src/Classes/UPluginInterface.pas | 156 -- src/Classes/URecord.pas | 766 ---------- src/Classes/URingBuffer.pas | 128 -- src/Classes/UServices.pas | 358 ----- src/Classes/USingNotes.pas | 13 - src/Classes/USingScores.pas | 973 ------------- src/Classes/USkins.pas | 185 --- src/Classes/USong.pas | 1027 ------------- src/Classes/USongs.pas | 806 ----------- src/Classes/UTextClasses.pas | 60 - src/Classes/UTexture.pas | 525 ------- src/Classes/UThemes.pas | 2234 ----------------------------- src/Classes/UTime.pas | 185 --- src/Classes/UVideo.pas | 828 ----------- src/Classes/UVisualizer.pas | 442 ------ src/Classes/UXMLSong.pas | 573 -------- src/Classes/uPluginLoader.pas | 775 ---------- src/classes0/TextGL.pas | 462 ++++++ src/classes0/UAudioConverter.pas | 458 ++++++ src/classes0/UAudioCore_Bass.pas | 123 ++ src/classes0/UAudioCore_Portaudio.pas | 257 ++++ src/classes0/UAudioDecoder_Bass.pas | 242 ++++ src/classes0/UAudioDecoder_FFmpeg.pas | 1114 ++++++++++++++ src/classes0/UAudioInput_Bass.pas | 481 +++++++ src/classes0/UAudioInput_Portaudio.pas | 474 ++++++ src/classes0/UAudioPlaybackBase.pas | 292 ++++ src/classes0/UAudioPlayback_Bass.pas | 731 ++++++++++ src/classes0/UAudioPlayback_Portaudio.pas | 361 +++++ src/classes0/UAudioPlayback_SDL.pas | 160 +++ src/classes0/UAudioPlayback_SoftMixer.pas | 1132 +++++++++++++++ src/classes0/UCatCovers.pas | 173 +++ src/classes0/UCommandLine.pas | 339 +++++ src/classes0/UCommon.pas | 774 ++++++++++ src/classes0/UConfig.pas | 199 +++ src/classes0/UCore.pas | 525 +++++++ src/classes0/UCoreModule.pas | 128 ++ src/classes0/UCovers.pas | 430 ++++++ src/classes0/UDLLManager.pas | 253 ++++ src/classes0/UDataBase.pas | 533 +++++++ src/classes0/UDraw.pas | 1390 ++++++++++++++++++ src/classes0/UEditorLyrics.pas | 229 +++ src/classes0/UFiles.pas | 150 ++ src/classes0/UGraphic.pas | 760 ++++++++++ src/classes0/UGraphicClasses.pas | 673 +++++++++ src/classes0/UHooks.pas | 434 ++++++ src/classes0/UImage.pas | 993 +++++++++++++ src/classes0/UIni.pas | 928 ++++++++++++ src/classes0/UJoystick.pas | 282 ++++ src/classes0/ULCD.pas | 304 ++++ src/classes0/ULanguage.pas | 240 ++++ src/classes0/ULight.pas | 145 ++ src/classes0/ULog.pas | 417 ++++++ src/classes0/ULyrics.pas | 884 ++++++++++++ src/classes0/UMain.pas | 1107 ++++++++++++++ src/classes0/UMediaCore_FFmpeg.pas | 405 ++++++ src/classes0/UMediaCore_SDL.pas | 38 + src/classes0/UMedia_dummy.pas | 243 ++++ src/classes0/UModules.pas | 26 + src/classes0/UMusic.pas | 1233 ++++++++++++++++ src/classes0/UParty.pas | 630 ++++++++ src/classes0/UPlatform.pas | 165 +++ src/classes0/UPlatformLinux.pas | 160 +++ src/classes0/UPlatformMacOSX.pas | 294 ++++ src/classes0/UPlatformWindows.pas | 236 +++ src/classes0/UPlaylist.pas | 490 +++++++ src/classes0/UPluginInterface.pas | 156 ++ src/classes0/URecord.pas | 766 ++++++++++ src/classes0/URingBuffer.pas | 128 ++ src/classes0/UServices.pas | 358 +++++ src/classes0/USingNotes.pas | 13 + src/classes0/USingScores.pas | 973 +++++++++++++ src/classes0/USkins.pas | 185 +++ src/classes0/USong.pas | 1027 +++++++++++++ src/classes0/USongs.pas | 806 +++++++++++ src/classes0/UTextClasses.pas | 60 + src/classes0/UTexture.pas | 525 +++++++ src/classes0/UThemes.pas | 2234 +++++++++++++++++++++++++++++ src/classes0/UTime.pas | 185 +++ src/classes0/UVideo.pas | 828 +++++++++++ src/classes0/UVisualizer.pas | 442 ++++++ src/classes0/UXMLSong.pas | 573 ++++++++ src/classes0/uPluginLoader.pas | 775 ++++++++++ 130 files changed, 32531 insertions(+), 32531 deletions(-) delete mode 100644 src/Classes/TextGL.pas delete mode 100644 src/Classes/UAudioConverter.pas delete mode 100644 src/Classes/UAudioCore_Bass.pas delete mode 100644 src/Classes/UAudioCore_Portaudio.pas delete mode 100644 src/Classes/UAudioDecoder_Bass.pas delete mode 100644 src/Classes/UAudioDecoder_FFmpeg.pas delete mode 100644 src/Classes/UAudioInput_Bass.pas delete mode 100644 src/Classes/UAudioInput_Portaudio.pas delete mode 100644 src/Classes/UAudioPlaybackBase.pas delete mode 100644 src/Classes/UAudioPlayback_Bass.pas delete mode 100644 src/Classes/UAudioPlayback_Portaudio.pas delete mode 100644 src/Classes/UAudioPlayback_SDL.pas delete mode 100644 src/Classes/UAudioPlayback_SoftMixer.pas delete mode 100644 src/Classes/UCatCovers.pas delete mode 100644 src/Classes/UCommandLine.pas delete mode 100644 src/Classes/UCommon.pas delete mode 100644 src/Classes/UConfig.pas delete mode 100644 src/Classes/UCore.pas delete mode 100644 src/Classes/UCoreModule.pas delete mode 100644 src/Classes/UCovers.pas delete mode 100644 src/Classes/UDLLManager.pas delete mode 100644 src/Classes/UDataBase.pas delete mode 100644 src/Classes/UDraw.pas delete mode 100644 src/Classes/UEditorLyrics.pas delete mode 100644 src/Classes/UFiles.pas delete mode 100644 src/Classes/UGraphic.pas delete mode 100644 src/Classes/UGraphicClasses.pas delete mode 100644 src/Classes/UHooks.pas delete mode 100644 src/Classes/UImage.pas delete mode 100644 src/Classes/UIni.pas delete mode 100644 src/Classes/UJoystick.pas delete mode 100644 src/Classes/ULCD.pas delete mode 100644 src/Classes/ULanguage.pas delete mode 100644 src/Classes/ULight.pas delete mode 100644 src/Classes/ULog.pas delete mode 100644 src/Classes/ULyrics.pas delete mode 100644 src/Classes/UMain.pas delete mode 100644 src/Classes/UMediaCore_FFmpeg.pas delete mode 100644 src/Classes/UMediaCore_SDL.pas delete mode 100644 src/Classes/UMedia_dummy.pas delete mode 100644 src/Classes/UModules.pas delete mode 100644 src/Classes/UMusic.pas delete mode 100644 src/Classes/UParty.pas delete mode 100644 src/Classes/UPlatform.pas delete mode 100644 src/Classes/UPlatformLinux.pas delete mode 100644 src/Classes/UPlatformMacOSX.pas delete mode 100644 src/Classes/UPlatformWindows.pas delete mode 100644 src/Classes/UPlaylist.pas delete mode 100644 src/Classes/UPluginInterface.pas delete mode 100644 src/Classes/URecord.pas delete mode 100644 src/Classes/URingBuffer.pas delete mode 100644 src/Classes/UServices.pas delete mode 100644 src/Classes/USingNotes.pas delete mode 100644 src/Classes/USingScores.pas delete mode 100644 src/Classes/USkins.pas delete mode 100644 src/Classes/USong.pas delete mode 100644 src/Classes/USongs.pas delete mode 100644 src/Classes/UTextClasses.pas delete mode 100644 src/Classes/UTexture.pas delete mode 100644 src/Classes/UThemes.pas delete mode 100644 src/Classes/UTime.pas delete mode 100644 src/Classes/UVideo.pas delete mode 100644 src/Classes/UVisualizer.pas delete mode 100644 src/Classes/UXMLSong.pas delete mode 100644 src/Classes/uPluginLoader.pas create mode 100644 src/classes0/TextGL.pas create mode 100644 src/classes0/UAudioConverter.pas create mode 100644 src/classes0/UAudioCore_Bass.pas create mode 100644 src/classes0/UAudioCore_Portaudio.pas create mode 100644 src/classes0/UAudioDecoder_Bass.pas create mode 100644 src/classes0/UAudioDecoder_FFmpeg.pas create mode 100644 src/classes0/UAudioInput_Bass.pas create mode 100644 src/classes0/UAudioInput_Portaudio.pas create mode 100644 src/classes0/UAudioPlaybackBase.pas create mode 100644 src/classes0/UAudioPlayback_Bass.pas create mode 100644 src/classes0/UAudioPlayback_Portaudio.pas create mode 100644 src/classes0/UAudioPlayback_SDL.pas create mode 100644 src/classes0/UAudioPlayback_SoftMixer.pas create mode 100644 src/classes0/UCatCovers.pas create mode 100644 src/classes0/UCommandLine.pas create mode 100644 src/classes0/UCommon.pas create mode 100644 src/classes0/UConfig.pas create mode 100644 src/classes0/UCore.pas create mode 100644 src/classes0/UCoreModule.pas create mode 100644 src/classes0/UCovers.pas create mode 100644 src/classes0/UDLLManager.pas create mode 100644 src/classes0/UDataBase.pas create mode 100644 src/classes0/UDraw.pas create mode 100644 src/classes0/UEditorLyrics.pas create mode 100644 src/classes0/UFiles.pas create mode 100644 src/classes0/UGraphic.pas create mode 100644 src/classes0/UGraphicClasses.pas create mode 100644 src/classes0/UHooks.pas create mode 100644 src/classes0/UImage.pas create mode 100644 src/classes0/UIni.pas create mode 100644 src/classes0/UJoystick.pas create mode 100644 src/classes0/ULCD.pas create mode 100644 src/classes0/ULanguage.pas create mode 100644 src/classes0/ULight.pas create mode 100644 src/classes0/ULog.pas create mode 100644 src/classes0/ULyrics.pas create mode 100644 src/classes0/UMain.pas create mode 100644 src/classes0/UMediaCore_FFmpeg.pas create mode 100644 src/classes0/UMediaCore_SDL.pas create mode 100644 src/classes0/UMedia_dummy.pas create mode 100644 src/classes0/UModules.pas create mode 100644 src/classes0/UMusic.pas create mode 100644 src/classes0/UParty.pas create mode 100644 src/classes0/UPlatform.pas create mode 100644 src/classes0/UPlatformLinux.pas create mode 100644 src/classes0/UPlatformMacOSX.pas create mode 100644 src/classes0/UPlatformWindows.pas create mode 100644 src/classes0/UPlaylist.pas create mode 100644 src/classes0/UPluginInterface.pas create mode 100644 src/classes0/URecord.pas create mode 100644 src/classes0/URingBuffer.pas create mode 100644 src/classes0/UServices.pas create mode 100644 src/classes0/USingNotes.pas create mode 100644 src/classes0/USingScores.pas create mode 100644 src/classes0/USkins.pas create mode 100644 src/classes0/USong.pas create mode 100644 src/classes0/USongs.pas create mode 100644 src/classes0/UTextClasses.pas create mode 100644 src/classes0/UTexture.pas create mode 100644 src/classes0/UThemes.pas create mode 100644 src/classes0/UTime.pas create mode 100644 src/classes0/UVideo.pas create mode 100644 src/classes0/UVisualizer.pas create mode 100644 src/classes0/UXMLSong.pas create mode 100644 src/classes0/uPluginLoader.pas (limited to 'src') diff --git a/src/Classes/TextGL.pas b/src/Classes/TextGL.pas deleted file mode 100644 index f7b3ac95..00000000 --- a/src/Classes/TextGL.pas +++ /dev/null @@ -1,462 +0,0 @@ -unit TextGL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - gl, - SDL, - UTexture, - Classes, -// SDL_ttf, - ULog; - -procedure BuildFont; // build our bitmap font -procedure KillFont; // delete the font -function glTextWidth(text: PChar): real; // returns text width -procedure glPrintLetter(letter: char); -procedure glPrint(text: pchar); // custom GL "Print" routine -procedure SetFontPos(X, Y: real); // sets X and Y -procedure SetFontZ(Z: real); // sets Z -procedure SetFontSize(Size: real); -procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc) -procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) -procedure SetFontAspectW(Aspect: real); -procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection -procedure SetFontBlend(Enable: boolean); // enables/disables blending - -//function NextPowerOfTwo(Value: integer): integer; -// Checks if the ttf exists, if yes then a SDL_ttf is returned -//function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; -// Does the renderstuff, color is in $ffeecc style -//function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal):PSDL_Surface; - -type - TTextGL = record - X: real; - Y: real; - Z: real; - Text: string; - Size: real; - ColR: real; - ColG: real; - ColB: real; - end; - - PFont = ^TFont; - TFont = record - Tex: TTexture; - Width: array[0..255] of byte; - AspectW: real; - Centered: boolean; - Outline: real; - Italic: boolean; - Reflection: boolean; - ReflectionSpacing: real; - Blend: boolean; - end; - - -var - Fonts: array of TFont; - ActFont: integer; - - -implementation - -uses - UMain, - UCommon, - SysUtils, - UGraphic; - -var - // Colours for the reflection - TempColor: array[0..3] of GLfloat; - -procedure LoadBitmapFontInfo(aID : integer; const aType, aResourceName: string); -var - stream: TStream; -begin - stream := GetResourceStream(aResourceName, aType); - if (not assigned(stream)) then - begin - Log.LogError('Unknown font['+ inttostr(aID) +': '+aType+']', 'loadfont'); - Exit; - end; - try - stream.Read(Fonts[ aID ].Width, 256); - except - Log.LogError('Error while reading font['+ inttostr(aID) +': '+aType+']', 'loadfont'); - end; - stream.Free; -end; - -// Builds bitmap fonts -procedure BuildFont; -var - Count: integer; -begin - ActFont := 0; - - SetLength(Fonts, 5); - Fonts[0].Tex := Texture.LoadTexture(true, 'Font', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[0].Tex.H := 30; - Fonts[0].AspectW := 0.9; - Fonts[0].Outline := 0; - - Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[1].Tex.H := 30; - Fonts[1].AspectW := 1; - Fonts[1].Outline := 0; - - Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[2].Tex.H := 30; - Fonts[2].AspectW := 0.95; - Fonts[2].Outline := 5; - - Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[3].Tex.H := 30; - Fonts[3].AspectW := 0.95; - Fonts[3].Outline := 4; - -{ Fonts[4].Tex := Texture.LoadTexture('FontO', TEXTURE_TYPE_TRANSPARENT, 0); // for score screen - Fonts[4].Tex.H := 30; - Fonts[4].AspectW := 0.95; - Fonts[4].Done := -1; - Fonts[4].Outline := 5;} - - // load font info - LoadBitmapFontInfo( 0, 'FNT', 'Font'); - LoadBitmapFontInfo( 1, 'FNT', 'FontB'); - LoadBitmapFontInfo( 2, 'FNT', 'FontO'); - LoadBitmapFontInfo( 3, 'FNT', 'FontO2'); - - for Count := 0 to 255 do - Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2; - - for Count := 0 to 255 do - Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2; - - for Count := 0 to 255 do - Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1; - -{ for Count := 0 to 255 do - Fonts[4].Width[Count] := Fonts[4].Width[Count] div 2 + 2;} - - // enable blending by default - for Count := 0 to High(Fonts) do - Fonts[Count].Blend := true; -end; - -// Deletes the font -procedure KillFont; -begin - // delete all characters - //glDeleteLists(..., 256); -end; - -function glTextWidth(text: pchar): real; -var - Letter: char; - i: integer; -begin - Result := 0; - for i := 0 to Length(text) -1 do - begin - Letter := Text[i]; - Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; - end; -end; - -procedure glPrintLetter(Letter: char); -var - TexX, TexY: real; - TexR, TexB: real; - TexHeight: real; - FWidth: real; - PL, PT: real; - PR, PB: real; - XItal: real; // X shift for italic type letter - ReflectionSpacing: real; // Distance of the reflection - Font: PFont; - Tex: PTexture; -begin - Font := @Fonts[ActFont]; - Tex := @Font.Tex; - - FWidth := Font.Width[Ord(Letter)]; - - Tex.W := FWidth * (Tex.H/30) * Font.AspectW; - - // set texture positions - TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Font.Outline/1024; - TexY := (ord(Letter) div 16) * 1/16 + 2/1024; - TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Font.Outline/1024; - TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; - - TexHeight := TexB - TexY; - - // set vector positions - PL := Tex.X - Font.Outline * (Tex.H/30) * Font.AspectW /2; - PT := Tex.Y; - PR := PL + Tex.W + Font.Outline * (Tex.H/30) * Font.AspectW; - PB := PT + Tex.H; - - if (not Font.Italic) then - XItal := 0 - else - XItal := 12; - - if (Font.Blend) then - begin - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - end; - - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, Tex.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); - glEnd; - - // Reflection - // Yes it would make sense to put this in an extra procedure, - // but this works, doesn't take much lines, and is almost lightweight - if Font.Reflection then - begin - ReflectionSpacing := Font.ReflectionSpacing + Tex.H/2; - - glDepthRange(0, 10); - glDepthFunc(GL_LEQUAL); - glEnable(GL_DEPTH_TEST); - - glBegin(GL_QUADS); - glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); - glTexCoord2f(TexX, TexY + TexHeight/2); - glVertex3f(PL, PB + ReflectionSpacing - Tex.H/2, Tex.z); - - glColor4f(TempColor[0], TempColor[1], TempColor[2], Tex.Alpha-0.3); - glTexCoord2f(TexX, TexB ); - glVertex3f(PL + XItal, PT + ReflectionSpacing, Tex.z); - - glTexCoord2f(TexR, TexB ); - glVertex3f(PR + XItal, PT + ReflectionSpacing, Tex.z); - - glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); - glTexCoord2f(TexR, TexY + TexHeight/2); - glVertex3f(PR, PB + ReflectionSpacing - Tex.H/2, Tex.z); - glEnd; - - glDisable(GL_DEPTH_TEST); - end; // reflection - - glDisable(GL_TEXTURE_2D); - if (Font.Blend) then - glDisable(GL_BLEND); - - Tex.X := Tex.X + Tex.W; - - //write the colour back - glColor4fv(@TempColor); -end; - -// Custom GL "Print" Routine -procedure glPrint(Text: PChar); -var - Pos: integer; -begin - // if there is no text do nothing - if ((Text = nil) or (Text = '')) then - Exit; - - //Save the actual color and alpha (for reflection) - glGetFloatv(GL_CURRENT_COLOR, @TempColor); - - for Pos := 0 to Length(Text) - 1 do - begin - glPrintLetter(Text[Pos]); - end; -end; - -procedure SetFontPos(X, Y: real); -begin - Fonts[ActFont].Tex.X := X; - Fonts[ActFont].Tex.Y := Y; -end; - -procedure SetFontZ(Z: real); -begin - Fonts[ActFont].Tex.Z := Z; -end; - -procedure SetFontSize(Size: real); -begin - Fonts[ActFont].Tex.H := 30 * (Size/10); -end; - -procedure SetFontStyle(Style: integer); -begin - ActFont := Style; -end; - -procedure SetFontItalic(Enable: boolean); -begin - Fonts[ActFont].Italic := Enable; -end; - -procedure SetFontAspectW(Aspect: real); -begin - Fonts[ActFont].AspectW := Aspect; -end; - -procedure SetFontReflection(Enable: boolean; Spacing: real); -begin - Fonts[ActFont].Reflection := Enable; - Fonts[ActFont].ReflectionSpacing := Spacing; -end; - -procedure SetFontBlend(Enable: boolean); -begin - Fonts[ActFont].Blend := Enable; -end; - - - - -(* - I uncommented this, because it was some kind of after hour hack together with blindy -it's actually just a prove of concept, as it's having some flaws -- instead nice and clean ttf code should be placed here :) - -{$IFDEF FPC} - {$ASMMODE Intel} -{$ENDIF} - -function NextPowerOfTwo(Value: integer): integer; -begin - Result:= 1; -{$IF Defined(CPUX86_64)} - asm - mov rcx, -1 - bsr rcx, Value - inc rcx - shl Result, cl - end; -{$ELSEIF Defined(CPU386) or Defined(CPUI386)} - asm - mov ecx, -1 - bsr ecx, Value - inc ecx - shl Result, cl - end; -{$ELSE} - while (Result <= Value) do - Result := 2 * Result; -{$IFEND} -end; - -function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; -begin - if (FileExists(FileName)) then - begin - Result := TTF_OpenFont( FileName, PointSize ); - end - else - begin - Log.LogStatus('ERROR Could not find font in ' + FileName , ''); - ShowMessage( 'ERROR Could not find font in ' + FileName ); - Result := nil; - end; -end; - -function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surface; -var - clr : TSDL_color; -begin - clr.r := ((Color and $ff0000) shr 16 ) div 255; - clr.g := ((Color and $ff00 ) shr 8 ) div 255; - clr.b := ( Color and $ff ) div 255 ; - - result := TTF_RenderText_Blended( font, text, cLr); -end; - -procedure printrandomtext(); -var - stext,intermediary : PSDL_surface; - clrFg, clrBG : TSDL_color; - texture : Gluint; - font : PTTF_Font; - w,h : integer; -begin - - font := LoadFont('fonts\comicbd.ttf', 42); - - clrFg.r := 255; - clrFg.g := 255; - clrFg.b := 255; - clrFg.unused := 255; - - clrBg.r := 255; - clrbg.g := 0; - clrbg.b := 255; - clrbg.unused := 0; - - sText := RenderText(font, 'katzeeeeeee', $fe198e); - //sText := TTF_RenderText_Blended( font, 'huuuuuuuuuund', clrFG); - - // Convert the rendered text to a known format - w := nextpoweroftwo(sText.w); - h := nextpoweroftwo(sText.h); - - intermediary := SDL_CreateRGBSurface(0, w, h, 32, - $000000ff, $0000ff00, $00ff0000, $ff000000); - - SDL_SetAlpha(intermediary, 0, 255); - SDL_SetAlpha(sText, 0, 255); - SDL_BlitSurface(sText, nil, intermediary, nil); - - glGenTextures(1, @texture); - - glBindTexture(GL_TEXTURE_2D, texture); - - glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels); - - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - - glEnable(GL_TEXTURE_2D); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glEnable(GL_BLEND); - glBindTexture(GL_TEXTURE_2D, texture); - glColor4f(1, 0, 1, 1); - - glbegin(gl_quads); - glTexCoord2f(0, 0); glVertex2f(200 , 300 ); - glTexCoord2f(0, sText.h/h); glVertex2f(200 , 300 + sText.h); - glTexCoord2f(sText.w/w, sText.h/h); glVertex2f(200 + sText.w, 300 + sText.h); - glTexCoord2f(sText.w/w, 0); glVertex2f(200 + sText.w, 300 ); - glEnd; - glfinish(); - glDisable(GL_BLEND); - gldisable(gl_texture_2d); - - SDL_FreeSurface(sText); - SDL_FreeSurface(intermediary); - glDeleteTextures(1, @texture); - TTF_CloseFont(font); - -end; -*) - - -end. diff --git a/src/Classes/UAudioConverter.pas b/src/Classes/UAudioConverter.pas deleted file mode 100644 index 5647f27b..00000000 --- a/src/Classes/UAudioConverter.pas +++ /dev/null @@ -1,458 +0,0 @@ -unit UAudioConverter; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UMusic, - ULog, - ctypes, - {$IFDEF UseSRCResample} - samplerate, - {$ENDIF} - {$IFDEF UseFFmpegResample} - avcodec, - {$ENDIF} - UMediaCore_SDL, - sdl, - SysUtils, - Math; - -type - {* - * Notes: - * - 44.1kHz to 48kHz conversion or vice versa is not supported - * by SDL 1.2 (will be introduced in 1.3). - * No conversion takes place in this cases. - * This is because SDL just converts differences in powers of 2. - * So the result might not be that accurate. - * This IS audible (voice to high/low) and it needs good synchronization - * with the video or the lyrics timer. - * - float<->int16 conversion is not supported (will be part of 1.3) and - * SDL (<1.3) is not capable of handling floats at all. - * -> Using FFmpeg or libsamplerate for resampling is preferred. - * Use SDL for channel and format conversion only. - *} - TAudioConverter_SDL = class(TAudioConverter) - private - cvt: TSDL_AudioCVT; - public - function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; - destructor Destroy(); override; - - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; - function GetOutputBufferSize(InputSize: integer): integer; override; - function GetRatio(): double; override; - end; - - {$IFDEF UseFFmpegResample} - // Note: FFmpeg seems to be using "kaiser windowed sinc" for resampling, so - // the quality should be good. - TAudioConverter_FFmpeg = class(TAudioConverter) - private - // TODO: use SDL for multi-channel->stereo and format conversion - ResampleContext: PReSampleContext; - Ratio: double; - public - function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; - destructor Destroy(); override; - - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; - function GetOutputBufferSize(InputSize: integer): integer; override; - function GetRatio(): double; override; - end; - {$ENDIF} - - {$IFDEF UseSRCResample} - TAudioConverter_SRC = class(TAudioConverter) - private - ConverterState: PSRC_STATE; - ConversionData: SRC_DATA; - FormatConverter: TAudioConverter; - public - function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; - destructor Destroy(); override; - - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; - function GetOutputBufferSize(InputSize: integer): integer; override; - function GetRatio(): double; override; - end; - - // Note: SRC (=libsamplerate) provides several converters with different quality - // speed trade-offs. The SINC-types are slow but offer best quality. - // The SRC_SINC_* converters are too slow for realtime conversion, - // (SRC_SINC_FASTEST is approx. ten times slower than SRC_LINEAR) resulting - // in audible clicks and pops. - // SRC_LINEAR is very fast and should have a better quality than SRC_ZERO_ORDER_HOLD - // because it interpolates the samples. Normal "non-audiophile" users should not - // be able to hear a difference between the SINC_* ones and LINEAR. Especially - // if people sing along with the song. - // But FFmpeg might offer a better quality/speed ratio than SRC_LINEAR. - const - SRC_CONVERTER_TYPE = SRC_LINEAR; - {$ENDIF} - -implementation - -function TAudioConverter_SDL.Init(srcFormatInfo: TAudioFormatInfo; dstFormatInfo: TAudioFormatInfo): boolean; -var - srcFormat: UInt16; - dstFormat: UInt16; -begin - inherited Init(SrcFormatInfo, DstFormatInfo); - - Result := false; - - if (not ConvertAudioFormatToSDL(srcFormatInfo.Format, srcFormat) or - not ConvertAudioFormatToSDL(dstFormatInfo.Format, dstFormat)) then - begin - Log.LogError('Audio-format not supported by SDL', 'TSoftMixerPlaybackStream.InitFormatConversion'); - Exit; - end; - - if (SDL_BuildAudioCVT(@cvt, - srcFormat, srcFormatInfo.Channels, Round(srcFormatInfo.SampleRate), - dstFormat, dstFormatInfo.Channels, Round(dstFormatInfo.SampleRate)) = -1) then - begin - Log.LogError(SDL_GetError(), 'TSoftMixerPlaybackStream.InitFormatConversion'); - Exit; - end; - - Result := true; -end; - -destructor TAudioConverter_SDL.Destroy(); -begin - // nothing to be done here - inherited; -end; - -(* - * Returns the size of the output buffer. This might be bigger than the actual - * size of resampled audio data. - *) -function TAudioConverter_SDL.GetOutputBufferSize(InputSize: integer): integer; -begin - // Note: len_ratio must not be used here. Even if the len_ratio is 1.0, len_mult might be 2. - // Example: 44.1kHz/mono to 22.05kHz/stereo -> len_ratio=1, len_mult=2 - Result := InputSize * cvt.len_mult; -end; - -function TAudioConverter_SDL.GetRatio(): double; -begin - Result := cvt.len_ratio; -end; - -function TAudioConverter_SDL.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; -begin - Result := -1; - - if (InputSize <= 0) then - begin - // avoid div-by-zero problems - if (InputSize = 0) then - Result := 0; - Exit; - end; - - // OutputBuffer is always bigger than or equal to InputBuffer - Move(InputBuffer[0], OutputBuffer[0], InputSize); - cvt.buf := PUint8(OutputBuffer); - cvt.len := InputSize; - if (SDL_ConvertAudio(@cvt) = -1) then - Exit; - - Result := cvt.len_cvt; -end; - - -{$IFDEF UseFFmpegResample} - -function TAudioConverter_FFmpeg.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; -begin - inherited Init(SrcFormatInfo, DstFormatInfo); - - Result := false; - - // Note: ffmpeg does not support resampling for more than 2 input channels - - if (srcFormatInfo.Format <> asfS16) then - begin - Log.LogError('Unsupported format', 'TAudioConverter_FFmpeg.Init'); - Exit; - end; - - // TODO: use SDL here - if (srcFormatInfo.Format <> dstFormatInfo.Format) then - begin - Log.LogError('Incompatible formats', 'TAudioConverter_FFmpeg.Init'); - Exit; - end; - - ResampleContext := audio_resample_init( - dstFormatInfo.Channels, srcFormatInfo.Channels, - Round(dstFormatInfo.SampleRate), Round(srcFormatInfo.SampleRate)); - if (ResampleContext = nil) then - begin - Log.LogError('audio_resample_init() failed', 'TAudioConverter_FFmpeg.Init'); - Exit; - end; - - // calculate ratio - Ratio := (dstFormatInfo.Channels / srcFormatInfo.Channels) * - (dstFormatInfo.SampleRate / srcFormatInfo.SampleRate); - - Result := true; -end; - -destructor TAudioConverter_FFmpeg.Destroy(); -begin - if (ResampleContext <> nil) then - audio_resample_close(ResampleContext); - inherited; -end; - -function TAudioConverter_FFmpeg.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; -var - InputSampleCount: integer; - OutputSampleCount: integer; -begin - Result := -1; - - if (InputSize <= 0) then - begin - // avoid div-by-zero in audio_resample() - if (InputSize = 0) then - Result := 0; - Exit; - end; - - InputSampleCount := InputSize div SrcFormatInfo.FrameSize; - OutputSampleCount := audio_resample( - ResampleContext, PSmallInt(OutputBuffer), PSmallInt(InputBuffer), - InputSampleCount); - if (OutputSampleCount = -1) then - begin - Log.LogError('audio_resample() failed', 'TAudioConverter_FFmpeg.Convert'); - Exit; - end; - Result := OutputSampleCount * DstFormatInfo.FrameSize; -end; - -function TAudioConverter_FFmpeg.GetOutputBufferSize(InputSize: integer): integer; -begin - Result := Ceil(InputSize * GetRatio()); -end; - -function TAudioConverter_FFmpeg.GetRatio(): double; -begin - Result := Ratio; -end; - -{$ENDIF} - - -{$IFDEF UseSRCResample} - -function TAudioConverter_SRC.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; -var - error: integer; - TempSrcFormatInfo: TAudioFormatInfo; - TempDstFormatInfo: TAudioFormatInfo; -begin - inherited Init(SrcFormatInfo, DstFormatInfo); - - Result := false; - - FormatConverter := nil; - - // SRC does not handle channel or format conversion - if ((SrcFormatInfo.Channels <> DstFormatInfo.Channels) or - not (SrcFormatInfo.Format in [asfS16, asfFloat])) then - begin - // SDL can not convert to float, so we have to convert to SInt16 first - TempSrcFormatInfo := TAudioFormatInfo.Create( - SrcFormatInfo.Channels, SrcFormatInfo.SampleRate, SrcFormatInfo.Format); - TempDstFormatInfo := TAudioFormatInfo.Create( - DstFormatInfo.Channels, SrcFormatInfo.SampleRate, asfS16); - - // init format/channel conversion - FormatConverter := TAudioConverter_SDL.Create(); - if (not FormatConverter.Init(TempSrcFormatInfo, TempDstFormatInfo)) then - begin - Log.LogError('Unsupported input format', 'TAudioConverter_SRC.Init'); - FormatConverter.Free; - // exit after the format-info is freed - end; - - // this info was copied so we do not need it anymore - TempSrcFormatInfo.Free; - TempDstFormatInfo.Free; - - // leave if the format is not supported - if (not assigned(FormatConverter)) then - Exit; - - // adjust our copy of the input audio-format for SRC conversion - Self.SrcFormatInfo.Channels := DstFormatInfo.Channels; - Self.SrcFormatInfo.Format := asfS16; - end; - - if ((DstFormatInfo.Format <> asfS16) and - (DstFormatInfo.Format <> asfFloat)) then - begin - Log.LogError('Unsupported output format', 'TAudioConverter_SRC.Init'); - Exit; - end; - - ConversionData.src_ratio := DstFormatInfo.SampleRate / SrcFormatInfo.SampleRate; - if (src_is_valid_ratio(ConversionData.src_ratio) = 0) then - begin - Log.LogError('Invalid samplerate ratio', 'TAudioConverter_SRC.Init'); - Exit; - end; - - ConverterState := src_new(SRC_CONVERTER_TYPE, DstFormatInfo.Channels, @error); - if (ConverterState = nil) then - begin - Log.LogError('src_new() failed: ' + src_strerror(error), 'TAudioConverter_SRC.Init'); - Exit; - end; - - Result := true; -end; - -destructor TAudioConverter_SRC.Destroy(); -begin - if (ConverterState <> nil) then - src_delete(ConverterState); - FormatConverter.Free; - inherited; -end; - -function TAudioConverter_SRC.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; -var - FloatInputBuffer: PSingle; - FloatOutputBuffer: PSingle; - TempBuffer: PChar; - TempSize: integer; - NumSamples: integer; - OutputSize: integer; - error: integer; -begin - Result := -1; - - TempBuffer := nil; - - // format conversion with external converter (to correct number of channels and format) - if (assigned(FormatConverter)) then - begin - TempSize := FormatConverter.GetOutputBufferSize(InputSize); - GetMem(TempBuffer, TempSize); - InputSize := FormatConverter.Convert(InputBuffer, TempBuffer, InputSize); - InputBuffer := TempBuffer; - end; - - if (InputSize <= 0) then - begin - // avoid div-by-zero problems - if (InputSize = 0) then - Result := 0; - if (TempBuffer <> nil) then - FreeMem(TempBuffer); - Exit; - end; - - if (SrcFormatInfo.Format = asfFloat) then - begin - FloatInputBuffer := PSingle(InputBuffer); - end else begin - NumSamples := InputSize div AudioSampleSize[SrcFormatInfo.Format]; - GetMem(FloatInputBuffer, NumSamples * SizeOf(Single)); - src_short_to_float_array(PCshort(InputBuffer), PCfloat(FloatInputBuffer), NumSamples); - end; - - // calculate approx. output size - OutputSize := Ceil(InputSize * ConversionData.src_ratio); - - if (DstFormatInfo.Format = asfFloat) then - begin - FloatOutputBuffer := PSingle(OutputBuffer); - end else begin - NumSamples := OutputSize div AudioSampleSize[DstFormatInfo.Format]; - GetMem(FloatOutputBuffer, NumSamples * SizeOf(Single)); - end; - - with ConversionData do - begin - data_in := PCFloat(FloatInputBuffer); - input_frames := InputSize div SrcFormatInfo.FrameSize; - data_out := PCFloat(FloatOutputBuffer); - output_frames := OutputSize div DstFormatInfo.FrameSize; - // TODO: set this to 1 at end of file-playback - end_of_input := 0; - end; - - error := src_process(ConverterState, @ConversionData); - if (error <> 0) then - begin - Log.LogError(src_strerror(error), 'TAudioConverter_SRC.Convert'); - if (SrcFormatInfo.Format <> asfFloat) then - FreeMem(FloatInputBuffer); - if (DstFormatInfo.Format <> asfFloat) then - FreeMem(FloatOutputBuffer); - if (TempBuffer <> nil) then - FreeMem(TempBuffer); - Exit; - end; - - if (SrcFormatInfo.Format <> asfFloat) then - FreeMem(FloatInputBuffer); - - if (DstFormatInfo.Format <> asfFloat) then - begin - NumSamples := ConversionData.output_frames_gen * DstFormatInfo.Channels; - src_float_to_short_array(PCfloat(FloatOutputBuffer), PCshort(OutputBuffer), NumSamples); - FreeMem(FloatOutputBuffer); - end; - - // free format conversion buffer if used - if (TempBuffer <> nil) then - FreeMem(TempBuffer); - - if (assigned(FormatConverter)) then - InputSize := ConversionData.input_frames_used * FormatConverter.SrcFormatInfo.FrameSize - else - InputSize := ConversionData.input_frames_used * SrcFormatInfo.FrameSize; - - // set result to output size according to SRC - Result := ConversionData.output_frames_gen * DstFormatInfo.FrameSize; -end; - -function TAudioConverter_SRC.GetOutputBufferSize(InputSize: integer): integer; -begin - Result := Ceil(InputSize * GetRatio()); -end; - -function TAudioConverter_SRC.GetRatio(): double; -begin - // if we need additional channel/format conversion, use this ratio - if (assigned(FormatConverter)) then - Result := FormatConverter.GetRatio() - else - Result := 1.0; - - // now the SRC ratio (Note: the format might change from SInt16 to float) - Result := Result * - ConversionData.src_ratio * - (DstFormatInfo.FrameSize / SrcFormatInfo.FrameSize); -end; - -{$ENDIF} - -end. \ No newline at end of file diff --git a/src/Classes/UAudioCore_Bass.pas b/src/Classes/UAudioCore_Bass.pas deleted file mode 100644 index beb2db16..00000000 --- a/src/Classes/UAudioCore_Bass.pas +++ /dev/null @@ -1,123 +0,0 @@ -unit UAudioCore_Bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - SysUtils, - UMusic, - bass; // (Note: DWORD is defined here) - -type - TAudioCore_Bass = class - public - constructor Create(); - class function GetInstance(): TAudioCore_Bass; - function ErrorGetString(): string; overload; - function ErrorGetString(errCode: integer): string; overload; - function ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean; - function ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean; - end; - -implementation - -uses - UMain, - ULog; - -var - Instance: TAudioCore_Bass; - -constructor TAudioCore_Bass.Create(); -begin - inherited; -end; - -class function TAudioCore_Bass.GetInstance(): TAudioCore_Bass; -begin - if (not Assigned(Instance)) then - Instance := TAudioCore_Bass.Create(); - Result := Instance; -end; - -function TAudioCore_Bass.ErrorGetString(): string; -begin - Result := ErrorGetString(BASS_ErrorGetCode()); -end; - -function TAudioCore_Bass.ErrorGetString(errCode: integer): string; -begin - case errCode of - BASS_OK: result := 'No error'; - BASS_ERROR_MEM: result := 'Insufficient memory'; - BASS_ERROR_FILEOPEN: result := 'File could not be opened'; - BASS_ERROR_DRIVER: result := 'Device driver not available'; - BASS_ERROR_BUFLOST: result := 'Buffer lost'; - BASS_ERROR_HANDLE: result := 'Invalid Handle'; - BASS_ERROR_FORMAT: result := 'Sample-Format not supported'; - BASS_ERROR_POSITION: result := 'Illegal position'; - BASS_ERROR_INIT: result := 'BASS_Init has not been successfully called'; - BASS_ERROR_START: result := 'Paused/stopped'; - BASS_ERROR_ALREADY: result := 'Already created/used'; - BASS_ERROR_NOCHAN: result := 'No free channels'; - BASS_ERROR_ILLTYPE: result := 'Type is invalid'; - BASS_ERROR_ILLPARAM: result := 'Illegal parameter'; - BASS_ERROR_NO3D: result := 'No 3D support'; - BASS_ERROR_NOEAX: result := 'No EAX support'; - BASS_ERROR_DEVICE: result := 'Invalid device number'; - BASS_ERROR_NOPLAY: result := 'Channel not playing'; - BASS_ERROR_FREQ: result := 'Freq out of range'; - BASS_ERROR_NOTFILE: result := 'Not a file stream'; - BASS_ERROR_NOHW: result := 'No hardware support'; - BASS_ERROR_EMPTY: result := 'Is empty'; - BASS_ERROR_NONET: result := 'Network unavailable'; - BASS_ERROR_CREATE: result := 'Creation error'; - BASS_ERROR_NOFX: result := 'DX8 effects unavailable'; - BASS_ERROR_NOTAVAIL: result := 'Not available'; - BASS_ERROR_DECODE: result := 'Is a decoding channel'; - BASS_ERROR_DX: result := 'Insufficient version of DirectX'; - BASS_ERROR_TIMEOUT: result := 'Timeout'; - BASS_ERROR_FILEFORM: result := 'File-Format not recognised/supported'; - BASS_ERROR_SPEAKER: result := 'Requested speaker(s) not support'; - BASS_ERROR_VERSION: result := 'Version error'; - BASS_ERROR_CODEC: result := 'Codec not available/supported'; - BASS_ERROR_ENDED: result := 'The channel/file has ended'; - BASS_ERROR_UNKNOWN: result := 'Unknown error'; - else result := 'Unknown error'; - end; -end; - -function TAudioCore_Bass.ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean; -begin - case Format of - asfS16: Flags := 0; - asfFloat: Flags := BASS_SAMPLE_FLOAT; - asfU8: Flags := BASS_SAMPLE_8BITS; - else begin - Result := false; - Exit; - end; - end; - - Result := true; -end; - -function TAudioCore_Bass.ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean; -begin - if ((Flags and BASS_SAMPLE_FLOAT) <> 0) then - Format := asfFloat - else if ((Flags and BASS_SAMPLE_8BITS) <> 0) then - Format := asfU8 - else - Format := asfS16; - - Result := true; -end; - -end. diff --git a/src/Classes/UAudioCore_Portaudio.pas b/src/Classes/UAudioCore_Portaudio.pas deleted file mode 100644 index bcc8a001..00000000 --- a/src/Classes/UAudioCore_Portaudio.pas +++ /dev/null @@ -1,257 +0,0 @@ -unit UAudioCore_Portaudio; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I ../switches.inc} - - -uses - Classes, - SysUtils, - portaudio; - -type - TAudioCore_Portaudio = class - public - constructor Create(); - class function GetInstance(): TAudioCore_Portaudio; - function GetPreferredApiIndex(): TPaHostApiIndex; - function TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean; - end; - -implementation - -uses - ULog; - -{* - * The default API used by Portaudio is the least common denominator - * and might lack efficiency. In addition it might not even work. - * We use an array named ApiPreferenceOrder with which we define the order of - * preferred APIs to use. The first API-type in the list is tried first. - * If it is not available the next one is tried and so on ... - * If none of the preferred APIs was found the default API (detected by - * portaudio) is used. - * - * Pascal does not permit zero-length static arrays, so you must use paDefaultApi - * as an array's only member if you do not have any preferences. - * You can also append paDefaultApi to a non-zero length preferences array but - * this is optional because the default API is always used as a fallback. - *} -const - paDefaultApi = -1; -const - ApiPreferenceOrder: -{$IF Defined(MSWINDOWS)} - // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment - // Note2: Windows Default-API is MME, but DirectSound is faster - array[0..0] of TPaHostApiTypeId = ( paDirectSound ); -{$ELSEIF Defined(LINUX)} - // Note: Portmixer has no mixer support for JACK at the moment - array[0..2] of TPaHostApiTypeId = ( paALSA, paJACK, paOSS ); -{$ELSEIF Defined(DARWIN)} - array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); // paCoreAudio -{$ELSE} - array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); -{$IFEND} - - -{ TAudioInput_Portaudio } - -var - Instance: TAudioCore_Portaudio; - -constructor TAudioCore_Portaudio.Create(); -begin - inherited; -end; - -class function TAudioCore_Portaudio.GetInstance(): TAudioCore_Portaudio; -begin - if not assigned(Instance) then - Instance := TAudioCore_Portaudio.Create(); - Result := Instance; -end; - -function TAudioCore_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex; -var - i: integer; - apiIndex: TPaHostApiIndex; - apiInfo: PPaHostApiInfo; -begin - result := -1; - - // select preferred sound-API - for i:= 0 to High(ApiPreferenceOrder) do - begin - if(ApiPreferenceOrder[i] <> paDefaultApi) then - begin - // check if API is available - apiIndex := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]); - if(apiIndex >= 0) then - begin - // we found an API but we must check if it works - // (on linux portaudio might detect OSS but does not provide - // any devices if ALSA is enabled) - apiInfo := Pa_GetHostApiInfo(apiIndex); - if (apiInfo^.deviceCount > 0) then - begin - Result := apiIndex; - break; - end; - end; - end; - end; - - // None of the preferred APIs is available -> use default - if(result < 0) then - begin - result := Pa_GetDefaultHostApi(); - end; -end; - -{* - * Portaudio test callback used by TestDevice(). - *} -function TestCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; -begin - // this callback is called only once - result := paAbort; -end; - -(* - * Tests if the callback works. Some devices can be opened without - * an error but the callback is never called. Calling Pa_StopStream() on such - * a stream freezes USDX then. Probably because the callback-thread is deadlocked - * due to some bug in portaudio. The blocking Pa_ReadStream() and Pa_WriteStream() - * block forever too and though can't be used for testing. - * - * To avoid freezing Pa_AbortStream (or Pa_CloseStream which calls Pa_AbortStream) - * can be used to force the stream to stop. But for some reason this stops debugging - * in gdb with a "no process found" message. - * - * Because freezing devices are non-working devices we test the devices here to - * be able to exclude them from the device-selection list. - * - * Portaudio does not provide any test to check this error case (probably because - * it should not even occur). So we have to open the device, start the stream and - * check if the callback is called (the stream is stopped if the callback is called - * for the first time, so we can poll until the stream is stopped). - * - * Another error that occurs is that some devices (even the default device) might - * work at the beginning but stop after a few calls (maybe 50) of the callback. - * For me this problem occurs with the default output-device. The "dmix" or "front" - * device must be selected instead. Another problem is that (due to a bug in - * portaudio or ALSA) the "front" device is not detected every time portaudio - * is started. Sometimes it needs two or more restarts. - * - * There is no reasonable way to test for these errors. For the first error-case - * we could test if the callback is called 50 times but this can take a second - * for each device and it can fail in the 51st or even 100th callback call then. - * - * The second error-case cannot be tested at all. How should we now that one - * device is missing if portaudio is not even able to detect it. - * We could start and terminate Portaudio for several times and see if the device - * count changes but this is ugly. - * - * Conclusion: We are not able to autodetect a working device with - * portaudio (at least not with the newest v19_20071207) at the moment. - * So we have to provide the possibility to manually select an output device - * in the UltraStar options if we want to use portaudio instead of SDL. - *) -function TAudioCore_Portaudio.TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean; -var - stream: PPaStream; - err: TPaError; - cbWorks: boolean; - cbPolls: integer; - i: integer; -const - altSampleRates: array[0..1] of Double = (44100, 48000); // alternative sample-rates -begin - Result := false; - - if (sampleRate <= 0) then - sampleRate := 44100; - - // check if device supports our input-format - err := Pa_IsFormatSupported(inParams, outParams, sampleRate); - if(err <> paNoError) then - begin - // we cannot fix the error -> exit - if (err <> paInvalidSampleRate) then - Exit; - - // try alternative sample-rates to the detected one - sampleRate := 0; - for i := 0 to High(altSampleRates) do - begin - // do not check the detected sample-rate twice - if (altSampleRates[i] = sampleRate) then - continue; - // check alternative - err := Pa_IsFormatSupported(inParams, outParams, altSampleRates[i]); - if (err = paNoError) then - begin - // sample-rate works - sampleRate := altSampleRates[i]; - break; - end; - end; - // no working sample-rate found - if (sampleRate = 0) then - Exit; - end; - - // FIXME: for some reason gdb stops after a call of Pa_AbortStream() - // which is implicitely called by Pa_CloseStream(). - // gdb's stops with the message: "ptrace: no process found". - // Probably because the callback-thread is killed what confuses gdb. - {$IF Defined(Debug) and Defined(Linux)} - cbWorks := true; - {$ELSE} - // open device for testing - err := Pa_OpenStream(stream, inParams, outParams, sampleRate, - paFramesPerBufferUnspecified, - paNoFlag, @TestCallback, nil); - if(err <> paNoError) then - begin - exit; - end; - - // start the callback - err := Pa_StartStream(stream); - if(err <> paNoError) then - begin - Pa_CloseStream(stream); - exit; - end; - - cbWorks := false; - // check if the callback was called (poll for max. 200ms) - for cbPolls := 1 to 20 do - begin - // if the test-callback was called it should be aborted now - if (Pa_IsStreamActive(stream) = 0) then - begin - cbWorks := true; - break; - end; - // not yet aborted, wait and try (poll) again - Pa_Sleep(10); - end; - - // finally abort the stream - Pa_CloseStream(stream); - {$IFEND} - - Result := cbWorks; -end; - -end. diff --git a/src/Classes/UAudioDecoder_Bass.pas b/src/Classes/UAudioDecoder_Bass.pas deleted file mode 100644 index dba1fde4..00000000 --- a/src/Classes/UAudioDecoder_Bass.pas +++ /dev/null @@ -1,242 +0,0 @@ -unit UAudioDecoder_Bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -implementation - -uses - Classes, - SysUtils, - UMain, - UMusic, - UAudioCore_Bass, - ULog, - bass; - -type - TBassDecodeStream = class(TAudioDecodeStream) - private - Handle: HSTREAM; - FormatInfo : TAudioFormatInfo; - Error: boolean; - public - constructor Create(Handle: HSTREAM); - destructor Destroy(); override; - - procedure Close(); override; - - function GetLength(): real; override; - function GetAudioFormatInfo(): TAudioFormatInfo; override; - function GetPosition: real; override; - procedure SetPosition(Time: real); override; - function GetLoop(): boolean; override; - procedure SetLoop(Enabled: boolean); override; - function IsEOF(): boolean; override; - function IsError(): boolean; override; - - function ReadData(Buffer: PChar; BufSize: integer): integer; override; - end; - -type - TAudioDecoder_Bass = class( TInterfacedObject, IAudioDecoder ) - public - function GetName: string; - - function InitializeDecoder(): boolean; - function FinalizeDecoder(): boolean; - function Open(const Filename: string): TAudioDecodeStream; - end; - -var - BassCore: TAudioCore_Bass; - - -{ TBassDecodeStream } - -constructor TBassDecodeStream.Create(Handle: HSTREAM); -var - ChannelInfo: BASS_CHANNELINFO; - Format: TAudioSampleFormat; -begin - inherited Create(); - Self.Handle := Handle; - - // setup format info - if (not BASS_ChannelGetInfo(Handle, ChannelInfo)) then - begin - raise Exception.Create('Failed to open decode-stream'); - end; - BassCore.ConvertBASSFlagsToAudioFormat(ChannelInfo.flags, Format); - FormatInfo := TAudioFormatInfo.Create(ChannelInfo.chans, ChannelInfo.freq, format); - - Error := false; -end; - -destructor TBassDecodeStream.Destroy(); -begin - Close(); - inherited; -end; - -procedure TBassDecodeStream.Close(); -begin - if (Handle <> 0) then - begin - BASS_StreamFree(Handle); - Handle := 0; - end; - PerformOnClose(); - FreeAndNil(FormatInfo); - Error := false; -end; - -function TBassDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo; -begin - Result := FormatInfo; -end; - -function TBassDecodeStream.GetLength(): real; -var - bytes: QWORD; -begin - bytes := BASS_ChannelGetLength(Handle, BASS_POS_BYTE); - Result := BASS_ChannelBytes2Seconds(Handle, bytes); -end; - -function TBassDecodeStream.GetPosition: real; -var - bytes: QWORD; -begin - bytes := BASS_ChannelGetPosition(Handle, BASS_POS_BYTE); - Result := BASS_ChannelBytes2Seconds(Handle, bytes); -end; - -procedure TBassDecodeStream.SetPosition(Time: real); -var - bytes: QWORD; -begin - bytes := BASS_ChannelSeconds2Bytes(Handle, Time); - BASS_ChannelSetPosition(Handle, bytes, BASS_POS_BYTE); -end; - -function TBassDecodeStream.GetLoop(): boolean; -var - flags: DWORD; -begin - // retrieve channel flags - flags := BASS_ChannelFlags(Handle, 0, 0); - if (flags = DWORD(-1)) then - begin - Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.GetLoop'); - Result := false; - Exit; - end; - Result := (flags and BASS_SAMPLE_LOOP) <> 0; -end; - -procedure TBassDecodeStream.SetLoop(Enabled: boolean); -var - flags: DWORD; -begin - // set/unset loop-flag - if (Enabled) then - flags := BASS_SAMPLE_LOOP - else - flags := 0; - - // set new flag-bits - if (BASS_ChannelFlags(Handle, flags, BASS_SAMPLE_LOOP) = DWORD(-1)) then - begin - Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.SetLoop'); - Exit; - end; -end; - -function TBassDecodeStream.IsEOF(): boolean; -begin - Result := (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_STOPPED); -end; - -function TBassDecodeStream.IsError(): boolean; -begin - Result := Error; -end; - -function TBassDecodeStream.ReadData(Buffer: PChar; BufSize: integer): integer; -begin - Result := BASS_ChannelGetData(Handle, Buffer, BufSize); - // check error state (do not handle EOF as error) - if ((Result = -1) and (BASS_ErrorGetCode() <> BASS_ERROR_ENDED)) then - Error := true - else - Error := false; -end; - - -{ TAudioDecoder_Bass } - -function TAudioDecoder_Bass.GetName: String; -begin - result := 'BASS_Decoder'; -end; - -function TAudioDecoder_Bass.InitializeDecoder(): boolean; -begin - BassCore := TAudioCore_Bass.GetInstance(); - Result := true; -end; - -function TAudioDecoder_Bass.FinalizeDecoder(): boolean; -begin - Result := true; -end; - -function TAudioDecoder_Bass.Open(const Filename: string): TAudioDecodeStream; -var - Stream: HSTREAM; - ChannelInfo: BASS_CHANNELINFO; - FileExt: string; -begin - Result := nil; - - // check if BASS was initialized - // in case the decoder is not used with BASS playback, init the NO_SOUND device - if ((integer(BASS_GetDevice) = -1) and (BASS_ErrorGetCode() = BASS_ERROR_INIT)) then - BASS_Init(0, 44100, 0, 0, nil); - - // TODO: use BASS_STREAM_PRESCAN for accurate seeking in VBR-files? - // disadvantage: seeking will slow down. - Stream := BASS_StreamCreateFile(False, PChar(Filename), 0, 0, BASS_STREAM_DECODE); - if (Stream = 0) then - begin - //Log.LogError(BassCore.ErrorGetString(), 'TAudioDecoder_Bass.Open'); - Exit; - end; - - // check if BASS opened some erroneously recognized file-formats - if BASS_ChannelGetInfo(Stream, channelInfo) then - begin - fileExt := ExtractFileExt(Filename); - // BASS opens FLV-files (maybe others too) although it cannot handle them. - // Setting BASS_CONFIG_VERIFY to the max. value (100000) does not help. - if ((fileExt = '.flv') and (channelInfo.ctype = BASS_CTYPE_STREAM_MP1)) then - begin - BASS_StreamFree(Stream); - Exit; - end; - end; - - Result := TBassDecodeStream.Create(Stream); -end; - - -initialization - MediaManager.Add(TAudioDecoder_Bass.Create); - -end. diff --git a/src/Classes/UAudioDecoder_FFmpeg.pas b/src/Classes/UAudioDecoder_FFmpeg.pas deleted file mode 100644 index d9b4c93c..00000000 --- a/src/Classes/UAudioDecoder_FFmpeg.pas +++ /dev/null @@ -1,1114 +0,0 @@ -unit UAudioDecoder_FFmpeg; - -(******************************************************************************* - * - * This unit is primarily based upon - - * http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - * - * and tutorial03.c - * - * http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html - * - *******************************************************************************) - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -// show FFmpeg specific debug output -{.$DEFINE DebugFFmpegDecode} - -// FFmpeg is very verbose and shows a bunch of errors. -// Those errors (they can be considered as warnings by us) can be ignored -// as they do not give any useful information. -// There is no solution to fix this except for turning them off. -{.$DEFINE EnableFFmpegErrorOutput} - -implementation - -uses - Classes, - SysUtils, - Math, - UMusic, - UIni, - UMain, - avcodec, - avformat, - avutil, - avio, - mathematics, // used for av_rescale_q - rational, - UMediaCore_FFmpeg, - SDL, - ULog, - UCommon, - UConfig; - -const - MAX_AUDIOQ_SIZE = (5 * 16 * 1024); - -const - // TODO: The factor 3/2 might not be necessary as we do not need extra - // space for synchronizing as in the tutorial. - AUDIO_BUFFER_SIZE = (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3) div 2; - -type - TFFmpegDecodeStream = class(TAudioDecodeStream) - private - StateLock: PSDL_Mutex; - - EOFState: boolean; // end-of-stream flag (locked by StateLock) - ErrorState: boolean; // error flag (locked by StateLock) - - QuitRequest: boolean; // (locked by StateLock) - ParserIdleCond: PSDL_Cond; - - // parser pause/resume data - ParserLocked: boolean; - ParserPauseRequestCount: integer; - ParserUnlockedCond: PSDL_Cond; - ParserResumeCond: PSDL_Cond; - - SeekRequest: boolean; // (locked by StateLock) - SeekFlags: integer; // (locked by StateLock) - SeekPos: double; // stream position to seek for (in secs) (locked by StateLock) - SeekFlush: boolean; // true if the buffers should be flushed after seeking (locked by StateLock) - SeekFinishedCond: PSDL_Cond; - - Loop: boolean; // (locked by StateLock) - - ParseThread: PSDL_Thread; - PacketQueue: TPacketQueue; - - FormatInfo: TAudioFormatInfo; - - // FFmpeg specific data - FormatCtx: PAVFormatContext; - CodecCtx: PAVCodecContext; - Codec: PAVCodec; - - AudioStreamIndex: integer; - AudioStream: PAVStream; - AudioStreamPos: double; // stream position in seconds (locked by DecoderLock) - - // decoder pause/resume data - DecoderLocked: boolean; - DecoderPauseRequestCount: integer; - DecoderUnlockedCond: PSDL_Cond; - DecoderResumeCond: PSDL_Cond; - - // state-vars for DecodeFrame (locked by DecoderLock) - AudioPaket: TAVPacket; - AudioPaketData: PChar; - AudioPaketSize: integer; - AudioPaketSilence: integer; // number of bytes of silence to return - - // state-vars for AudioCallback (locked by DecoderLock) - AudioBufferPos: integer; - AudioBufferSize: integer; - AudioBuffer: PChar; - - Filename: string; - - procedure SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean); - procedure SetEOF(State: boolean); {$IFDEF HasInline}inline;{$ENDIF} - procedure SetError(State: boolean); {$IFDEF HasInline}inline;{$ENDIF} - function IsSeeking(): boolean; - function IsQuit(): boolean; - - procedure Reset(); - - procedure Parse(); - function ParseLoop(): boolean; - procedure PauseParser(); - procedure ResumeParser(); - - function DecodeFrame(Buffer: PChar; BufferSize: integer): integer; - procedure FlushCodecBuffers(); - procedure PauseDecoder(); - procedure ResumeDecoder(); - public - constructor Create(); - destructor Destroy(); override; - - function Open(const Filename: string): boolean; - procedure Close(); override; - - function GetLength(): real; override; - function GetAudioFormatInfo(): TAudioFormatInfo; override; - function GetPosition: real; override; - procedure SetPosition(Time: real); override; - function GetLoop(): boolean; override; - procedure SetLoop(Enabled: boolean); override; - function IsEOF(): boolean; override; - function IsError(): boolean; override; - - function ReadData(Buffer: PChar; BufferSize: integer): integer; override; - end; - -type - TAudioDecoder_FFmpeg = class( TInterfacedObject, IAudioDecoder ) - public - function GetName: string; - - function InitializeDecoder(): boolean; - function FinalizeDecoder(): boolean; - function Open(const Filename: string): TAudioDecodeStream; - end; - -var - FFmpegCore: TMediaCore_FFmpeg; - -function ParseThreadMain(Data: Pointer): integer; cdecl; forward; - - -{ TFFmpegDecodeStream } - -constructor TFFmpegDecodeStream.Create(); -begin - inherited Create(); - - StateLock := SDL_CreateMutex(); - ParserUnlockedCond := SDL_CreateCond(); - ParserResumeCond := SDL_CreateCond(); - ParserIdleCond := SDL_CreateCond(); - SeekFinishedCond := SDL_CreateCond(); - DecoderUnlockedCond := SDL_CreateCond(); - DecoderResumeCond := SDL_CreateCond(); - - // according to the documentation of avcodec_decode_audio(2), sample-data - // should be aligned on a 16 byte boundary. Otherwise internal calls - // (e.g. to SSE or Altivec operations) might fail or lack performance on some - // CPUs. Although GetMem() in Delphi and FPC seems to use a 16 byte or higher - // alignment for buffers of this size (alignment depends on the size of the - // requested buffer), we will set the alignment explicitly as the minimum - // alignment used by Delphi and FPC is on an 8 byte boundary. - // - // Note: AudioBuffer was previously defined as a field of type TAudioBuffer - // (array[0..AUDIO_BUFFER_SIZE-1] of byte) and hence statically allocated. - // Fields of records are aligned different to memory allocated with GetMem(), - // aligning depending on the type but will be at least 2 bytes. - // AudioBuffer was not aligned to a 16 byte boundary. The {$ALIGN x} directive - // was not applicable as Delphi in contrast to FPC provides at most 8 byte - // alignment ({$ALIGN 16} is not supported) by this directive. - AudioBuffer := GetAlignedMem(AUDIO_BUFFER_SIZE, 16); - - Reset(); -end; - -procedure TFFmpegDecodeStream.Reset(); -begin - ParseThread := nil; - - EOFState := false; - ErrorState := false; - Loop := false; - QuitRequest := false; - - AudioPaketData := nil; - AudioPaketSize := 0; - AudioPaketSilence := 0; - - AudioBufferPos := 0; - AudioBufferSize := 0; - - ParserLocked := false; - ParserPauseRequestCount := 0; - DecoderLocked := false; - DecoderPauseRequestCount := 0; - - FillChar(AudioPaket, SizeOf(TAVPacket), 0); -end; - -{* - * Frees the decode-stream data. - *} -destructor TFFmpegDecodeStream.Destroy(); -begin - Close(); - - SDL_DestroyMutex(StateLock); - SDL_DestroyCond(ParserUnlockedCond); - SDL_DestroyCond(ParserResumeCond); - SDL_DestroyCond(ParserIdleCond); - SDL_DestroyCond(SeekFinishedCond); - SDL_DestroyCond(DecoderUnlockedCond); - SDL_DestroyCond(DecoderResumeCond); - - FreeAlignedMem(AudioBuffer); - - inherited; -end; - -function TFFmpegDecodeStream.Open(const Filename: string): boolean; -var - SampleFormat: TAudioSampleFormat; - AVResult: integer; -begin - Result := false; - - Close(); - Reset(); - - if (not FileExists(Filename)) then - begin - Log.LogError('Audio-file does not exist: "' + Filename + '"', 'UAudio_FFmpeg'); - Exit; - end; - - Self.Filename := Filename; - - // open audio file - if (av_open_input_file(FormatCtx, PChar(Filename), nil, 0, nil) <> 0) then - begin - Log.LogError('av_open_input_file failed: "' + Filename + '"', 'UAudio_FFmpeg'); - Exit; - end; - - // generate PTS values if they do not exist - FormatCtx^.flags := FormatCtx^.flags or AVFMT_FLAG_GENPTS; - - // retrieve stream information - if (av_find_stream_info(FormatCtx) < 0) then - begin - Log.LogError('av_find_stream_info failed: "' + Filename + '"', 'UAudio_FFmpeg'); - Close(); - Exit; - end; - - // FIXME: hack used by ffplay. Maybe should not use url_feof() to test for the end - FormatCtx^.pb.eof_reached := 0; - - {$IFDEF DebugFFmpegDecode} - dump_format(FormatCtx, 0, pchar(Filename), 0); - {$ENDIF} - - AudioStreamIndex := FFmpegCore.FindAudioStreamIndex(FormatCtx); - if (AudioStreamIndex < 0) then - begin - Log.LogError('FindAudioStreamIndex: No Audio-stream found "' + Filename + '"', 'UAudio_FFmpeg'); - Close(); - Exit; - end; - - //Log.LogStatus('AudioStreamIndex is: '+ inttostr(ffmpegStreamID), 'UAudio_FFmpeg'); - - AudioStream := FormatCtx.streams[AudioStreamIndex]; - CodecCtx := AudioStream^.codec; - - // TODO: should we use this or not? Should we allow 5.1 channel audio? - (* - {$IF LIBAVCODEC_VERSION >= 51042000} - if (CodecCtx^.channels > 0) then - CodecCtx^.request_channels := Min(2, CodecCtx^.channels) - else - CodecCtx^.request_channels := 2; - {$IFEND} - *) - - Codec := avcodec_find_decoder(CodecCtx^.codec_id); - if (Codec = nil) then - begin - Log.LogError('Unsupported codec!', 'UAudio_FFmpeg'); - CodecCtx := nil; - Close(); - Exit; - end; - - // set debug options - CodecCtx^.debug_mv := 0; - CodecCtx^.debug := 0; - - // detect bug-workarounds automatically - CodecCtx^.workaround_bugs := FF_BUG_AUTODETECT; - // error resilience strategy (careful/compliant/agressive/very_aggressive) - //CodecCtx^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT; - // allow non spec compliant speedup tricks. - //CodecCtx^.flags2 := CodecCtx^.flags2 or CODEC_FLAG2_FAST; - - // Note: avcodec_open() and avcodec_close() are not thread-safe and will - // fail if called concurrently by different threads. - FFmpegCore.LockAVCodec(); - try - AVResult := avcodec_open(CodecCtx, Codec); - finally - FFmpegCore.UnlockAVCodec(); - end; - if (AVResult < 0) then - begin - Log.LogError('avcodec_open failed!', 'UAudio_FFmpeg'); - Close(); - Exit; - end; - - // now initialize the audio-format - - if (not FFmpegCore.ConvertFFmpegToAudioFormat(CodecCtx^.sample_fmt, SampleFormat)) then - begin - // try standard format - SampleFormat := asfS16; - end; - - FormatInfo := TAudioFormatInfo.Create( - CodecCtx^.channels, - CodecCtx^.sample_rate, - SampleFormat - ); - - - PacketQueue := TPacketQueue.Create(); - - // finally start the decode thread - ParseThread := SDL_CreateThread(@ParseThreadMain, Self); - - Result := true; -end; - -procedure TFFmpegDecodeStream.Close(); -var - ThreadResult: integer; -begin - // wake threads waiting for packet-queue data - // Note: normally, there are no waiting threads. If there were waiting - // ones, they would block the audio-callback thread. - if (assigned(PacketQueue)) then - PacketQueue.Abort(); - - // send quit request (to parse-thread etc) - SDL_mutexP(StateLock); - QuitRequest := true; - SDL_CondBroadcast(ParserIdleCond); - SDL_mutexV(StateLock); - - // abort parse-thread - if (ParseThread <> nil) then - begin - // and wait until it terminates - SDL_WaitThread(ParseThread, ThreadResult); - ParseThread := nil; - end; - - // Close the codec - if (CodecCtx <> nil) then - begin - // avcodec_close() is not thread-safe - FFmpegCore.LockAVCodec(); - try - avcodec_close(CodecCtx); - finally - FFmpegCore.UnlockAVCodec(); - end; - CodecCtx := nil; - end; - - // Close the video file - if (FormatCtx <> nil) then - begin - av_close_input_file(FormatCtx); - FormatCtx := nil; - end; - - PerformOnClose(); - - FreeAndNil(PacketQueue); - FreeAndNil(FormatInfo); -end; - -function TFFmpegDecodeStream.GetLength(): real; -begin - // do not forget to consider the start_time value here - Result := (FormatCtx^.start_time + FormatCtx^.duration) / AV_TIME_BASE; -end; - -function TFFmpegDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo; -begin - Result := FormatInfo; -end; - -function TFFmpegDecodeStream.IsEOF(): boolean; -begin - SDL_mutexP(StateLock); - Result := EOFState; - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.SetEOF(State: boolean); -begin - SDL_mutexP(StateLock); - EOFState := State; - SDL_mutexV(StateLock); -end; - -function TFFmpegDecodeStream.IsError(): boolean; -begin - SDL_mutexP(StateLock); - Result := ErrorState; - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.SetError(State: boolean); -begin - SDL_mutexP(StateLock); - ErrorState := State; - SDL_mutexV(StateLock); -end; - -function TFFmpegDecodeStream.IsSeeking(): boolean; -begin - SDL_mutexP(StateLock); - Result := SeekRequest; - SDL_mutexV(StateLock); -end; - -function TFFmpegDecodeStream.IsQuit(): boolean; -begin - SDL_mutexP(StateLock); - Result := QuitRequest; - SDL_mutexV(StateLock); -end; - -function TFFmpegDecodeStream.GetPosition(): real; -var - BufferSizeSec: double; -begin - PauseDecoder(); - - // ReadData() does not return all of the buffer retrieved by DecodeFrame(). - // Determine the size of the unused part of the decode-buffer. - BufferSizeSec := (AudioBufferSize - AudioBufferPos) / - FormatInfo.BytesPerSec; - - // subtract the size of unused buffer-data from the audio clock. - Result := AudioStreamPos - BufferSizeSec; - - ResumeDecoder(); -end; - -procedure TFFmpegDecodeStream.SetPosition(Time: real); -begin - SetPositionIntern(Time, true, true); -end; - -function TFFmpegDecodeStream.GetLoop(): boolean; -begin - SDL_mutexP(StateLock); - Result := Loop; - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.SetLoop(Enabled: boolean); -begin - SDL_mutexP(StateLock); - Loop := Enabled; - SDL_mutexV(StateLock); -end; - - -(******************************************** - * Parser section - ********************************************) - -procedure TFFmpegDecodeStream.PauseParser(); -begin - if (SDL_ThreadID() = ParseThread.threadid) then - Exit; - - SDL_mutexP(StateLock); - Inc(ParserPauseRequestCount); - while (ParserLocked) do - SDL_CondWait(ParserUnlockedCond, StateLock); - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.ResumeParser(); -begin - if (SDL_ThreadID() = ParseThread.threadid) then - Exit; - - SDL_mutexP(StateLock); - Dec(ParserPauseRequestCount); - SDL_CondSignal(ParserResumeCond); - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean); -begin - // - Pause the parser first to prevent it from putting obsolete packages - // into the queue after the queue was flushed and before seeking is done. - // Otherwise we will hear fragments of old data, if the stream was seeked - // in stopped mode and resumed afterwards (applies to non-blocking mode only). - // - Pause the decoder to avoid race-condition that might occur otherwise. - // - Last lock the state lock because we are manipulating some shared state-vars. - PauseParser(); - PauseDecoder(); - SDL_mutexP(StateLock); - - // configure seek parameters - SeekPos := Time; - SeekFlush := Flush; - SeekFlags := AVSEEK_FLAG_ANY; - SeekRequest := true; - - // Note: the BACKWARD-flag seeks to the first position <= the position - // searched for. Otherwise e.g. position 0 might not be seeked correct. - // For some reason ffmpeg sometimes doesn't use position 0 but the key-frame - // following. In streams with few key-frames (like many flv-files) the next - // key-frame after 0 might be 5secs ahead. - if (Time < AudioStreamPos) then - SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD; - - EOFState := false; - ErrorState := false; - - // send a reuse signal in case the parser was stopped (e.g. because of an EOF) - SDL_CondSignal(ParserIdleCond); - - SDL_mutexV(StateLock); - ResumeDecoder(); - ResumeParser(); - - // in blocking mode, wait until seeking is done - if (Blocking) then - begin - SDL_mutexP(StateLock); - while (SeekRequest) do - SDL_CondWait(SeekFinishedCond, StateLock); - SDL_mutexV(StateLock); - end; -end; - -function ParseThreadMain(Data: Pointer): integer; cdecl; -var - Stream: TFFmpegDecodeStream; -begin - Stream := TFFmpegDecodeStream(Data); - if (Stream <> nil) then - Stream.Parse(); - Result := 0; -end; - -procedure TFFmpegDecodeStream.Parse(); -begin - // reuse thread as long as the stream is not terminated - while (ParseLoop()) do - begin - // wait for reuse or destruction of stream - SDL_mutexP(StateLock); - while (not (SeekRequest or QuitRequest)) do - SDL_CondWait(ParserIdleCond, StateLock); - SDL_mutexV(StateLock); - end; -end; - -(** - * Parser main loop. - * Will not return until parsing of the stream is finished. - * Reasons for the parser to return are: - * - the end-of-file is reached - * - an error occured - * - the stream was quited (received a quit-request) - * Returns true if the stream can be resumed or false if the stream has to - * be terminated. - *) -function TFFmpegDecodeStream.ParseLoop(): boolean; -var - Packet: TAVPacket; - StatusPacket: PAVPacket; - SeekTarget: int64; - ByteIOCtx: PByteIOContext; - ErrorCode: integer; - StartSilence: double; // duration of silence at start of stream - StartSilencePtr: PDouble; // pointer for the EMPTY status packet - - // Note: pthreads wakes threads waiting on a mutex in the order of their - // priority and not in FIFO order. SDL does not provide any option to - // control priorities. This might (and already did) starve threads waiting - // on the mutex (e.g. SetPosition) making usdx look like it was froozen. - // Instead of simply locking the critical section we set a ParserLocked flag - // instead and give priority to the threads requesting the parser to pause. - procedure LockParser(); - begin - SDL_mutexP(StateLock); - while (ParserPauseRequestCount > 0) do - SDL_CondWait(ParserResumeCond, StateLock); - ParserLocked := true; - SDL_mutexV(StateLock); - end; - - procedure UnlockParser(); - begin - SDL_mutexP(StateLock); - ParserLocked := false; - SDL_CondBroadcast(ParserUnlockedCond); - SDL_mutexV(StateLock); - end; - -begin - Result := true; - - while (true) do - begin - LockParser(); - try - - if (IsQuit()) then - begin - Result := false; - Exit; - end; - - // handle seek-request (Note: no need to lock SeekRequest here) - if (SeekRequest) then - begin - // first try: seek on the audio stream - SeekTarget := Round(SeekPos / av_q2d(AudioStream^.time_base)); - StartSilence := 0; - if (SeekTarget < AudioStream^.start_time) then - StartSilence := (AudioStream^.start_time - SeekTarget) * av_q2d(AudioStream^.time_base); - ErrorCode := av_seek_frame(FormatCtx, AudioStreamIndex, SeekTarget, SeekFlags); - - if (ErrorCode < 0) then - begin - // second try: seek on the default stream (necessary for flv-videos and some ogg-files) - SeekTarget := Round(SeekPos * AV_TIME_BASE); - StartSilence := 0; - if (SeekTarget < FormatCtx^.start_time) then - StartSilence := (FormatCtx^.start_time - SeekTarget) / AV_TIME_BASE; - ErrorCode := av_seek_frame(FormatCtx, -1, SeekTarget, SeekFlags); - end; - - // pause decoder and lock state (keep the lock-order to avoid deadlocks). - // Note that the decoder does not block in the packet-queue in seeking state, - // so locking the decoder here does not cause a dead-lock. - PauseDecoder(); - SDL_mutexP(StateLock); - try - if (ErrorCode < 0) then - begin - // seeking failed - ErrorState := true; - Log.LogStatus('Seek Error in "'+FormatCtx^.filename+'"', 'UAudioDecoder_FFmpeg'); - end - else - begin - if (SeekFlush) then - begin - // flush queue (we will send a Flush-Packet when seeking is finished) - PacketQueue.Flush(); - - // flush the decode buffers - AudioBufferSize := 0; - AudioBufferPos := 0; - AudioPaketSize := 0; - AudioPaketSilence := 0; - FlushCodecBuffers(); - - // Set preliminary stream position. The position will be set to - // the correct value as soon as the first packet is decoded. - AudioStreamPos := SeekPos; - end - else - begin - // request avcodec buffer flush - PacketQueue.PutStatus(PKT_STATUS_FLAG_FLUSH, nil); - end; - - // fill the gap between position 0 and start_time with silence - // but not if we are in loop mode - if ((StartSilence > 0) and (not Loop)) then - begin - GetMem(StartSilencePtr, SizeOf(StartSilence)); - StartSilencePtr^ := StartSilence; - PacketQueue.PutStatus(PKT_STATUS_FLAG_EMPTY, StartSilencePtr); - end; - end; - - SeekRequest := false; - SDL_CondBroadcast(SeekFinishedCond); - finally - SDL_mutexV(StateLock); - ResumeDecoder(); - end; - end; - - if (PacketQueue.GetSize() > MAX_AUDIOQ_SIZE) then - begin - SDL_Delay(10); - Continue; - end; - - if (av_read_frame(FormatCtx, Packet) < 0) then - begin - // failed to read a frame, check reason - {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)} - ByteIOCtx := FormatCtx^.pb; - {$ELSE} - ByteIOCtx := @FormatCtx^.pb; - {$IFEND} - - // check for end-of-file (eof is not an error) - if (url_feof(ByteIOCtx) <> 0) then - begin - if (GetLoop()) then - begin - // rewind stream (but do not flush) - SetPositionIntern(0, false, false); - Continue; - end - else - begin - // signal end-of-file - PacketQueue.PutStatus(PKT_STATUS_FLAG_EOF, nil); - Exit; - end; - end; - - // check for errors - if (url_ferror(ByteIOCtx) <> 0) then - begin - // an error occured -> abort and wait for repositioning or termination - PacketQueue.PutStatus(PKT_STATUS_FLAG_ERROR, nil); - Exit; - end; - - // no error -> wait for user input - SDL_Delay(100); - Continue; - end; - - if (Packet.stream_index = AudioStreamIndex) then - PacketQueue.Put(@Packet) - else - av_free_packet(@Packet); - - finally - UnlockParser(); - end; - end; -end; - - -(******************************************** - * Decoder section - ********************************************) - -procedure TFFmpegDecodeStream.PauseDecoder(); -begin - SDL_mutexP(StateLock); - Inc(DecoderPauseRequestCount); - while (DecoderLocked) do - SDL_CondWait(DecoderUnlockedCond, StateLock); - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.ResumeDecoder(); -begin - SDL_mutexP(StateLock); - Dec(DecoderPauseRequestCount); - SDL_CondSignal(DecoderResumeCond); - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.FlushCodecBuffers(); -begin - // if no flush operation is specified, avcodec_flush_buffers will not do anything. - if (@CodecCtx.codec.flush <> nil) then - begin - // flush buffers used by avcodec_decode_audio, etc. - avcodec_flush_buffers(CodecCtx); - end - else - begin - // we need a Workaround to avoid plopping noise with ogg-vorbis and - // mp3 (in older versions of FFmpeg). - // We will just reopen the codec. - FFmpegCore.LockAVCodec(); - try - avcodec_close(CodecCtx); - avcodec_open(CodecCtx, Codec); - finally - FFmpegCore.UnlockAVCodec(); - end; - end; -end; - -function TFFmpegDecodeStream.DecodeFrame(Buffer: PChar; BufferSize: integer): integer; -var - PaketDecodedSize: integer; // size of packet data used for decoding - DataSize: integer; // size of output data decoded by FFmpeg - BlockQueue: boolean; - SilenceDuration: double; - {$IFDEF DebugFFmpegDecode} - TmpPos: double; - {$ENDIF} -begin - Result := -1; - - if (EOF) then - Exit; - - while(true) do - begin - // for titles with start_time > 0 we have to generate silence - // until we reach the pts of the first data packet. - if (AudioPaketSilence > 0) then - begin - DataSize := Min(AudioPaketSilence, BufferSize); - FillChar(Buffer[0], DataSize, 0); - Dec(AudioPaketSilence, DataSize); - AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec; - Result := DataSize; - Exit; - end; - - // read packet data - while (AudioPaketSize > 0) do - begin - DataSize := BufferSize; - - {$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0 - PaketDecodedSize := avcodec_decode_audio2(CodecCtx, PSmallint(Buffer), - DataSize, AudioPaketData, AudioPaketSize); - {$ELSE} - PaketDecodedSize := avcodec_decode_audio(CodecCtx, PSmallint(Buffer), - DataSize, AudioPaketData, AudioPaketSize); - {$IFEND} - - if(PaketDecodedSize < 0) then - begin - // if error, skip frame - {$IFDEF DebugFFmpegDecode} - DebugWriteln('Skip audio frame'); - {$ENDIF} - AudioPaketSize := 0; - Break; - end; - - Inc(AudioPaketData, PaketDecodedSize); - Dec(AudioPaketSize, PaketDecodedSize); - - // check if avcodec_decode_audio returned data, otherwise fetch more frames - if (DataSize <= 0) then - Continue; - - // update stream position by the amount of fetched data - AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec; - - // we have data, return it and come back for more later - Result := DataSize; - Exit; - end; - - // free old packet data - if (AudioPaket.data <> nil) then - av_free_packet(@AudioPaket); - - // do not block queue on seeking (to avoid deadlocks on the DecoderLock) - if (IsSeeking()) then - BlockQueue := false - else - BlockQueue := true; - - // request a new packet and block if none available. - // If this fails, the queue was aborted. - if (PacketQueue.Get(AudioPaket, BlockQueue) <= 0) then - Exit; - - // handle Status-packet - if (PChar(AudioPaket.data) = STATUS_PACKET) then - begin - AudioPaket.data := nil; - AudioPaketData := nil; - AudioPaketSize := 0; - - case (AudioPaket.flags) of - PKT_STATUS_FLAG_FLUSH: - begin - // just used if SetPositionIntern was called without the flush flag. - FlushCodecBuffers; - end; - PKT_STATUS_FLAG_EOF: // end-of-file - begin - // ignore EOF while seeking - if (not IsSeeking()) then - SetEOF(true); - // buffer contains no data -> result = -1 - Exit; - end; - PKT_STATUS_FLAG_ERROR: - begin - SetError(true); - Log.LogStatus('I/O Error', 'TFFmpegDecodeStream.DecodeFrame'); - Exit; - end; - PKT_STATUS_FLAG_EMPTY: - begin - SilenceDuration := PDouble(PacketQueue.GetStatusInfo(AudioPaket))^; - AudioPaketSilence := Round(SilenceDuration * FormatInfo.SampleRate) * FormatInfo.FrameSize; - PacketQueue.FreeStatusInfo(AudioPaket); - end - else - begin - Log.LogStatus('Unknown status', 'TFFmpegDecodeStream.DecodeFrame'); - end; - end; - - Continue; - end; - - AudioPaketData := PChar(AudioPaket.data); - AudioPaketSize := AudioPaket.size; - - // if available, update the stream position to the presentation time of this package - if(AudioPaket.pts <> AV_NOPTS_VALUE) then - begin - {$IFDEF DebugFFmpegDecode} - TmpPos := AudioStreamPos; - {$ENDIF} - AudioStreamPos := av_q2d(AudioStream^.time_base) * AudioPaket.pts; - {$IFDEF DebugFFmpegDecode} - DebugWriteln('Timestamp: ' + floattostrf(AudioStreamPos, ffFixed, 15, 3) + ' ' + - '(Calc: ' + floattostrf(TmpPos, ffFixed, 15, 3) + '), ' + - 'Diff: ' + floattostrf(AudioStreamPos-TmpPos, ffFixed, 15, 3)); - {$ENDIF} - end; - end; -end; - -function TFFmpegDecodeStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -var - CopyByteCount: integer; // number of bytes to copy - RemainByteCount: integer; // number of bytes left (remain) to read - BufferPos: integer; - - // prioritize pause requests - procedure LockDecoder(); - begin - SDL_mutexP(StateLock); - while (DecoderPauseRequestCount > 0) do - SDL_CondWait(DecoderResumeCond, StateLock); - DecoderLocked := true; - SDL_mutexV(StateLock); - end; - - procedure UnlockDecoder(); - begin - SDL_mutexP(StateLock); - DecoderLocked := false; - SDL_CondBroadcast(DecoderUnlockedCond); - SDL_mutexV(StateLock); - end; - -begin - Result := -1; - - // set number of bytes to copy to the output buffer - BufferPos := 0; - - LockDecoder(); - try - // leave if end-of-file is reached - if (EOF) then - Exit; - - // copy data to output buffer - while (BufferPos < BufferSize) do - begin - // check if we need more data - if (AudioBufferPos >= AudioBufferSize) then - begin - AudioBufferPos := 0; - - // we have already sent all our data; get more - AudioBufferSize := DecodeFrame(AudioBuffer, AUDIO_BUFFER_SIZE); - - // check for errors or EOF - if(AudioBufferSize < 0) then - begin - Result := BufferPos; - Exit; - end; - end; - - // calc number of new bytes in the decode-buffer - CopyByteCount := AudioBufferSize - AudioBufferPos; - // resize copy-count if more bytes available than needed (remaining bytes are used the next time) - RemainByteCount := BufferSize - BufferPos; - if (CopyByteCount > RemainByteCount) then - CopyByteCount := RemainByteCount; - - Move(AudioBuffer[AudioBufferPos], Buffer[BufferPos], CopyByteCount); - - Inc(BufferPos, CopyByteCount); - Inc(AudioBufferPos, CopyByteCount); - end; - finally - UnlockDecoder(); - end; - - Result := BufferSize; -end; - - -{ TAudioDecoder_FFmpeg } - -function TAudioDecoder_FFmpeg.GetName: String; -begin - Result := 'FFmpeg_Decoder'; -end; - -function TAudioDecoder_FFmpeg.InitializeDecoder: boolean; -begin - //Log.LogStatus('InitializeDecoder', 'UAudioDecoder_FFmpeg'); - FFmpegCore := TMediaCore_FFmpeg.GetInstance(); - av_register_all(); - - // Do not show uninformative error messages by default. - // FFmpeg prints all error-infos on the console by default what - // is very confusing as the playback of the files is correct. - // We consider these errors to be internal to FFMpeg. They can be fixed - // by the FFmpeg guys only and do not provide any useful information in - // respect to USDX. - {$IFNDEF EnableFFmpegErrorOutput} - {$IF LIBAVUTIL_VERSION_MAJOR >= 50} - av_log_set_level(AV_LOG_FATAL); - {$ELSE} - // FATAL and ERROR share one log-level, so we have to use QUIET - av_log_set_level(AV_LOG_QUIET); - {$IFEND} - {$ENDIF} - - Result := true; -end; - -function TAudioDecoder_FFmpeg.FinalizeDecoder(): boolean; -begin - Result := true; -end; - -function TAudioDecoder_FFmpeg.Open(const Filename: string): TAudioDecodeStream; -var - Stream: TFFmpegDecodeStream; -begin - Result := nil; - - Stream := TFFmpegDecodeStream.Create(); - if (not Stream.Open(Filename)) then - begin - Stream.Free; - Exit; - end; - - Result := Stream; -end; - - -initialization - MediaManager.Add(TAudioDecoder_FFmpeg.Create); - -end. diff --git a/src/Classes/UAudioInput_Bass.pas b/src/Classes/UAudioInput_Bass.pas deleted file mode 100644 index 65a4704d..00000000 --- a/src/Classes/UAudioInput_Bass.pas +++ /dev/null @@ -1,481 +0,0 @@ -unit UAudioInput_Bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses - Classes, - SysUtils, - URecord, - UMusic; - -implementation - -uses - UMain, - UIni, - ULog, - UAudioCore_Bass, - UCommon, // (Note: for MakeLong on non-windows platforms) - {$IFDEF MSWINDOWS} - Windows, // (Note: for MakeLong) - {$ENDIF} - bass; // (Note: DWORD is redefined here -> insert after Windows-unit) - -type - TAudioInput_Bass = class(TAudioInputBase) - private - function EnumDevices(): boolean; - public - function GetName: String; override; - function InitializeRecord: boolean; override; - function FinalizeRecord: boolean; override; - end; - - TBassInputDevice = class(TAudioInputDevice) - private - RecordStream: HSTREAM; - BassDeviceID: DWORD; // DeviceID used by BASS - SingleIn: boolean; - - function SetInputSource(SourceIndex: integer): boolean; - function GetInputSource(): integer; - public - function Open(): boolean; - function Close(): boolean; - function Start(): boolean; override; - function Stop(): boolean; override; - - function GetVolume(): single; override; - procedure SetVolume(Volume: single); override; - end; - -var - BassCore: TAudioCore_Bass; - - -{ Global } - -{* - * Bass input capture callback. - * Params: - * stream - BASS input stream - * buffer - buffer of captured samples - * len - size of buffer in bytes - * user - players associated with left/right channels - *} -function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; - len: Cardinal; inputDevice: Pointer): boolean; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} -begin - AudioInputProcessor.HandleMicrophoneData(buffer, len, inputDevice); - Result := true; -end; - - -{ TBassInputDevice } - -function TBassInputDevice.GetInputSource(): integer; -var - SourceCnt: integer; - i: integer; - flags: DWORD; -begin - // get input-source config (subtract virtual device to get BASS indices) - SourceCnt := Length(Source)-1; - - // find source - Result := -1; - for i := 0 to SourceCnt-1 do - begin - // get input settings - flags := BASS_RecordGetInput(i, PSingle(nil)^); - if (flags = DWORD(-1)) then - begin - Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource'); - Exit; - end; - - // check if current source is selected - if ((flags and BASS_INPUT_OFF) = 0) then - begin - // selected source found - Result := i; - Exit; - end; - end; -end; - -function TBassInputDevice.SetInputSource(SourceIndex: integer): boolean; -var - SourceCnt: integer; - i: integer; - flags: DWORD; -begin - Result := false; - - // check for invalid source index - if (SourceIndex < 0) then - Exit; - - // get input-source config (subtract virtual device to get BASS indices) - SourceCnt := Length(Source)-1; - - // turn on selected source (turns off the others for single-in devices) - if (not BASS_RecordSetInput(SourceIndex, BASS_INPUT_ON, -1)) then - begin - Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start'); - Exit; - end; - - // turn off all other sources (not needed for single-in devices) - if (not SingleIn) then - begin - for i := 0 to SourceCnt-1 do - begin - if (i = SourceIndex) then - continue; - // get input settings - flags := BASS_RecordGetInput(i, PSingle(nil)^); - if (flags = DWORD(-1)) then - begin - Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource'); - Exit; - end; - // deselect source if selected - if ((flags and BASS_INPUT_OFF) = 0) then - BASS_RecordSetInput(i, BASS_INPUT_OFF, -1); - end; - end; - - Result := true; -end; - -function TBassInputDevice.Open(): boolean; -var - FormatFlags: DWORD; - SourceIndex: integer; -const - latency = 20; // 20ms callback period (= latency) -begin - Result := false; - - if (not BASS_RecordInit(BassDeviceID)) then - begin - Log.LogError('BASS_RecordInit['+Name+']: ' + - BassCore.ErrorGetString(), 'TBassInputDevice.Open'); - Exit; - end; - - if (not BassCore.ConvertAudioFormatToBASSFlags(AudioFormat.Format, FormatFlags)) then - begin - Log.LogError('Unhandled sample-format', 'TBassInputDevice.Open'); - Exit; - end; - - // start capturing in paused state - RecordStream := BASS_RecordStart(Round(AudioFormat.SampleRate), AudioFormat.Channels, - MakeLong(FormatFlags or BASS_RECORD_PAUSE, latency), - @MicrophoneCallback, Self); - if (RecordStream = 0) then - begin - Log.LogError('BASS_RecordStart: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Open'); - BASS_RecordFree; - Exit; - end; - - // save current source selection and select new source - SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; - if (SourceIndex = -1) then - begin - // nothing to do if default source is used - SourceRestore := -1; - end - else - begin - // store current source-index and select new source - SourceRestore := GetInputSource(); - SetInputSource(SourceIndex); - end; - - Result := true; -end; - -{* Start input-capturing on this device. *} -function TBassInputDevice.Start(): boolean; -begin - Result := false; - - // recording already started -> stop first - if (RecordStream <> 0) then - Stop(); - - // TODO: Do not open the device here (takes too much time). - if not Open() then - Exit; - - if (not BASS_ChannelPlay(RecordStream, true)) then - begin - Log.LogError('BASS_ChannelPlay: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start'); - Exit; - end; - - Result := true; -end; - -{* Stop input-capturing on this device. *} -function TBassInputDevice.Stop(): boolean; -begin - Result := false; - - if (RecordStream = 0) then - Exit; - if (not BASS_RecordSetDevice(BassDeviceID)) then - Exit; - - if (not BASS_ChannelStop(RecordStream)) then - begin - Log.LogError('BASS_ChannelStop: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Stop'); - end; - - // TODO: Do not close the device here (takes too much time). - Result := Close(); -end; - -function TBassInputDevice.Close(): boolean; -begin - // restore source selection - if (SourceRestore >= 0) then - begin - SetInputSource(SourceRestore); - end; - - // free data - if (not BASS_RecordFree()) then - begin - Log.LogError('BASS_RecordFree: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Close'); - Result := false; - end - else - begin - Result := true; - end; - - RecordStream := 0; -end; - -function TBassInputDevice.GetVolume(): single; -var - SourceIndex: integer; - lVolume: Single; -begin - Result := 0; - - SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; - if (SourceIndex = -1) then - begin - // if default source used find selected source - SourceIndex := GetInputSource(); - if (SourceIndex = -1) then - Exit; - end; - - if (BASS_RecordGetInput(SourceIndex, lVolume) = DWORD(-1)) then - begin - Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.GetVolume'); - Exit; - end; - Result := lVolume; -end; - -procedure TBassInputDevice.SetVolume(Volume: single); -var - SourceIndex: integer; -begin - SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; - if (SourceIndex = -1) then - begin - // if default source used find selected source - SourceIndex := GetInputSource(); - if (SourceIndex = -1) then - Exit; - end; - - // clip volume to valid range - if (Volume > 1.0) then - Volume := 1.0 - else if (Volume < 0) then - Volume := 0; - - if (not BASS_RecordSetInput(SourceIndex, 0, Volume)) then - begin - Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.SetVolume'); - end; -end; - - -{ TAudioInput_Bass } - -function TAudioInput_Bass.GetName: String; -begin - result := 'BASS_Input'; -end; - -function TAudioInput_Bass.EnumDevices(): boolean; -var - Descr: PChar; - SourceName: PChar; - Flags: integer; - BassDeviceID: integer; - BassDevice: TBassInputDevice; - DeviceIndex: integer; - DeviceInfo: BASS_DEVICEINFO; - SourceIndex: integer; - RecordInfo: BASS_RECORDINFO; - SelectedSourceIndex: integer; -begin - result := false; - - DeviceIndex := 0; - BassDeviceID := 0; - SetLength(AudioInputProcessor.DeviceList, 0); - - // checks for recording devices and puts them into an array - while true do - begin - if (not BASS_RecordGetDeviceInfo(BassDeviceID, DeviceInfo)) then - break; - - // try to initialize the device - if not BASS_RecordInit(BassDeviceID) then - begin - Log.LogStatus('Failed to initialize BASS Capture-Device['+inttostr(BassDeviceID)+']', - 'TAudioInput_Bass.InitializeRecord'); - end - else - begin - SetLength(AudioInputProcessor.DeviceList, DeviceIndex+1); - - // TODO: free object on termination - BassDevice := TBassInputDevice.Create(); - AudioInputProcessor.DeviceList[DeviceIndex] := BassDevice; - - Descr := DeviceInfo.name; - - BassDevice.BassDeviceID := BassDeviceID; - BassDevice.Name := UnifyDeviceName(Descr, DeviceIndex); - - // zero info-struct as some fields might not be set (e.g. freq is just set on Vista and MacOSX) - FillChar(RecordInfo, SizeOf(RecordInfo), 0); - // retrieve recording device info - BASS_RecordGetInfo(RecordInfo); - - // check if BASS has capture-freq. info - if (RecordInfo.freq > 0) then - begin - // use current input sample rate (available only on Windows Vista and OSX). - // Recording at this rate will give the best quality and performance, as no resampling is required. - // FIXME: does BASS use LSB/MSB or system integer values for 16bit? - BassDevice.AudioFormat := TAudioFormatInfo.Create(2, RecordInfo.freq, asfS16) - end - else - begin - // BASS does not provide an explizit input channel count (except BASS_RECORDINFO.formats) - // but it doesn't fail if we use stereo input on a mono device - // -> use stereo by default - BassDevice.AudioFormat := TAudioFormatInfo.Create(2, 44100, asfS16) - end; - - // get info if multiple input-sources can be selected at once - BassDevice.SingleIn := RecordInfo.singlein; - - // init list for capture buffers per channel - SetLength(BassDevice.CaptureChannel, BassDevice.AudioFormat.Channels); - - BassDevice.MicSource := -1; - BassDevice.SourceRestore := -1; - - // add a virtual default source (will not change mixer-settings) - SetLength(BassDevice.Source, 1); - BassDevice.Source[0].Name := DEFAULT_SOURCE_NAME; - - // add real input sources - SourceIndex := 1; - - // process each input - while true do - begin - SourceName := BASS_RecordGetInputName(SourceIndex-1); - - {$IFDEF DARWIN} - // Under MacOSX the SingStar Mics have an empty InputName. - // So, we have to add a hard coded Workaround for this problem - // FIXME: - Do we need this anymore? Doesn't the (new) default source already solve this problem? - // - Normally a nil return value of BASS_RecordGetInputName() means end-of-list, so maybe - // BASS is not able to detect any mic-sources (the default source will work then). - // - Does BASS_RecordGetInfo() return true or false? If it returns true in this case - // we could use this value to check if the device exists. - // Please check that, eddie. - // If it returns false, then the source is not detected and it does not make sense to add a second - // fake device here. - // What about BASS_RecordGetInput()? Does it return a value <> -1? - // - Does it even work at all with this fake source-index, now that input switching works? - // This info was not used before (sources were never switched), so it did not matter what source-index was used. - // But now BASS_RecordSetInput() will probably fail. - if ((SourceName = nil) and (SourceIndex = 1) and (Pos('USBMIC Serial#', Descr) > 0)) then - SourceName := 'Microphone' - {$ENDIF} - - if (SourceName = nil) then - break; - - SetLength(BassDevice.Source, Length(BassDevice.Source)+1); - BassDevice.Source[SourceIndex].Name := SourceName; - - // get input-source info - Flags := BASS_RecordGetInput(SourceIndex, PSingle(nil)^); - if (Flags <> -1) then - begin - // is the current source a mic-source? - if ((Flags and BASS_INPUT_TYPE_MIC) <> 0) then - BassDevice.MicSource := SourceIndex; - end; - - Inc(SourceIndex); - end; - - // FIXME: this call hangs in FPC (windows) every 2nd time USDX is called. - // Maybe because the sound-device was not released properly? - BASS_RecordFree; - - Inc(DeviceIndex); - end; - - Inc(BassDeviceID); - end; - - result := true; -end; - -function TAudioInput_Bass.InitializeRecord(): boolean; -begin - BassCore := TAudioCore_Bass.GetInstance(); - Result := EnumDevices(); -end; - -function TAudioInput_Bass.FinalizeRecord(): boolean; -begin - CaptureStop; - Result := inherited FinalizeRecord; -end; - - -initialization - MediaManager.Add(TAudioInput_Bass.Create); - -end. diff --git a/src/Classes/UAudioInput_Portaudio.pas b/src/Classes/UAudioInput_Portaudio.pas deleted file mode 100644 index 9a1c3e99..00000000 --- a/src/Classes/UAudioInput_Portaudio.pas +++ /dev/null @@ -1,474 +0,0 @@ -unit UAudioInput_Portaudio; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I ../switches.inc} - - -uses - Classes, - SysUtils, - UMusic; - -implementation - -uses - {$IFDEF UsePortmixer} - portmixer, - {$ENDIF} - portaudio, - UAudioCore_Portaudio, - URecord, - UIni, - ULog, - UMain; - -type - TAudioInput_Portaudio = class(TAudioInputBase) - private - AudioCore: TAudioCore_Portaudio; - function EnumDevices(): boolean; - public - function GetName: String; override; - function InitializeRecord: boolean; override; - function FinalizeRecord: boolean; override; - end; - - TPortaudioInputDevice = class(TAudioInputDevice) - private - RecordStream: PPaStream; - {$IFDEF UsePortmixer} - Mixer: PPxMixer; - {$ENDIF} - PaDeviceIndex: TPaDeviceIndex; - public - function Open(): boolean; - function Close(): boolean; - function Start(): boolean; override; - function Stop(): boolean; override; - - function GetVolume(): single; override; - procedure SetVolume(Volume: single); override; - end; - -function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; forward; - -function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; forward; - - -{ TPortaudioInputDevice } - -function TPortaudioInputDevice.Open(): boolean; -var - Error: TPaError; - inputParams: TPaStreamParameters; - deviceInfo: PPaDeviceInfo; - SourceIndex: integer; -begin - Result := false; - - // get input latency info - deviceInfo := Pa_GetDeviceInfo(PaDeviceIndex); - - // set input stream parameters - with inputParams do - begin - device := PaDeviceIndex; - channelCount := AudioFormat.Channels; - sampleFormat := paInt16; - suggestedLatency := deviceInfo^.defaultLowInputLatency; - hostApiSpecificStreamInfo := nil; - end; - - //Log.LogStatus(deviceInfo^.name, 'Portaudio'); - //Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); - - // open input stream - Error := Pa_OpenStream(RecordStream, @inputParams, nil, - AudioFormat.SampleRate, - paFramesPerBufferUnspecified, paNoFlag, - @MicrophoneCallback, Pointer(Self)); - if(Error <> paNoError) then - begin - Log.LogError('Error opening stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open'); - Exit; - end; - - {$IFDEF UsePortmixer} - // open default mixer - Mixer := Px_OpenMixer(RecordStream, 0); - if (Mixer = nil) then - begin - Log.LogError('Error opening mixer: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open'); - end - else - begin - // save current source selection and select new source - SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; - if (SourceIndex = -1) then - begin - // nothing to do if default source is used - SourceRestore := -1; - end - else - begin - // store current source-index and select new source - SourceRestore := Px_GetCurrentInputSource(Mixer); // -1 in error case - Px_SetCurrentInputSource(Mixer, SourceIndex); - end; - end; - {$ENDIF} - - Result := true; -end; - -function TPortaudioInputDevice.Start(): boolean; -var - Error: TPaError; -begin - Result := false; - - // recording already started -> stop first - if (RecordStream <> nil) then - Stop(); - - // TODO: Do not open the device here (takes too much time). - if (not Open()) then - Exit; - - // start capture - Error := Pa_StartStream(RecordStream); - if(Error <> paNoError) then - begin - Log.LogError('Error starting stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Start'); - Close(); - RecordStream := nil; - Exit; - end; - - Result := true; -end; - -function TPortaudioInputDevice.Stop(): boolean; -var - Error: TPaError; -begin - Result := false; - - if (RecordStream = nil) then - Exit; - - // Note: do NOT call Pa_StopStream here! - // It gets stuck on devices with non-working callback as Pa_StopStream - // waits until all buffers have been handled (which never occurs in that case). - Error := Pa_AbortStream(RecordStream); - if (Error <> paNoError) then - begin - Log.LogError('Pa_AbortStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Stop'); - end; - - Result := Close(); -end; - -function TPortaudioInputDevice.Close(): boolean; -var - Error: TPaError; -begin - {$IFDEF UsePortmixer} - if (Mixer <> nil) then - begin - // restore source selection - if (SourceRestore >= 0) then - begin - Px_SetCurrentInputSource(Mixer, SourceRestore); - end; - - // close mixer - Px_CloseMixer(Mixer); - Mixer := nil; - end; - {$ENDIF} - - Error := Pa_CloseStream(RecordStream); - if (Error <> paNoError) then - begin - Log.LogError('Pa_CloseStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Close'); - Result := false; - end - else - begin - Result := true; - end; - - RecordStream := nil; -end; - -function TPortaudioInputDevice.GetVolume(): single; -begin - Result := 0; - {$IFDEF UsePortmixer} - if (Mixer <> nil) then - Result := Px_GetInputVolume(Mixer); - {$ENDIF} -end; - -procedure TPortaudioInputDevice.SetVolume(Volume: single); -begin - {$IFDEF UsePortmixer} - if (Mixer <> nil) then - begin - // clip to valid range - if (Volume > 1.0) then - Volume := 1.0 - else if (Volume < 0) then - Volume := 0; - Px_SetInputVolume(Mixer, Volume); - end; - {$ENDIF} -end; - - -{ TAudioInput_Portaudio } - -function TAudioInput_Portaudio.GetName: String; -begin - result := 'Portaudio'; -end; - -function TAudioInput_Portaudio.EnumDevices(): boolean; -var - i: integer; - paApiIndex: TPaHostApiIndex; - paApiInfo: PPaHostApiInfo; - deviceName: string; - deviceIndex: TPaDeviceIndex; - deviceInfo: PPaDeviceInfo; - channelCnt: integer; - SC: integer; // soundcard - err: TPaError; - errMsg: string; - paDevice: TPortaudioInputDevice; - inputParams: TPaStreamParameters; - stream: PPaStream; - streamInfo: PPaStreamInfo; - sampleRate: double; - latency: TPaTime; - {$IFDEF UsePortmixer} - mixer: PPxMixer; - sourceCnt: integer; - sourceIndex: integer; - sourceName: string; - {$ENDIF} - cbPolls: integer; - cbWorks: boolean; -begin - Result := false; - - // choose the best available Audio-API - paApiIndex := AudioCore.GetPreferredApiIndex(); - if(paApiIndex = -1) then - begin - Log.LogError('No working Audio-API found', 'TAudioInput_Portaudio.EnumDevices'); - Exit; - end; - - paApiInfo := Pa_GetHostApiInfo(paApiIndex); - - SC := 0; - - // init array-size to max. input-devices count - SetLength(AudioInputProcessor.DeviceList, paApiInfo^.deviceCount); - for i:= 0 to High(AudioInputProcessor.DeviceList) do - begin - // convert API-specific device-index to global index - deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i); - deviceInfo := Pa_GetDeviceInfo(deviceIndex); - - channelCnt := deviceInfo^.maxInputChannels; - - // current device is no input device -> skip - if (channelCnt <= 0) then - continue; - - // portaudio returns a channel-count of 128 for some devices - // (e.g. the "default"-device), so we have to detect those - // fantasy channel counts. - if (channelCnt > 8) then - channelCnt := 2; - - paDevice := TPortaudioInputDevice.Create(); - AudioInputProcessor.DeviceList[SC] := paDevice; - - // retrieve device-name - deviceName := deviceInfo^.name; - paDevice.Name := deviceName; - paDevice.PaDeviceIndex := deviceIndex; - - sampleRate := deviceInfo^.defaultSampleRate; - - // on vista and xp the defaultLowInputLatency may be set to 0 but it works. - // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?) - latency := deviceInfo^.defaultLowInputLatency; - - // setup desired input parameters - // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might - // not be set correctly in OSS) - with inputParams do - begin - device := deviceIndex; - channelCount := channelCnt; - sampleFormat := paInt16; - suggestedLatency := latency; - hostApiSpecificStreamInfo := nil; - end; - - // check souncard and adjust sample-rate - if (not AudioCore.TestDevice(@inputParams, nil, sampleRate)) then - begin - // ignore device if it does not work - Log.LogError('Device "'+paDevice.Name+'" does not work', - 'TAudioInput_Portaudio.EnumDevices'); - paDevice.Free(); - continue; - end; - - // open device for further info - err := Pa_OpenStream(stream, @inputParams, nil, sampleRate, - paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil); - if(err <> paNoError) then - begin - // unable to open device -> skip - errMsg := Pa_GetErrorText(err); - Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')', - 'TAudioInput_Portaudio.EnumDevices'); - paDevice.Free(); - continue; - end; - - // adjust sample-rate (might be changed by portaudio) - streamInfo := Pa_GetStreamInfo(stream); - if (streamInfo <> nil) then - begin - if (sampleRate <> streamInfo^.sampleRate) then - begin - Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) + - ' to ' + FloatToStr(streamInfo^.sampleRate), - 'TAudioInput_Portaudio.InitializeRecord'); - sampleRate := streamInfo^.sampleRate; - end; - end; - - // create audio-format info and resize capture-buffer array - paDevice.AudioFormat := TAudioFormatInfo.Create( - channelCnt, - sampleRate, - asfS16 - ); - SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels); - - Log.LogStatus('InputDevice "'+paDevice.Name+'"@' + - IntToStr(paDevice.AudioFormat.Channels)+'x'+ - FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+ - FloatTostr(inputParams.suggestedLatency)+'sec)' , - 'Portaudio.EnumDevices'); - - // portaudio does not provide a source-type check - paDevice.MicSource := -1; - paDevice.SourceRestore := -1; - - // add a virtual default source (will not change mixer-settings) - SetLength(paDevice.Source, 1); - paDevice.Source[0].Name := DEFAULT_SOURCE_NAME; - - {$IFDEF UsePortmixer} - // use default mixer - mixer := Px_OpenMixer(stream, 0); - - // get input count - sourceCnt := Px_GetNumInputSources(mixer); - SetLength(paDevice.Source, sourceCnt+1); - - // get input names - for sourceIndex := 1 to sourceCnt do - begin - sourceName := Px_GetInputSourceName(mixer, sourceIndex-1); - paDevice.Source[sourceIndex].Name := sourceName; - end; - - Px_CloseMixer(mixer); - {$ENDIF} - - // close test-stream - Pa_CloseStream(stream); - - Inc(SC); - end; - - // adjust size to actual input-device count - SetLength(AudioInputProcessor.DeviceList, SC); - - Log.LogStatus('#Input-Devices: ' + inttostr(SC), 'Portaudio'); - - Result := true; -end; - -function TAudioInput_Portaudio.InitializeRecord(): boolean; -var - err: TPaError; -begin - AudioCore := TAudioCore_Portaudio.GetInstance(); - - // initialize portaudio - err := Pa_Initialize(); - if(err <> paNoError) then - begin - Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord'); - Result := false; - Exit; - end; - - Result := EnumDevices(); -end; - -function TAudioInput_Portaudio.FinalizeRecord: boolean; -begin - CaptureStop; - Pa_Terminate(); - Result := inherited FinalizeRecord(); -end; - -{* - * Portaudio input capture callback. - *} -function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; -begin - AudioInputProcessor.HandleMicrophoneData(input, frameCount*4, inputDevice); - result := paContinue; -end; - -{* - * Portaudio test capture callback. - *} -function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; -begin - // this callback is called only once - result := paAbort; -end; - - -initialization - MediaManager.add(TAudioInput_Portaudio.Create); - -end. diff --git a/src/Classes/UAudioPlaybackBase.pas b/src/Classes/UAudioPlaybackBase.pas deleted file mode 100644 index 2337d43f..00000000 --- a/src/Classes/UAudioPlaybackBase.pas +++ /dev/null @@ -1,292 +0,0 @@ -unit UAudioPlaybackBase; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UMusic; - -type - TAudioPlaybackBase = class(TInterfacedObject, IAudioPlayback) - protected - OutputDeviceList: TAudioOutputDeviceList; - MusicStream: TAudioPlaybackStream; - function CreatePlaybackStream(): TAudioPlaybackStream; virtual; abstract; - procedure ClearOutputDeviceList(); - function GetLatency(): double; virtual; abstract; - - // open sound or music stream (used by Open() and OpenSound()) - function OpenStream(const Filename: string): TAudioPlaybackStream; - function OpenDecodeStream(const Filename: string): TAudioDecodeStream; - public - function GetName: string; virtual; abstract; - - function Open(const Filename: string): boolean; // true if succeed - procedure Close; - - procedure Play; - procedure Pause; - procedure Stop; - procedure FadeIn(Time: real; TargetVolume: single); - - procedure SetSyncSource(SyncSource: TSyncSource); - - procedure SetPosition(Time: real); - function GetPosition: real; - - function InitializePlayback: boolean; virtual; abstract; - function FinalizePlayback: boolean; virtual; - - //function SetOutputDevice(Device: TAudioOutputDevice): boolean; - function GetOutputDeviceList(): TAudioOutputDeviceList; - - procedure SetAppVolume(Volume: single); virtual; abstract; - procedure SetVolume(Volume: single); - procedure SetLoop(Enabled: boolean); - - procedure Rewind; - function Finished: boolean; - function Length: real; - - // Sounds - function OpenSound(const Filename: string): TAudioPlaybackStream; - procedure PlaySound(Stream: TAudioPlaybackStream); - procedure StopSound(Stream: TAudioPlaybackStream); - - // Equalizer - procedure GetFFTData(var Data: TFFTData); - - // Interface for Visualizer - function GetPCMData(var Data: TPCMData): Cardinal; - - function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; virtual; abstract; - end; - - -implementation - -uses - ULog, - SysUtils; - -{ TAudioPlaybackBase } - -function TAudioPlaybackBase.FinalizePlayback: boolean; -begin - FreeAndNil(MusicStream); - ClearOutputDeviceList(); - Result := true; -end; - -function TAudioPlaybackBase.Open(const Filename: string): boolean; -begin - // free old MusicStream - MusicStream.Free; - - MusicStream := OpenStream(Filename); - if not assigned(MusicStream) then - begin - Result := false; - Exit; - end; - - //MusicStream.AddSoundEffect(TVoiceRemoval.Create()); - - Result := true; -end; - -procedure TAudioPlaybackBase.Close; -begin - FreeAndNil(MusicStream); -end; - -function TAudioPlaybackBase.OpenDecodeStream(const Filename: String): TAudioDecodeStream; -var - i: integer; -begin - for i := 0 to AudioDecoders.Count-1 do - begin - Result := IAudioDecoder(AudioDecoders[i]).Open(Filename); - if (assigned(Result)) then - begin - Log.LogInfo('Using decoder ' + IAudioDecoder(AudioDecoders[i]).GetName() + - ' for "' + Filename + '"', 'TAudioPlaybackBase.OpenDecodeStream'); - Exit; - end; - end; - Result := nil; -end; - -procedure OnClosePlaybackStream(Stream: TAudioProcessingStream); -var - PlaybackStream: TAudioPlaybackStream; - SourceStream: TAudioSourceStream; -begin - PlaybackStream := TAudioPlaybackStream(Stream); - SourceStream := PlaybackStream.GetSourceStream(); - SourceStream.Free; -end; - -function TAudioPlaybackBase.OpenStream(const Filename: string): TAudioPlaybackStream; -var - PlaybackStream: TAudioPlaybackStream; - DecodeStream: TAudioDecodeStream; -begin - Result := nil; - - //Log.LogStatus('Loading Sound: "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream'); - - DecodeStream := OpenDecodeStream(Filename); - if (not assigned(DecodeStream)) then - begin - Log.LogStatus('Could not open "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream'); - Exit; - end; - - // create a matching playback-stream for the decoder - PlaybackStream := CreatePlaybackStream(); - if (not PlaybackStream.Open(DecodeStream)) then - begin - FreeAndNil(PlaybackStream); - FreeAndNil(DecodeStream); - Exit; - end; - - PlaybackStream.AddOnCloseHandler(OnClosePlaybackStream); - - Result := PlaybackStream; -end; - -procedure TAudioPlaybackBase.Play; -begin - if assigned(MusicStream) then - MusicStream.Play(); -end; - -procedure TAudioPlaybackBase.Pause; -begin - if assigned(MusicStream) then - MusicStream.Pause(); -end; - -procedure TAudioPlaybackBase.Stop; -begin - if assigned(MusicStream) then - MusicStream.Stop(); -end; - -function TAudioPlaybackBase.Length: real; -begin - if assigned(MusicStream) then - Result := MusicStream.Length - else - Result := 0; -end; - -function TAudioPlaybackBase.GetPosition: real; -begin - if assigned(MusicStream) then - Result := MusicStream.Position - else - Result := 0; -end; - -procedure TAudioPlaybackBase.SetPosition(Time: real); -begin - if assigned(MusicStream) then - MusicStream.Position := Time; -end; - -procedure TAudioPlaybackBase.SetSyncSource(SyncSource: TSyncSource); -begin - if assigned(MusicStream) then - MusicStream.SetSyncSource(SyncSource); -end; - -procedure TAudioPlaybackBase.Rewind; -begin - SetPosition(0); -end; - -function TAudioPlaybackBase.Finished: boolean; -begin - if assigned(MusicStream) then - Result := (MusicStream.Status = ssStopped) - else - Result := true; -end; - -procedure TAudioPlaybackBase.SetVolume(Volume: single); -begin - if assigned(MusicStream) then - MusicStream.Volume := Volume; -end; - -procedure TAudioPlaybackBase.FadeIn(Time: real; TargetVolume: single); -begin - if assigned(MusicStream) then - MusicStream.FadeIn(Time, TargetVolume); -end; - -procedure TAudioPlaybackBase.SetLoop(Enabled: boolean); -begin - if assigned(MusicStream) then - MusicStream.Loop := Enabled; -end; - -// Equalizer -procedure TAudioPlaybackBase.GetFFTData(var data: TFFTData); -begin - if assigned(MusicStream) then - MusicStream.GetFFTData(data); -end; - -{* - * Copies interleaved PCM SInt16 stereo samples into data. - * Returns the number of frames - *} -function TAudioPlaybackBase.GetPCMData(var data: TPCMData): Cardinal; -begin - if assigned(MusicStream) then - Result := MusicStream.GetPCMData(data) - else - Result := 0; -end; - -function TAudioPlaybackBase.OpenSound(const Filename: string): TAudioPlaybackStream; -begin - Result := OpenStream(Filename); -end; - -procedure TAudioPlaybackBase.PlaySound(stream: TAudioPlaybackStream); -begin - if assigned(stream) then - stream.Play(); -end; - -procedure TAudioPlaybackBase.StopSound(stream: TAudioPlaybackStream); -begin - if assigned(stream) then - stream.Stop(); -end; - -procedure TAudioPlaybackBase.ClearOutputDeviceList(); -var - DeviceIndex: integer; -begin - for DeviceIndex := 0 to High(OutputDeviceList) do - OutputDeviceList[DeviceIndex].Free(); - SetLength(OutputDeviceList, 0); -end; - -function TAudioPlaybackBase.GetOutputDeviceList(): TAudioOutputDeviceList; -begin - Result := OutputDeviceList; -end; - -end. diff --git a/src/Classes/UAudioPlayback_Bass.pas b/src/Classes/UAudioPlayback_Bass.pas deleted file mode 100644 index 41a91173..00000000 --- a/src/Classes/UAudioPlayback_Bass.pas +++ /dev/null @@ -1,731 +0,0 @@ -unit UAudioPlayback_Bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -implementation - -uses - Classes, - SysUtils, - Math, - UIni, - UMain, - UMusic, - UAudioPlaybackBase, - UAudioCore_Bass, - ULog, - sdl, - bass; - -type - PHDSP = ^HDSP; - -type - TBassPlaybackStream = class(TAudioPlaybackStream) - private - Handle: HSTREAM; - NeedsRewind: boolean; - PausedSeek: boolean; // true if a seek was performed in pause state - - procedure Reset(); - function IsEOF(): boolean; - protected - function GetLatency(): double; override; - function GetLoop(): boolean; override; - procedure SetLoop(Enabled: boolean); override; - function GetLength(): real; override; - function GetStatus(): TStreamStatus; override; - function GetVolume(): single; override; - procedure SetVolume(Volume: single); override; - function GetPosition: real; override; - procedure SetPosition(Time: real); override; - public - constructor Create(); - destructor Destroy(); override; - - function Open(SourceStream: TAudioSourceStream): boolean; override; - procedure Close(); override; - - procedure Play(); override; - procedure Pause(); override; - procedure Stop(); override; - procedure FadeIn(Time: real; TargetVolume: single); override; - - procedure AddSoundEffect(Effect: TSoundEffect); override; - procedure RemoveSoundEffect(Effect: TSoundEffect); override; - - procedure GetFFTData(var Data: TFFTData); override; - function GetPCMData(var Data: TPCMData): Cardinal; override; - - function GetAudioFormatInfo(): TAudioFormatInfo; override; - - function ReadData(Buffer: PChar; BufferSize: integer): integer; - - property EOF: boolean READ IsEOF; - end; - -const - MAX_VOICE_DELAY = 0.020; // 20ms - -type - TBassVoiceStream = class(TAudioVoiceStream) - private - Handle: HSTREAM; - public - function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override; - procedure Close(); override; - - procedure WriteData(Buffer: PChar; BufferSize: integer); override; - function ReadData(Buffer: PChar; BufferSize: integer): integer; override; - function IsEOF(): boolean; override; - function IsError(): boolean; override; - end; - -type - TAudioPlayback_Bass = class(TAudioPlaybackBase) - private - function EnumDevices(): boolean; - protected - function GetLatency(): double; override; - function CreatePlaybackStream(): TAudioPlaybackStream; override; - public - function GetName: String; override; - function InitializePlayback(): boolean; override; - function FinalizePlayback: boolean; override; - procedure SetAppVolume(Volume: single); override; - function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override; - end; - - TBassOutputDevice = class(TAudioOutputDevice) - private - BassDeviceID: DWORD; // DeviceID used by BASS - end; - -var - BassCore: TAudioCore_Bass; - - -{ TBassPlaybackStream } - -function PlaybackStreamHandler(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; -{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} -var - PlaybackStream: TBassPlaybackStream; - BytesRead: integer; -begin - PlaybackStream := TBassPlaybackStream(user); - if (not assigned (PlaybackStream)) then - begin - Result := BASS_STREAMPROC_END; - Exit; - end; - - BytesRead := PlaybackStream.ReadData(buffer, length); - // check for errors - if (BytesRead < 0) then - Result := BASS_STREAMPROC_END - // check for EOF - else if (PlaybackStream.EOF) then - Result := BytesRead or BASS_STREAMPROC_END - // no error/EOF - else - Result := BytesRead; -end; - -function TBassPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -var - AdjustedSize: integer; - RequestedSourceSize, SourceSize: integer; - SkipCount: integer; - SourceFormatInfo: TAudioFormatInfo; - FrameSize: integer; - PadFrame: PChar; - //Info: BASS_INFO; - //Latency: double; -begin - Result := -1; - - if (not assigned(SourceStream)) then - Exit; - - // sanity check - if (BufferSize = 0) then - begin - Result := 0; - Exit; - end; - - SourceFormatInfo := SourceStream.GetAudioFormatInfo(); - FrameSize := SourceFormatInfo.FrameSize; - - // check how much data to fetch to be in synch - AdjustedSize := Synchronize(BufferSize, SourceFormatInfo); - - // skip data if we are too far behind - SkipCount := AdjustedSize - BufferSize; - while (SkipCount > 0) do - begin - RequestedSourceSize := Min(SkipCount, BufferSize); - SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize); - // if an error or EOF occured stop skipping and handle error/EOF with the next ReadData() - if (SourceSize <= 0) then - break; - Dec(SkipCount, SourceSize); - end; - - // get source data (e.g. from a decoder) - RequestedSourceSize := Min(AdjustedSize, BufferSize); - SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize); - if (SourceSize < 0) then - Exit; - - // set preliminary result - Result := SourceSize; - - // if we are to far ahead, fill output-buffer with last frame of source data - // Note that AdjustedSize is used instead of SourceSize as the SourceSize might - // be less than expected because of errors etc. - if (AdjustedSize < BufferSize) then - begin - // use either the last frame for padding or fill with zero - if (SourceSize >= FrameSize) then - PadFrame := @Buffer[SourceSize-FrameSize] - else - PadFrame := nil; - - FillBufferWithFrame(@Buffer[SourceSize], BufferSize - SourceSize, - PadFrame, FrameSize); - Result := BufferSize; - end; -end; - -constructor TBassPlaybackStream.Create(); -begin - inherited; - Reset(); -end; - -destructor TBassPlaybackStream.Destroy(); -begin - Close(); - inherited; -end; - -function TBassPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean; -var - FormatInfo: TAudioFormatInfo; - FormatFlags: DWORD; -begin - Result := false; - - // close previous stream and reset state - Reset(); - - // sanity check if stream is valid - if not assigned(SourceStream) then - Exit; - - Self.SourceStream := SourceStream; - FormatInfo := SourceStream.GetAudioFormatInfo(); - if (not BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, FormatFlags)) then - begin - Log.LogError('Unhandled sample-format', 'TBassPlaybackStream.Open'); - Exit; - end; - - // create matching playback stream - Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), FormatInfo.Channels, formatFlags, - @PlaybackStreamHandler, Self); - if (Handle = 0) then - begin - Log.LogError('BASS_StreamCreate failed: ' + BassCore.ErrorGetString(BASS_ErrorGetCode()), - 'TBassPlaybackStream.Open'); - Exit; - end; - - Result := true; -end; - -procedure TBassPlaybackStream.Close(); -begin - // stop and free stream - if (Handle <> 0) then - begin - Bass_StreamFree(Handle); - Handle := 0; - end; - - // Note: PerformOnClose must be called before SourceStream is invalidated - PerformOnClose(); - // unset source-stream - SourceStream := nil; -end; - -procedure TBassPlaybackStream.Reset(); -begin - Close(); - NeedsRewind := false; - PausedSeek := false; -end; - -procedure TBassPlaybackStream.Play(); -var - NeedsFlush: boolean; -begin - if (not assigned(SourceStream)) then - Exit; - - NeedsFlush := true; - - if (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_PAUSED) then - begin - // only paused (and not seeked while paused) streams are not flushed - if (not PausedSeek) then - NeedsFlush := false; - // paused streams do not need a rewind - NeedsRewind := false; - end; - - // rewind if necessary. Cases that require no rewind are: - // - stream was created and never played - // - stream was paused and is resumed now - // - stream was stopped and set to a new position already - if (NeedsRewind) then - SourceStream.Position := 0; - - NeedsRewind := true; - PausedSeek := false; - - // start playing and flush buffers on rewind - BASS_ChannelPlay(Handle, NeedsFlush); -end; - -procedure TBassPlaybackStream.FadeIn(Time: real; TargetVolume: single); -begin - // start stream - Play(); - // start fade-in: slide from fadeStart- to fadeEnd-volume in FadeInTime - BASS_ChannelSlideAttribute(Handle, BASS_ATTRIB_VOL, TargetVolume, Trunc(Time * 1000)); -end; - -procedure TBassPlaybackStream.Pause(); -begin - BASS_ChannelPause(Handle); -end; - -procedure TBassPlaybackStream.Stop(); -begin - BASS_ChannelStop(Handle); -end; - -function TBassPlaybackStream.IsEOF(): boolean; -begin - if (assigned(SourceStream)) then - Result := SourceStream.EOF - else - Result := true; -end; - -function TBassPlaybackStream.GetLatency(): double; -begin - // TODO: should we consider output latency for synching (needs BASS_DEVICE_LATENCY)? - //if (BASS_GetInfo(Info)) then - // Latency := Info.latency / 1000 - //else - // Latency := 0; - Result := 0; -end; - -function TBassPlaybackStream.GetVolume(): single; -var - lVolume: single; -begin - if (not BASS_ChannelGetAttribute(Handle, BASS_ATTRIB_VOL, lVolume)) then - begin - Log.LogError('BASS_ChannelGetAttribute: ' + BassCore.ErrorGetString(), - 'TBassPlaybackStream.GetVolume'); - Result := 0; - Exit; - end; - Result := Round(lVolume); -end; - -procedure TBassPlaybackStream.SetVolume(Volume: single); -begin - // clamp volume - if Volume < 0 then - Volume := 0; - if Volume > 1.0 then - Volume := 1.0; - // set volume - BASS_ChannelSetAttribute(Handle, BASS_ATTRIB_VOL, Volume); -end; - -function TBassPlaybackStream.GetPosition: real; -var - BufferPosByte: QWORD; - BufferPosSec: double; -begin - if assigned(SourceStream) then - begin - BufferPosByte := BASS_ChannelGetData(Handle, nil, BASS_DATA_AVAILABLE); - BufferPosSec := BASS_ChannelBytes2Seconds(Handle, BufferPosByte); - // decrease the decoding position by the amount buffered (and hence not played) - // in the BASS playback stream. - Result := SourceStream.Position - BufferPosSec; - end - else - begin - Result := -1; - end; -end; - -procedure TBassPlaybackStream.SetPosition(Time: real); -var - ChannelState: DWORD; -begin - if assigned(SourceStream) then - begin - ChannelState := BASS_ChannelIsActive(Handle); - if (ChannelState = BASS_ACTIVE_STOPPED) then - begin - // if the stream is stopped, do not rewind when the stream is played next time - NeedsRewind := false - end - else if (ChannelState = BASS_ACTIVE_PAUSED) then - begin - // buffers must be flushed if in paused state but there is no - // BASS_ChannelFlush() function so we have to use BASS_ChannelPlay() called in Play(). - PausedSeek := true; - end; - - // set new position - SourceStream.Position := Time; - end; -end; - -function TBassPlaybackStream.GetLength(): real; -begin - if assigned(SourceStream) then - Result := SourceStream.Length - else - Result := -1; -end; - -function TBassPlaybackStream.GetStatus(): TStreamStatus; -var - State: DWORD; -begin - State := BASS_ChannelIsActive(Handle); - case State of - BASS_ACTIVE_PLAYING, - BASS_ACTIVE_STALLED: - Result := ssPlaying; - BASS_ACTIVE_PAUSED: - Result := ssPaused; - BASS_ACTIVE_STOPPED: - Result := ssStopped; - else - begin - Log.LogError('Unknown status', 'TBassPlaybackStream.GetStatus'); - Result := ssStopped; - end; - end; -end; - -function TBassPlaybackStream.GetLoop(): boolean; -begin - if assigned(SourceStream) then - Result := SourceStream.Loop - else - Result := false; -end; - -procedure TBassPlaybackStream.SetLoop(Enabled: boolean); -begin - if assigned(SourceStream) then - SourceStream.Loop := Enabled; -end; - -procedure DSPProcHandler(handle: HDSP; channel: DWORD; buffer: Pointer; length: DWORD; user: Pointer); -{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} -var - Effect: TSoundEffect; -begin - Effect := TSoundEffect(user); - if assigned(Effect) then - Effect.Callback(buffer, length); -end; - -procedure TBassPlaybackStream.AddSoundEffect(Effect: TSoundEffect); -var - DspHandle: HDSP; -begin - if assigned(Effect.engineData) then - begin - Log.LogError('TSoundEffect.engineData already set', 'TBassPlaybackStream.AddSoundEffect'); - Exit; - end; - - DspHandle := BASS_ChannelSetDSP(Handle, @DSPProcHandler, Effect, 0); - if (DspHandle = 0) then - begin - Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.AddSoundEffect'); - Exit; - end; - - GetMem(Effect.EngineData, SizeOf(HDSP)); - PHDSP(Effect.EngineData)^ := DspHandle; -end; - -procedure TBassPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect); -begin - if not assigned(Effect.EngineData) then - begin - Log.LogError('TSoundEffect.engineData invalid', 'TBassPlaybackStream.RemoveSoundEffect'); - Exit; - end; - - if not BASS_ChannelRemoveDSP(Handle, PHDSP(Effect.EngineData)^) then - begin - Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.RemoveSoundEffect'); - Exit; - end; - - FreeMem(Effect.EngineData); - Effect.EngineData := nil; -end; - -procedure TBassPlaybackStream.GetFFTData(var Data: TFFTData); -begin - // get FFT channel data (Mono, FFT512 -> 256 values) - BASS_ChannelGetData(Handle, @Data, BASS_DATA_FFT512); -end; - -{* - * Copies interleaved PCM SInt16 stereo samples into data. - * Returns the number of frames - *} -function TBassPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal; -var - Info: BASS_CHANNELINFO; - nBytes: DWORD; -begin - Result := 0; - - FillChar(Data, SizeOf(TPCMData), 0); - - // no support for non-stereo files at the moment - BASS_ChannelGetInfo(Handle, Info); - if (Info.chans <> 2) then - Exit; - - nBytes := BASS_ChannelGetData(Handle, @Data, SizeOf(TPCMData)); - if(nBytes <= 0) then - Result := 0 - else - Result := nBytes div SizeOf(TPCMStereoSample); -end; - -function TBassPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo; -begin - if assigned(SourceStream) then - Result := SourceStream.GetAudioFormatInfo() - else - Result := nil; -end; - - -{ TBassVoiceStream } - -function TBassVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; -var - Flags: DWORD; -begin - Result := false; - - Close(); - - if (not inherited Open(ChannelMap, FormatInfo)) then - Exit; - - // get channel flags - BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, Flags); - - (* - // distribute the mics equally to both speakers - if ((ChannelMap and CHANNELMAP_LEFT) <> 0) then - Flags := Flags or BASS_SPEAKER_FRONTLEFT; - if ((ChannelMap and CHANNELMAP_RIGHT) <> 0) then - Flags := Flags or BASS_SPEAKER_FRONTRIGHT; - *) - - // create the channel - Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), 1, Flags, STREAMPROC_PUSH, nil); - - // start the channel - BASS_ChannelPlay(Handle, true); - - Result := true; -end; - -procedure TBassVoiceStream.Close(); -begin - if (Handle <> 0) then - begin - BASS_ChannelStop(Handle); - BASS_StreamFree(Handle); - end; - inherited Close(); -end; - -procedure TBassVoiceStream.WriteData(Buffer: PChar; BufferSize: integer); -var QueueSize: DWORD; -begin - if ((Handle <> 0) and (BufferSize > 0)) then - begin - // query the queue size (normally 0) - QueueSize := BASS_StreamPutData(Handle, nil, 0); - // flush the buffer if the delay would be too high - if (QueueSize > MAX_VOICE_DELAY * FormatInfo.BytesPerSec) then - BASS_ChannelPlay(Handle, true); - // send new data to playback buffer - BASS_StreamPutData(Handle, Buffer, BufferSize); - end; -end; - -// Note: we do not need the read-function for the BASS implementation -function TBassVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -begin - Result := -1; -end; - -function TBassVoiceStream.IsEOF(): boolean; -begin - Result := false; -end; - -function TBassVoiceStream.IsError(): boolean; -begin - Result := false; -end; - - -{ TAudioPlayback_Bass } - -function TAudioPlayback_Bass.GetName: String; -begin - Result := 'BASS_Playback'; -end; - -function TAudioPlayback_Bass.EnumDevices(): boolean; -var - BassDeviceID: DWORD; - DeviceIndex: integer; - Device: TBassOutputDevice; - DeviceInfo: BASS_DEVICEINFO; -begin - Result := true; - - ClearOutputDeviceList(); - - // skip "no sound"-device (ID = 0) - BassDeviceID := 1; - - while (true) do - begin - // check for device - if (not BASS_GetDeviceInfo(BassDeviceID, DeviceInfo)) then - Break; - - // set device info - Device := TBassOutputDevice.Create(); - Device.Name := DeviceInfo.name; - Device.BassDeviceID := BassDeviceID; - - // add device to list - SetLength(OutputDeviceList, BassDeviceID); - OutputDeviceList[BassDeviceID-1] := Device; - - Inc(BassDeviceID); - end; -end; - -function TAudioPlayback_Bass.InitializePlayback(): boolean; -begin - result := false; - - BassCore := TAudioCore_Bass.GetInstance(); - - EnumDevices(); - - //Log.BenchmarkStart(4); - //Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - // TODO: use BASS_DEVICE_LATENCY to determine the latency - if not BASS_Init(-1, 44100, 0, 0, nil) then - begin - Log.LogError('Could not initialize BASS', 'TAudioPlayback_Bass.InitializePlayback'); - Exit; - end; - - //Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); - - // config playing buffer - //BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); - //BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - - result := true; -end; - -function TAudioPlayback_Bass.FinalizePlayback(): boolean; -begin - Close; - BASS_Free; - inherited FinalizePlayback(); - Result := true; -end; - -function TAudioPlayback_Bass.CreatePlaybackStream(): TAudioPlaybackStream; -begin - Result := TBassPlaybackStream.Create(); -end; - -procedure TAudioPlayback_Bass.SetAppVolume(Volume: single); -begin - // set volume for this application (ranges from 0..10000 since BASS 2.4) - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Round(Volume*10000)); -end; - -function TAudioPlayback_Bass.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; -var - VoiceStream: TAudioVoiceStream; -begin - Result := nil; - - VoiceStream := TBassVoiceStream.Create(); - if (not VoiceStream.Open(ChannelMap, FormatInfo)) then - begin - VoiceStream.Free; - Exit; - end; - - Result := VoiceStream; -end; - -function TAudioPlayback_Bass.GetLatency(): double; -begin - Result := 0; -end; - - -initialization - MediaManager.Add(TAudioPlayback_Bass.Create); - -end. diff --git a/src/Classes/UAudioPlayback_Portaudio.pas b/src/Classes/UAudioPlayback_Portaudio.pas deleted file mode 100644 index c3717ba6..00000000 --- a/src/Classes/UAudioPlayback_Portaudio.pas +++ /dev/null @@ -1,361 +0,0 @@ -unit UAudioPlayback_Portaudio; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses - Classes, - SysUtils, - UMusic; - -implementation - -uses - portaudio, - UAudioCore_Portaudio, - UAudioPlayback_SoftMixer, - ULog, - UIni, - UMain; - -type - TAudioPlayback_Portaudio = class(TAudioPlayback_SoftMixer) - private - paStream: PPaStream; - AudioCore: TAudioCore_Portaudio; - Latency: double; - function OpenDevice(deviceIndex: TPaDeviceIndex): boolean; - function EnumDevices(): boolean; - protected - function InitializeAudioPlaybackEngine(): boolean; override; - function StartAudioPlaybackEngine(): boolean; override; - procedure StopAudioPlaybackEngine(); override; - function FinalizeAudioPlaybackEngine(): boolean; override; - function GetLatency(): double; override; - public - function GetName: String; override; - end; - - TPortaudioOutputDevice = class(TAudioOutputDevice) - private - PaDeviceIndex: TPaDeviceIndex; - end; - - -{ TAudioPlayback_Portaudio } - -function PortaudioAudioCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - userData: Pointer): Integer; cdecl; -var - Engine: TAudioPlayback_Portaudio; -begin - Engine := TAudioPlayback_Portaudio(userData); - // update latency - Engine.Latency := timeInfo.outputBufferDacTime - timeInfo.currentTime; - // call superclass callback - Engine.AudioCallback(output, frameCount * Engine.FormatInfo.FrameSize); - Result := paContinue; -end; - -function TAudioPlayback_Portaudio.GetName: String; -begin - Result := 'Portaudio_Playback'; -end; - -function TAudioPlayback_Portaudio.OpenDevice(deviceIndex: TPaDeviceIndex): boolean; -var - DeviceInfo : PPaDeviceInfo; - SampleRate : double; - OutParams : TPaStreamParameters; - StreamInfo : PPaStreamInfo; - err : TPaError; -begin - Result := false; - - DeviceInfo := Pa_GetDeviceInfo(deviceIndex); - - Log.LogInfo('Audio-Output Device: ' + DeviceInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice'); - - SampleRate := DeviceInfo^.defaultSampleRate; - - with OutParams do - begin - device := deviceIndex; - channelCount := 2; - sampleFormat := paInt16; - suggestedLatency := DeviceInfo^.defaultLowOutputLatency; - hostApiSpecificStreamInfo := nil; - end; - - // check souncard and adjust sample-rate - if not AudioCore.TestDevice(nil, @OutParams, SampleRate) then - begin - Log.LogStatus('TestDevice failed!', 'TAudioPlayback_Portaudio.OpenDevice'); - Exit; - end; - - // open output stream - err := Pa_OpenStream(paStream, nil, @OutParams, SampleRate, - paFramesPerBufferUnspecified, - paNoFlag, @PortaudioAudioCallback, Self); - if(err <> paNoError) then - begin - Log.LogStatus(Pa_GetErrorText(err), 'TAudioPlayback_Portaudio.OpenDevice'); - paStream := nil; - Exit; - end; - - // get estimated latency (will be updated with real latency in the callback) - StreamInfo := Pa_GetStreamInfo(paStream); - if (StreamInfo <> nil) then - Latency := StreamInfo^.outputLatency - else - Latency := 0; - - FormatInfo := TAudioFormatInfo.Create( - OutParams.channelCount, - SampleRate, - asfS16 // FIXME: is paInt16 system-dependant or -independant? - ); - - Result := true; -end; - -function TAudioPlayback_Portaudio.EnumDevices(): boolean; -var - i: integer; - paApiIndex: TPaHostApiIndex; - paApiInfo: PPaHostApiInfo; - deviceName: string; - deviceIndex: TPaDeviceIndex; - deviceInfo: PPaDeviceInfo; - channelCnt: integer; - SC: integer; // soundcard - err: TPaError; - errMsg: string; - paDevice: TPortaudioOutputDevice; - outputParams: TPaStreamParameters; - stream: PPaStream; - streamInfo: PPaStreamInfo; - sampleRate: double; - latency: TPaTime; - cbPolls: integer; - cbWorks: boolean; -begin - Result := false; - -(* - // choose the best available Audio-API - paApiIndex := AudioCore.GetPreferredApiIndex(); - if(paApiIndex = -1) then - begin - Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.EnumDevices'); - Exit; - end; - - paApiInfo := Pa_GetHostApiInfo(paApiIndex); - - SC := 0; - - // init array-size to max. output-devices count - SetLength(OutputDeviceList, paApiInfo^.deviceCount); - for i:= 0 to High(OutputDeviceList) do - begin - // convert API-specific device-index to global index - deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i); - deviceInfo := Pa_GetDeviceInfo(deviceIndex); - - channelCnt := deviceInfo^.maxOutputChannels; - - // current device is no output device -> skip - if (channelCnt <= 0) then - continue; - - // portaudio returns a channel-count of 128 for some devices - // (e.g. the "default"-device), so we have to detect those - // fantasy channel counts. - if (channelCnt > 8) then - channelCnt := 2; - - paDevice := TPortaudioOutputDevice.Create(); - OutputDeviceList[SC] := paDevice; - - // retrieve device-name - deviceName := deviceInfo^.name; - paDevice.Name := deviceName; - paDevice.PaDeviceIndex := deviceIndex; - - if (deviceInfo^.defaultSampleRate > 0) then - sampleRate := deviceInfo^.defaultSampleRate - else - sampleRate := 44100; - - // on vista and xp the defaultLowInputLatency may be set to 0 but it works. - // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?) - latency := deviceInfo^.defaultLowInputLatency; - - // setup desired output parameters - // TODO: retry with input-latency set to 20ms (defaultLowOutputLatency might - // not be set correctly in OSS) - with outputParams do - begin - device := deviceIndex; - channelCount := channelCnt; - sampleFormat := paInt16; - suggestedLatency := latency; - hostApiSpecificStreamInfo := nil; - end; - - // check if mic-callback works (might not be called on some devices) - if (not TAudioCore_Portaudio.TestDevice(nil, @outputParams, sampleRate)) then - begin - // ignore device if callback did not work - Log.LogError('Device "'+paDevice.Name+'" does not respond', - 'TAudioPlayback_Portaudio.InitializeRecord'); - paDevice.Free(); - continue; - end; - - // open device for further info - err := Pa_OpenStream(stream, nil, @outputParams, sampleRate, - paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil); - if(err <> paNoError) then - begin - // unable to open device -> skip - errMsg := Pa_GetErrorText(err); - Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')', - 'TAudioPlayback_Portaudio.InitializeRecord'); - paDevice.Free(); - continue; - end; - - // adjust sample-rate (might be changed by portaudio) - streamInfo := Pa_GetStreamInfo(stream); - if (streamInfo <> nil) then - begin - if (sampleRate <> streamInfo^.sampleRate) then - begin - Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) + - ' to ' + FloatToStr(streamInfo^.sampleRate), - 'TAudioInput_Portaudio.InitializeRecord'); - sampleRate := streamInfo^.sampleRate; - end; - end; - - // create audio-format info and resize capture-buffer array - paDevice.AudioFormat := TAudioFormatInfo.Create( - channelCnt, - sampleRate, - asfS16 - ); - SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels); - - Log.LogStatus('OutputDevice "'+paDevice.Name+'"@' + - IntToStr(paDevice.AudioFormat.Channels)+'x'+ - FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+ - FloatTostr(outputParams.suggestedLatency)+'sec)' , - 'TAudioInput_Portaudio.InitializeRecord'); - - // close test-stream - Pa_CloseStream(stream); - - Inc(SC); - end; - - // adjust size to actual input-device count - SetLength(OutputDeviceList, SC); - - Log.LogStatus('#Output-Devices: ' + inttostr(SC), 'Portaudio'); -*) - - Result := true; -end; - -function TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine(): boolean; -var - paApiIndex : TPaHostApiIndex; - paApiInfo : PPaHostApiInfo; - paOutDevice : TPaDeviceIndex; - err: TPaError; -begin - Result := false; - - AudioCore := TAudioCore_Portaudio.GetInstance(); - - // initialize portaudio - err := Pa_Initialize(); - if(err <> paNoError) then - begin - Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord'); - Exit; - end; - - paApiIndex := AudioCore.GetPreferredApiIndex(); - if(paApiIndex = -1) then - begin - Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine'); - Exit; - end; - - EnumDevices(); - - paApiInfo := Pa_GetHostApiInfo(paApiIndex); - Log.LogInfo('Audio-Output API-Type: ' + paApiInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice'); - - paOutDevice := paApiInfo^.defaultOutputDevice; - if (not OpenDevice(paOutDevice)) then - begin - Exit; - end; - - Result := true; -end; - -function TAudioPlayback_Portaudio.StartAudioPlaybackEngine(): boolean; -var - err: TPaError; -begin - Result := false; - - if (paStream = nil) then - Exit; - - err := Pa_StartStream(paStream); - if(err <> paNoError) then - begin - Log.LogStatus('Pa_StartStream: '+Pa_GetErrorText(err), 'UAudioPlayback_Portaudio'); - Exit; - end; - - Result := true; -end; - -procedure TAudioPlayback_Portaudio.StopAudioPlaybackEngine(); -begin - if (paStream <> nil) then - Pa_StopStream(paStream); -end; - -function TAudioPlayback_Portaudio.FinalizeAudioPlaybackEngine(): boolean; -begin - Pa_Terminate(); - Result := true; -end; - -function TAudioPlayback_Portaudio.GetLatency(): double; -begin - Result := Latency; -end; - - -initialization - MediaManager.Add(TAudioPlayback_Portaudio.Create); - -end. diff --git a/src/Classes/UAudioPlayback_SDL.pas b/src/Classes/UAudioPlayback_SDL.pas deleted file mode 100644 index deef91e8..00000000 --- a/src/Classes/UAudioPlayback_SDL.pas +++ /dev/null @@ -1,160 +0,0 @@ -unit UAudioPlayback_SDL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses - Classes, - SysUtils, - UMusic; - -implementation - -uses - sdl, - UAudioPlayback_SoftMixer, - ULog, - UIni, - UMain; - -type - TAudioPlayback_SDL = class(TAudioPlayback_SoftMixer) - private - Latency: double; - function EnumDevices(): boolean; - protected - function InitializeAudioPlaybackEngine(): boolean; override; - function StartAudioPlaybackEngine(): boolean; override; - procedure StopAudioPlaybackEngine(); override; - function FinalizeAudioPlaybackEngine(): boolean; override; - function GetLatency(): double; override; - public - function GetName: String; override; - procedure MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); override; - end; - - -{ TAudioPlayback_SDL } - -procedure SDLAudioCallback(userdata: Pointer; stream: PChar; len: integer); cdecl; -var - Engine: TAudioPlayback_SDL; -begin - Engine := TAudioPlayback_SDL(userdata); - Engine.AudioCallback(stream, len); -end; - -function TAudioPlayback_SDL.GetName: String; -begin - Result := 'SDL_Playback'; -end; - -function TAudioPlayback_SDL.EnumDevices(): boolean; -begin - // Note: SDL does not provide Device-Selection capabilities (will be introduced in 1.3) - ClearOutputDeviceList(); - SetLength(OutputDeviceList, 1); - OutputDeviceList[0] := TAudioOutputDevice.Create(); - OutputDeviceList[0].Name := '[SDL Default-Device]'; - Result := true; -end; - -function TAudioPlayback_SDL.InitializeAudioPlaybackEngine(): boolean; -var - DesiredAudioSpec, ObtainedAudioSpec: TSDL_AudioSpec; - SampleBufferSize: integer; -begin - Result := false; - - EnumDevices(); - - if (SDL_InitSubSystem(SDL_INIT_AUDIO) = -1) then - begin - Log.LogError('SDL_InitSubSystem failed!', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); - Exit; - end; - - SampleBufferSize := IAudioOutputBufferSizeVals[Ini.AudioOutputBufferSizeIndex]; - if (SampleBufferSize <= 0) then - begin - // Automatic setting default - // FIXME: too much glitches with 1024 samples - SampleBufferSize := 2048; //1024; - end; - - FillChar(DesiredAudioSpec, SizeOf(DesiredAudioSpec), 0); - with DesiredAudioSpec do - begin - freq := 44100; - format := AUDIO_S16SYS; - channels := 2; - samples := SampleBufferSize; - callback := @SDLAudioCallback; - userdata := Self; - end; - - // Note: always use the "obtained" parameter, otherwise SDL might try to convert - // the samples itself if the desired format is not available. This might lead - // to problems if for example ALSA does not support 44100Hz and proposes 48000Hz. - // Without the obtained parameter, SDL would try to convert 44.1kHz to 48kHz with - // its crappy (non working) converter resulting in a wrong (too high) pitch. - if(SDL_OpenAudio(@DesiredAudioSpec, @ObtainedAudioSpec) = -1) then - begin - Log.LogStatus('SDL_OpenAudio: ' + SDL_GetError(), 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); - Exit; - end; - - FormatInfo := TAudioFormatInfo.Create( - ObtainedAudioSpec.channels, - ObtainedAudioSpec.freq, - asfS16 - ); - - // Note: SDL does not provide info of the internal buffer state. - // So we use the average buffer-size. - Latency := (ObtainedAudioSpec.samples/2) / FormatInfo.SampleRate; - - Log.LogStatus('Opened audio device', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); - - Result := true; -end; - -function TAudioPlayback_SDL.StartAudioPlaybackEngine(): boolean; -begin - SDL_PauseAudio(0); - Result := true; -end; - -procedure TAudioPlayback_SDL.StopAudioPlaybackEngine(); -begin - SDL_PauseAudio(1); -end; - -function TAudioPlayback_SDL.FinalizeAudioPlaybackEngine(): boolean; -begin - SDL_CloseAudio(); - SDL_QuitSubSystem(SDL_INIT_AUDIO); - Result := true; -end; - -function TAudioPlayback_SDL.GetLatency(): double; -begin - Result := Latency; -end; - -procedure TAudioPlayback_SDL.MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); -begin - SDL_MixAudio(PUInt8(dst), PUInt8(src), size, Round(volume * SDL_MIX_MAXVOLUME)); -end; - - -initialization - MediaManager.add(TAudioPlayback_SDL.Create); - -end. diff --git a/src/Classes/UAudioPlayback_SoftMixer.pas b/src/Classes/UAudioPlayback_SoftMixer.pas deleted file mode 100644 index 6ddae980..00000000 --- a/src/Classes/UAudioPlayback_SoftMixer.pas +++ /dev/null @@ -1,1132 +0,0 @@ -unit UAudioPlayback_SoftMixer; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses - Classes, - SysUtils, - sdl, - URingBuffer, - UMusic, - UAudioPlaybackBase; - -type - TAudioPlayback_SoftMixer = class; - - TGenericPlaybackStream = class(TAudioPlaybackStream) - private - Engine: TAudioPlayback_SoftMixer; - - SampleBuffer: PChar; - SampleBufferSize: integer; - SampleBufferCount: integer; // number of available bytes in SampleBuffer - SampleBufferPos: cardinal; - - SourceBuffer: PChar; - SourceBufferSize: integer; - SourceBufferCount: integer; // number of available bytes in SourceBuffer - - Converter: TAudioConverter; - Status: TStreamStatus; - InternalLock: PSDL_Mutex; - SoundEffects: TList; - fVolume: single; - - FadeInStartTime, FadeInTime: cardinal; - FadeInStartVolume, FadeInTargetVolume: single; - - NeedsRewind: boolean; - - procedure Reset(); - - procedure ApplySoundEffects(Buffer: PChar; BufferSize: integer); - function InitFormatConversion(): boolean; - procedure FlushBuffers(); - - procedure LockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF} - procedure UnlockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF} - protected - function GetLatency(): double; override; - function GetStatus(): TStreamStatus; override; - function GetVolume(): single; override; - procedure SetVolume(Volume: single); override; - function GetLength(): real; override; - function GetLoop(): boolean; override; - procedure SetLoop(Enabled: boolean); override; - function GetPosition: real; override; - procedure SetPosition(Time: real); override; - public - constructor Create(Engine: TAudioPlayback_SoftMixer); - destructor Destroy(); override; - - function Open(SourceStream: TAudioSourceStream): boolean; override; - procedure Close(); override; - - procedure Play(); override; - procedure Pause(); override; - procedure Stop(); override; - procedure FadeIn(Time: real; TargetVolume: single); override; - - function GetAudioFormatInfo(): TAudioFormatInfo; override; - - function ReadData(Buffer: PChar; BufferSize: integer): integer; - - function GetPCMData(var Data: TPCMData): Cardinal; override; - procedure GetFFTData(var Data: TFFTData); override; - - procedure AddSoundEffect(Effect: TSoundEffect); override; - procedure RemoveSoundEffect(Effect: TSoundEffect); override; - end; - - TAudioMixerStream = class - private - Engine: TAudioPlayback_SoftMixer; - - ActiveStreams: TList; - MixerBuffer: PChar; - InternalLock: PSDL_Mutex; - - AppVolume: single; - - procedure Lock(); {$IFDEF HasInline}inline;{$ENDIF} - procedure Unlock(); {$IFDEF HasInline}inline;{$ENDIF} - - function GetVolume(): single; - procedure SetVolume(Volume: single); - public - constructor Create(Engine: TAudioPlayback_SoftMixer); - destructor Destroy(); override; - procedure AddStream(Stream: TAudioPlaybackStream); - procedure RemoveStream(Stream: TAudioPlaybackStream); - function ReadData(Buffer: PChar; BufferSize: integer): integer; - - property Volume: single read GetVolume write SetVolume; - end; - - TAudioPlayback_SoftMixer = class(TAudioPlaybackBase) - private - MixerStream: TAudioMixerStream; - protected - FormatInfo: TAudioFormatInfo; - - function InitializeAudioPlaybackEngine(): boolean; virtual; abstract; - function StartAudioPlaybackEngine(): boolean; virtual; abstract; - procedure StopAudioPlaybackEngine(); virtual; abstract; - function FinalizeAudioPlaybackEngine(): boolean; virtual; abstract; - procedure AudioCallback(Buffer: PChar; Size: integer); {$IFDEF HasInline}inline;{$ENDIF} - - function CreatePlaybackStream(): TAudioPlaybackStream; override; - public - function GetName: String; override; abstract; - function InitializePlayback(): boolean; override; - function FinalizePlayback: boolean; override; - - procedure SetAppVolume(Volume: single); override; - - function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override; - - function GetMixer(): TAudioMixerStream; {$IFDEF HasInline}inline;{$ENDIF} - function GetAudioFormatInfo(): TAudioFormatInfo; - - procedure MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); virtual; - end; - -type - TGenericVoiceStream = class(TAudioVoiceStream) - private - VoiceBuffer: TRingBuffer; - BufferLock: PSDL_Mutex; - PlaybackStream: TGenericPlaybackStream; - Engine: TAudioPlayback_SoftMixer; - public - constructor Create(Engine: TAudioPlayback_SoftMixer); - - function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override; - procedure Close(); override; - procedure WriteData(Buffer: PChar; BufferSize: integer); override; - function ReadData(Buffer: PChar; BufferSize: integer): integer; override; - function IsEOF(): boolean; override; - function IsError(): boolean; override; - end; - -const - SOURCE_BUFFER_FRAMES = 4096; - -const - MAX_VOICE_DELAY = 0.500; // 20ms - -implementation - -uses - Math, - ULog, - UIni, - UFFT, - UAudioConverter, - UMain; - -{ TAudioMixerStream } - -constructor TAudioMixerStream.Create(Engine: TAudioPlayback_SoftMixer); -begin - inherited Create(); - - Self.Engine := Engine; - - ActiveStreams := TList.Create; - InternalLock := SDL_CreateMutex(); - AppVolume := 1.0; -end; - -destructor TAudioMixerStream.Destroy(); -begin - if assigned(MixerBuffer) then - Freemem(MixerBuffer); - ActiveStreams.Free; - SDL_DestroyMutex(InternalLock); - inherited; -end; - -procedure TAudioMixerStream.Lock(); -begin - SDL_mutexP(InternalLock); -end; - -procedure TAudioMixerStream.Unlock(); -begin - SDL_mutexV(InternalLock); -end; - -function TAudioMixerStream.GetVolume(): single; -begin - Lock(); - Result := AppVolume; - Unlock(); -end; - -procedure TAudioMixerStream.SetVolume(Volume: single); -begin - Lock(); - AppVolume := Volume; - Unlock(); -end; - -procedure TAudioMixerStream.AddStream(Stream: TAudioPlaybackStream); -begin - if not assigned(Stream) then - Exit; - - Lock(); - // check if stream is already in list to avoid duplicates - if (ActiveStreams.IndexOf(Pointer(Stream)) = -1) then - ActiveStreams.Add(Pointer(Stream)); - Unlock(); -end; - -(* - * Sets the entry of stream in the ActiveStreams-List to nil - * but does not remove it from the list (Count is not changed!). - * Otherwise iterations over the elements might fail due to a - * changed Count-property. - * Call ActiveStreams.Pack() to remove the nil-pointers - * or check for nil-pointers when accessing ActiveStreams. - *) -procedure TAudioMixerStream.RemoveStream(Stream: TAudioPlaybackStream); -var - Index: integer; -begin - Lock(); - Index := activeStreams.IndexOf(Pointer(Stream)); - if (Index <> -1) then - begin - // remove entry but do not decrease count-property - ActiveStreams[Index] := nil; - end; - Unlock(); -end; - -function TAudioMixerStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -var - i: integer; - Size: integer; - Stream: TGenericPlaybackStream; - NeedsPacking: boolean; -begin - Result := BufferSize; - - // zero target-buffer (silence) - FillChar(Buffer^, BufferSize, 0); - - // resize mixer-buffer if necessary - ReallocMem(MixerBuffer, BufferSize); - if not assigned(MixerBuffer) then - Exit; - - Lock(); - - NeedsPacking := false; - - // mix streams to one stream - for i := 0 to ActiveStreams.Count-1 do - begin - if (ActiveStreams[i] = nil) then - begin - NeedsPacking := true; - continue; - end; - - Stream := TGenericPlaybackStream(ActiveStreams[i]); - // fetch data from current stream - Size := Stream.ReadData(MixerBuffer, BufferSize); - if (Size > 0) then - begin - // mix stream-data with mixer-buffer - // Note: use Self.appVolume instead of Self.Volume to prevent recursive locking - Engine.MixBuffers(Buffer, MixerBuffer, Size, AppVolume * Stream.Volume); - end; - end; - - // remove nil-pointers from list - if (NeedsPacking) then - begin - ActiveStreams.Pack(); - end; - - Unlock(); -end; - - -{ TGenericPlaybackStream } - -constructor TGenericPlaybackStream.Create(Engine: TAudioPlayback_SoftMixer); -begin - inherited Create(); - Self.Engine := Engine; - InternalLock := SDL_CreateMutex(); - SoundEffects := TList.Create; - Status := ssStopped; - Reset(); -end; - -destructor TGenericPlaybackStream.Destroy(); -begin - Close(); - SDL_DestroyMutex(InternalLock); - FreeAndNil(SoundEffects); - inherited; -end; - -procedure TGenericPlaybackStream.Reset(); -begin - SourceStream := nil; - - FreeAndNil(Converter); - - FreeMem(SampleBuffer); - SampleBuffer := nil; - SampleBufferPos := 0; - SampleBufferSize := 0; - SampleBufferCount := 0; - - FreeMem(SourceBuffer); - SourceBuffer := nil; - SourceBufferSize := 0; - SourceBufferCount := 0; - - NeedsRewind := false; - - fVolume := 0; - SoundEffects.Clear; - FadeInTime := 0; -end; - -function TGenericPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean; -begin - Result := false; - - Close(); - - if (not assigned(SourceStream)) then - Exit; - Self.SourceStream := SourceStream; - - if (not InitFormatConversion()) then - begin - // reset decode-stream so it will not be freed on destruction - Self.SourceStream := nil; - Exit; - end; - - SourceBufferSize := SOURCE_BUFFER_FRAMES * SourceStream.GetAudioFormatInfo().FrameSize; - GetMem(SourceBuffer, SourceBufferSize); - fVolume := 1.0; - - Result := true; -end; - -procedure TGenericPlaybackStream.Close(); -begin - // stop audio-callback on this stream - Stop(); - - // Note: PerformOnClose must be called before SourceStream is invalidated - PerformOnClose(); - // and free data - Reset(); -end; - -procedure TGenericPlaybackStream.LockSampleBuffer(); -begin - SDL_mutexP(InternalLock); -end; - -procedure TGenericPlaybackStream.UnlockSampleBuffer(); -begin - SDL_mutexV(InternalLock); -end; - -function TGenericPlaybackStream.InitFormatConversion(): boolean; -var - SrcFormatInfo: TAudioFormatInfo; - DstFormatInfo: TAudioFormatInfo; -begin - Result := false; - - SrcFormatInfo := SourceStream.GetAudioFormatInfo(); - DstFormatInfo := GetAudioFormatInfo(); - - // TODO: selection should not be done here, use a factory (TAudioConverterFactory) instead - {$IF Defined(UseFFmpegResample)} - Converter := TAudioConverter_FFmpeg.Create(); - {$ELSEIF Defined(UseSRCResample)} - Converter := TAudioConverter_SRC.Create(); - {$ELSE} - Converter := TAudioConverter_SDL.Create(); - {$IFEND} - - Result := Converter.Init(SrcFormatInfo, DstFormatInfo); -end; - -procedure TGenericPlaybackStream.Play(); -var - Mixer: TAudioMixerStream; -begin - // only paused streams are not flushed - if (Status = ssPaused) then - NeedsRewind := false; - - // rewind if necessary. Cases that require no rewind are: - // - stream was created and never played - // - stream was paused and is resumed now - // - stream was stopped and set to a new position already - if (NeedsRewind) then - SetPosition(0); - - // update status - Status := ssPlaying; - - NeedsRewind := true; - - // add this stream to the mixer - Mixer := Engine.GetMixer(); - if (Mixer <> nil) then - Mixer.AddStream(Self); -end; - -procedure TGenericPlaybackStream.FadeIn(Time: real; TargetVolume: single); -begin - FadeInTime := Trunc(Time * 1000); - FadeInStartTime := SDL_GetTicks(); - FadeInStartVolume := fVolume; - FadeInTargetVolume := TargetVolume; - Play(); -end; - -procedure TGenericPlaybackStream.Pause(); -var - Mixer: TAudioMixerStream; -begin - if (Status <> ssPlaying) then - Exit; - - Status := ssPaused; - - Mixer := Engine.GetMixer(); - if (Mixer <> nil) then - Mixer.RemoveStream(Self); -end; - -procedure TGenericPlaybackStream.Stop(); -var - Mixer: TAudioMixerStream; -begin - if (Status = ssStopped) then - Exit; - - Status := ssStopped; - - Mixer := Engine.GetMixer(); - if (Mixer <> nil) then - Mixer.RemoveStream(Self); -end; - -function TGenericPlaybackStream.GetLoop(): boolean; -begin - if assigned(SourceStream) then - Result := SourceStream.Loop - else - Result := false; -end; - -procedure TGenericPlaybackStream.SetLoop(Enabled: boolean); -begin - if assigned(SourceStream) then - SourceStream.Loop := Enabled; -end; - -function TGenericPlaybackStream.GetLength(): real; -begin - if assigned(SourceStream) then - Result := SourceStream.Length - else - Result := -1; -end; - -function TGenericPlaybackStream.GetLatency(): double; -begin - Result := Engine.GetLatency(); -end; - -function TGenericPlaybackStream.GetStatus(): TStreamStatus; -begin - Result := Status; -end; - -function TGenericPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo; -begin - Result := Engine.GetAudioFormatInfo(); -end; - -procedure TGenericPlaybackStream.FlushBuffers(); -begin - SampleBufferCount := 0; - SampleBufferPos := 0; - SourceBufferCount := 0; -end; - -procedure TGenericPlaybackStream.ApplySoundEffects(Buffer: PChar; BufferSize: integer); -var - i: integer; -begin - for i := 0 to SoundEffects.Count-1 do - begin - if (SoundEffects[i] <> nil) then - begin - TSoundEffect(SoundEffects[i]).Callback(Buffer, BufferSize); - end; - end; -end; - -function TGenericPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -var - ConversionInputCount: integer; - ConversionOutputSize: integer; // max. number of converted data (= buffer size) - ConversionOutputCount: integer; // actual number of converted data - SourceSize: integer; - RequestedSourceSize: integer; - NeededSampleBufferSize: integer; - BytesNeeded, BytesAvail: integer; - SourceFormatInfo, OutputFormatInfo: TAudioFormatInfo; - SourceFrameSize, OutputFrameSize: integer; - SkipOutputCount: integer; // number of output-data bytes to skip - SkipSourceCount: integer; // number of source-data bytes to skip - FillCount: integer; // number of bytes to fill with padding data - CopyCount: integer; - PadFrame: PChar; - i: integer; -begin - Result := -1; - - // sanity check for the source-stream - if (not assigned(SourceStream)) then - Exit; - - SkipOutputCount := 0; - SkipSourceCount := 0; - FillCount := 0; - - SourceFormatInfo := SourceStream.GetAudioFormatInfo(); - SourceFrameSize := SourceFormatInfo.FrameSize; - OutputFormatInfo := GetAudioFormatInfo(); - OutputFrameSize := OutputFormatInfo.FrameSize; - - // synchronize (adjust buffer size) - BytesNeeded := Synchronize(BufferSize, OutputFormatInfo); - if (BytesNeeded > BufferSize) then - begin - SkipOutputCount := BytesNeeded - BufferSize; - BytesNeeded := BufferSize; - end - else if (BytesNeeded < BufferSize) then - begin - FillCount := BufferSize - BytesNeeded; - end; - - // lock access to sample-buffer - LockSampleBuffer(); - try - - // skip sample-buffer data - SampleBufferPos := SampleBufferPos + SkipOutputCount; - // size of available bytes in SampleBuffer after skipping - SampleBufferCount := SampleBufferCount - SampleBufferPos; - // update byte skip-count - SkipOutputCount := -SampleBufferCount; - - // now that we skipped all buffered data from the last pass, we have to skip - // data directly after fetching it from the source-stream. - if (SkipOutputCount > 0) then - begin - SampleBufferCount := 0; - // convert skip-count to source-format units and resize to a multiple of - // the source frame-size. - SkipSourceCount := Round((SkipOutputCount * OutputFormatInfo.GetRatio(SourceFormatInfo)) / - SourceFrameSize) * SourceFrameSize; - SkipOutputCount := 0; - end; - - // copy data to front of buffer - if ((SampleBufferCount > 0) and (SampleBufferPos > 0)) then - Move(SampleBuffer[SampleBufferPos], SampleBuffer[0], SampleBufferCount); - SampleBufferPos := 0; - - // resize buffer to a reasonable size - if (BufferSize > SampleBufferCount) then - begin - // Note: use BufferSize instead of BytesNeeded to minimize the need for resizing - SampleBufferSize := BufferSize; - ReallocMem(SampleBuffer, SampleBufferSize); - if (not assigned(SampleBuffer)) then - Exit; - end; - - // fill sample-buffer (fetch and convert one block of source data per loop) - while (SampleBufferCount < BytesNeeded) do - begin - // move remaining source data from the previous pass to front of buffer - if (SourceBufferCount > 0) then - begin - Move(SourceBuffer[SourceBufferSize-SourceBufferCount], - SourceBuffer[0], - SourceBufferCount); - end; - - SourceSize := SourceStream.ReadData( - @SourceBuffer[SourceBufferCount], SourceBufferSize-SourceBufferCount); - // break on error (-1) or if no data is available (0), e.g. while seeking - if (SourceSize <= 0) then - begin - // if we do not have data -> exit - if (SourceBufferCount = 0) then - begin - FlushBuffers(); - Exit; - end; - // if we have some data, stop retrieving data from the source stream - // and use the data we have so far - Break; - end; - - SourceBufferCount := SourceBufferCount + SourceSize; - - // end-of-file reached -> stop playback - if (SourceStream.EOF) then - begin - if (Loop) then - SourceStream.Position := 0 - else - Stop(); - end; - - if (SkipSourceCount > 0) then - begin - // skip data and update source buffer count - SourceBufferCount := SourceBufferCount - SkipSourceCount; - SkipSourceCount := -SourceBufferCount; - // continue with next pass if we skipped all data - if (SourceBufferCount <= 0) then - begin - SourceBufferCount := 0; - Continue; - end; - end; - - // calc buffer size (might be bigger than actual resampled byte count) - ConversionOutputSize := Converter.GetOutputBufferSize(SourceBufferCount); - NeededSampleBufferSize := SampleBufferCount + ConversionOutputSize; - - // resize buffer if necessary - if (SampleBufferSize < NeededSampleBufferSize) then - begin - SampleBufferSize := NeededSampleBufferSize; - ReallocMem(SampleBuffer, SampleBufferSize); - if (not assigned(SampleBuffer)) then - begin - FlushBuffers(); - Exit; - end; - end; - - // resample source data (Note: ConversionInputCount might be adjusted by Convert()) - ConversionInputCount := SourceBufferCount; - ConversionOutputCount := Converter.Convert( - SourceBuffer, @SampleBuffer[SampleBufferCount], ConversionInputCount); - if (ConversionOutputCount = -1) then - begin - FlushBuffers(); - Exit; - end; - - // adjust sample- and source-buffer count by the number of converted bytes - SampleBufferCount := SampleBufferCount + ConversionOutputCount; - SourceBufferCount := SourceBufferCount - ConversionInputCount; - end; - - // apply effects - ApplySoundEffects(SampleBuffer, SampleBufferCount); - - // copy data to result buffer - CopyCount := Min(BytesNeeded, SampleBufferCount); - Move(SampleBuffer[0], Buffer[BufferSize - BytesNeeded], CopyCount); - Dec(BytesNeeded, CopyCount); - SampleBufferPos := CopyCount; - - // release buffer lock - finally - UnlockSampleBuffer(); - end; - - // pad the buffer with the last frame if we are to fast - if (FillCount > 0) then - begin - if (CopyCount >= OutputFrameSize) then - PadFrame := @Buffer[CopyCount-OutputFrameSize] - else - PadFrame := nil; - FillBufferWithFrame(@Buffer[CopyCount], FillCount, - PadFrame, OutputFrameSize); - end; - - // BytesNeeded now contains the number of remaining bytes we were not able to fetch - Result := BufferSize - BytesNeeded; -end; - -function TGenericPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal; -var - ByteCount: integer; -begin - Result := 0; - - // just SInt16 stereo support for now - if ((Engine.GetAudioFormatInfo().Format <> asfS16) or - (Engine.GetAudioFormatInfo().Channels <> 2)) then - begin - Exit; - end; - - // zero memory - FillChar(Data, SizeOf(Data), 0); - - // TODO: At the moment just the first samples of the SampleBuffer - // are returned, even if there is newer data in the upper samples. - - LockSampleBuffer(); - ByteCount := Min(SizeOf(Data), SampleBufferCount); - if (ByteCount > 0) then - begin - Move(SampleBuffer[0], Data, ByteCount); - end; - UnlockSampleBuffer(); - - Result := ByteCount div SizeOf(TPCMStereoSample); -end; - -procedure TGenericPlaybackStream.GetFFTData(var Data: TFFTData); -var - i: integer; - Frames: integer; - DataIn: PSingleArray; - AudioFormat: TAudioFormatInfo; -begin - // only works with SInt16 and Float values at the moment - AudioFormat := GetAudioFormatInfo(); - - DataIn := AllocMem(FFTSize * SizeOf(Single)); - if (DataIn = nil) then - Exit; - - LockSampleBuffer(); - // TODO: We just use the first Frames frames, the others are ignored. - Frames := Min(FFTSize, SampleBufferCount div AudioFormat.FrameSize); - // use only first channel and convert data to float-values - case AudioFormat.Format of - asfS16: - begin - for i := 0 to Frames-1 do - DataIn[i] := PSmallInt(@SampleBuffer[i*AudioFormat.FrameSize])^ / -Low(SmallInt); - end; - asfFloat: - begin - for i := 0 to Frames-1 do - DataIn[i] := PSingle(@SampleBuffer[i*AudioFormat.FrameSize])^; - end; - end; - UnlockSampleBuffer(); - - WindowFunc(fwfHanning, FFTSize, DataIn); - PowerSpectrum(FFTSize, DataIn, @Data); - FreeMem(DataIn); - - // resize data to a 0..1 range - for i := 0 to High(TFFTData) do - begin - Data[i] := Sqrt(Data[i]) / 100; - end; -end; - -procedure TGenericPlaybackStream.AddSoundEffect(Effect: TSoundEffect); -begin - if (not assigned(Effect)) then - Exit; - - LockSampleBuffer(); - // check if effect is already in list to avoid duplicates - if (SoundEffects.IndexOf(Pointer(Effect)) = -1) then - SoundEffects.Add(Pointer(Effect)); - UnlockSampleBuffer(); -end; - -procedure TGenericPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect); -begin - LockSampleBuffer(); - SoundEffects.Remove(Effect); - UnlockSampleBuffer(); -end; - -function TGenericPlaybackStream.GetPosition: real; -var - BufferedTime: double; -begin - if assigned(SourceStream) then - begin - LockSampleBuffer(); - - // calc the time of source data that is buffered (in the SampleBuffer and SourceBuffer) - // but not yet outputed - BufferedTime := (SampleBufferCount - SampleBufferPos) / Engine.FormatInfo.BytesPerSec + - SourceBufferCount / SourceStream.GetAudioFormatInfo().BytesPerSec; - // and subtract it from the source position - Result := SourceStream.Position - BufferedTime; - - UnlockSampleBuffer(); - end - else - begin - Result := -1; - end; -end; - -procedure TGenericPlaybackStream.SetPosition(Time: real); -begin - if assigned(SourceStream) then - begin - LockSampleBuffer(); - - SourceStream.Position := Time; - if (Status = ssStopped) then - NeedsRewind := false; - // do not use outdated data - FlushBuffers(); - - AvgSyncDiff := -1; - - UnlockSampleBuffer(); - end; -end; - -function TGenericPlaybackStream.GetVolume(): single; -var - FadeAmount: Single; -begin - LockSampleBuffer(); - // adjust volume if fading is enabled - if (FadeInTime > 0) then - begin - FadeAmount := (SDL_GetTicks() - FadeInStartTime) / FadeInTime; - // check if fade-target is reached - if (FadeAmount >= 1) then - begin - // target reached -> stop fading - FadeInTime := 0; - fVolume := FadeInTargetVolume; - end - else - begin - // fading in progress - fVolume := FadeAmount*FadeInTargetVolume + (1-FadeAmount)*FadeInStartVolume; - end; - end; - // return current volume - Result := fVolume; - UnlockSampleBuffer(); -end; - -procedure TGenericPlaybackStream.SetVolume(Volume: single); -begin - LockSampleBuffer(); - // stop fading - FadeInTime := 0; - // clamp volume - if (Volume > 1.0) then - fVolume := 1.0 - else if (Volume < 0) then - fVolume := 0 - else - fVolume := Volume; - UnlockSampleBuffer(); -end; - - -{ TGenericVoiceStream } - -constructor TGenericVoiceStream.Create(Engine: TAudioPlayback_SoftMixer); -begin - inherited Create(); - Self.Engine := Engine; -end; - -function TGenericVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; -var - BufferSize: integer; -begin - Result := false; - - Close(); - - if (not inherited Open(ChannelMap, FormatInfo)) then - Exit; - - // Note: - // - use Self.FormatInfo instead of FormatInfo as the latter one might have a - // channel size of 2. - // - the buffer-size must be a multiple of the FrameSize - BufferSize := (Ceil(MAX_VOICE_DELAY * Self.FormatInfo.BytesPerSec) div Self.FormatInfo.FrameSize) * - Self.FormatInfo.FrameSize; - VoiceBuffer := TRingBuffer.Create(BufferSize); - - BufferLock := SDL_CreateMutex(); - - - // create a matching playback stream for the voice-stream - PlaybackStream := TGenericPlaybackStream.Create(Engine); - // link voice- and playback-stream - if (not PlaybackStream.Open(Self)) then - begin - PlaybackStream.Free; - Exit; - end; - - // start voice passthrough - PlaybackStream.Play(); - - Result := true; -end; - -procedure TGenericVoiceStream.Close(); -begin - // stop and free the playback stream - FreeAndNil(PlaybackStream); - - // free data - FreeAndNil(VoiceBuffer); - if (BufferLock <> nil) then - SDL_DestroyMutex(BufferLock); - - inherited Close(); -end; - -procedure TGenericVoiceStream.WriteData(Buffer: PChar; BufferSize: integer); -begin - // lock access to buffer - SDL_mutexP(BufferLock); - try - if (VoiceBuffer = nil) then - Exit; - VoiceBuffer.Write(Buffer, BufferSize); - finally - SDL_mutexV(BufferLock); - end; -end; - -function TGenericVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -begin - Result := -1; - - // lock access to buffer - SDL_mutexP(BufferLock); - try - if (VoiceBuffer = nil) then - Exit; - Result := VoiceBuffer.Read(Buffer, BufferSize); - finally - SDL_mutexV(BufferLock); - end; -end; - -function TGenericVoiceStream.IsEOF(): boolean; -begin - SDL_mutexP(BufferLock); - Result := (VoiceBuffer = nil); - SDL_mutexV(BufferLock); -end; - -function TGenericVoiceStream.IsError(): boolean; -begin - Result := false; -end; - - -{ TAudioPlayback_SoftMixer } - -function TAudioPlayback_SoftMixer.InitializePlayback: boolean; -begin - Result := false; - - //Log.LogStatus('InitializePlayback', 'UAudioPlayback_SoftMixer'); - - if(not InitializeAudioPlaybackEngine()) then - Exit; - - MixerStream := TAudioMixerStream.Create(Self); - - if(not StartAudioPlaybackEngine()) then - Exit; - - Result := true; -end; - -function TAudioPlayback_SoftMixer.FinalizePlayback: boolean; -begin - Close; - StopAudioPlaybackEngine(); - - FreeAndNil(MixerStream); - FreeAndNil(FormatInfo); - - FinalizeAudioPlaybackEngine(); - inherited FinalizePlayback; - Result := true; -end; - -procedure TAudioPlayback_SoftMixer.AudioCallback(Buffer: PChar; Size: integer); -begin - MixerStream.ReadData(Buffer, Size); -end; - -function TAudioPlayback_SoftMixer.GetMixer(): TAudioMixerStream; -begin - Result := MixerStream; -end; - -function TAudioPlayback_SoftMixer.GetAudioFormatInfo(): TAudioFormatInfo; -begin - Result := FormatInfo; -end; - -function TAudioPlayback_SoftMixer.CreatePlaybackStream(): TAudioPlaybackStream; -begin - Result := TGenericPlaybackStream.Create(Self); -end; - -function TAudioPlayback_SoftMixer.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; -var - VoiceStream: TGenericVoiceStream; -begin - Result := nil; - - // create a voice stream - VoiceStream := TGenericVoiceStream.Create(Self); - if (not VoiceStream.Open(ChannelMap, FormatInfo)) then - begin - VoiceStream.Free; - Exit; - end; - - Result := VoiceStream; -end; - -procedure TAudioPlayback_SoftMixer.SetAppVolume(Volume: single); -begin - // sets volume only for this application - MixerStream.Volume := Volume; -end; - -procedure TAudioPlayback_SoftMixer.MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); -var - SampleIndex: Cardinal; - SampleInt: Integer; - SampleFlt: Single; -begin - SampleIndex := 0; - case FormatInfo.Format of - asfS16: - begin - while (SampleIndex < Size) do - begin - // apply volume and sum with previous mixer value - SampleInt := PSmallInt(@DstBuffer[SampleIndex])^ + - Round(PSmallInt(@SrcBuffer[SampleIndex])^ * Volume); - // clip result - if (SampleInt > High(SmallInt)) then - SampleInt := High(SmallInt) - else if (SampleInt < Low(SmallInt)) then - SampleInt := Low(SmallInt); - // assign result - PSmallInt(@DstBuffer[SampleIndex])^ := SampleInt; - // increase index by one sample - Inc(SampleIndex, SizeOf(SmallInt)); - end; - end; - asfFloat: - begin - while (SampleIndex < Size) do - begin - // apply volume and sum with previous mixer value - SampleFlt := PSingle(@DstBuffer[SampleIndex])^ + - PSingle(@SrcBuffer[SampleIndex])^ * Volume; - // clip result - if (SampleFlt > 1.0) then - SampleFlt := 1.0 - else if (SampleFlt < -1.0) then - SampleFlt := -1.0; - // assign result - PSingle(@DstBuffer[SampleIndex])^ := SampleFlt; - // increase index by one sample - Inc(SampleIndex, SizeOf(Single)); - end; - end; - else - begin - Log.LogError('Incompatible format', 'TAudioMixerStream.MixAudio'); - end; - end; -end; - -end. diff --git a/src/Classes/UCatCovers.pas b/src/Classes/UCatCovers.pas deleted file mode 100644 index d8f6cdb0..00000000 --- a/src/Classes/UCatCovers.pas +++ /dev/null @@ -1,173 +0,0 @@ -unit UCatCovers; -///////////////////////////////////////////////////////////////////////// -// UCatCovers by Whiteshark // -// Class for listing and managing the Category Covers // -///////////////////////////////////////////////////////////////////////// - -interface - -{$I switches.inc} - -uses UIni; - -type - TCatCovers = class - protected - cNames: array [0..high(ISorting)] of array of string; - cFiles: array [0..high(ISorting)] of array of string; - public - constructor Create; - procedure Load; //Load Cover aus Cover.ini and Cover Folder - procedure LoadPath(const CoversPath: string); - procedure Add(Sorting: integer; Name, Filename: string); //Add a Cover - function CoverExists(Sorting: integer; Name: string): boolean; //Returns True when a cover with the given Name exists - function GetCover(Sorting: integer; Name: string): string; //Returns the Filename of a Cover - end; - -var - CatCovers: TCatCovers; - -implementation - -uses - IniFiles, - SysUtils, - Classes, - // UFiles, - UMain, - ULog; - -constructor TCatCovers.Create; -begin - inherited; - Load; -end; - -procedure TCatCovers.Load; -var - I: integer; -begin - for I := 0 to CoverPaths.Count-1 do - LoadPath(CoverPaths[I]); -end; - -(** - * Load Cover from Cover.ini and Cover Folder - *) -procedure TCatCovers.LoadPath(const CoversPath: string); -var - Ini: TMemIniFile; - SR: TSearchRec; - List: TStringlist; - I, J: Integer; - Name, Filename, Temp: string; -begin - Ini := nil; - List := nil; - - try - Ini := TMemIniFile.Create(CoversPath + 'covers.ini'); - List := TStringlist.Create; - - //Add every Cover in Covers Ini for Every Sorting option - for I := 0 to High(ISorting) do - begin - Ini.ReadSection(ISorting[I], List); - - for J := 0 to List.Count - 1 do - Add(I, List.Strings[J], CoversPath + Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg')); - end; - finally - Ini.Free; - List.Free; - end; - - try - //Add Covers from Folder - if (FindFirst (CoversPath + '*.jpg', faAnyFile, SR) = 0) then - repeat - //Add Cover if it doesn't exist for every Section - Name := SR.Name; - Filename := CoversPath + Name; - Delete (Name, length(Name) - 3, 4); - - for I := 0 to high(ISorting) do - begin - Temp := Name; - if ((I = sTitle) or (I = sTitle2)) and (Pos ('Title', Temp) <> 0) then - Delete (Temp, Pos ('Title', Temp), 5) - else if (I = sArtist) or (I = sArtist2) and (Pos ('Artist', Temp) <> 0) then - Delete (Temp, Pos ('Artist', Temp), 6); - - if not CoverExists(I, Temp) then - Add (I, Temp, Filename); - end; - until FindNext (SR) <> 0; - finally - FindClose (SR); - end; -end; - - //Add a Cover -procedure TCatCovers.Add(Sorting: integer; Name, Filename: string); -begin - if FileExists (Filename) then //If Exists -> Add - begin - SetLength (CNames[Sorting], Length(CNames[Sorting]) + 1); - SetLength (CFiles[Sorting], Length(CNames[Sorting]) + 1); - - CNames[Sorting][high(cNames[Sorting])] := Uppercase(Name); - CFiles[Sorting][high(cNames[Sorting])] := FileName; - end; -end; - - //Returns True when a cover with the given Name exists -function TCatCovers.CoverExists(Sorting: integer; Name: string): boolean; -var - I: Integer; -begin - Result := False; - Name := Uppercase(Name); //Case Insensitiv - - for I := 0 to high(cNames[Sorting]) do - begin - if (cNames[Sorting][I] = Name) then //Found Name - begin - Result := true; - break; //Break For Loop - end; - end; -end; - - //Returns the Filename of a Cover -function TCatCovers.GetCover(Sorting: integer; Name: string): string; -var - I: Integer; -begin - Result := ''; - Name := Uppercase(Name); - - for I := 0 to high(cNames[Sorting]) do - begin - if cNames[Sorting][I] = Name then - begin - Result := cFiles[Sorting][I]; - Break; - end; - end; - - //No Cover - if (Result = '') then - begin - for I := 0 to CoverPaths.Count-1 do - begin - if (FileExists(CoverPaths[I] + 'NoCover.jpg')) then - begin - Result := CoverPaths[I] + 'NoCover.jpg'; - Break; - end; - end; - end; -end; - -end. diff --git a/src/Classes/UCommandLine.pas b/src/Classes/UCommandLine.pas deleted file mode 100644 index 3c56c606..00000000 --- a/src/Classes/UCommandLine.pas +++ /dev/null @@ -1,339 +0,0 @@ -unit UCommandLine; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -type - //----------- - // TCMDParams - Class Reads Infos from ParamStr and set some easy Interface Variables - //----------- - TCMDParams = class - private - sLanguage: String; - sResolution: String; - public - //Some Boolean Variables Set when Reading Infos - Debug: Boolean; - Benchmark: Boolean; - NoLog: Boolean; - FullScreen: Boolean; - Joypad: Boolean; - - //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} - Depth: Integer; - Screens: Integer; - - //Some Strings Set when Reading Infos {Length=0 Not Set} - SongPath: String; - ConfigFile: String; - ScoreFile: String; - - procedure showhelp(); - - //Pseudo Integer Values - Function GetLanguage: Integer; - Property Language: Integer read GetLanguage; - - Function GetResolution: Integer; - Property Resolution: Integer read GetResolution; - - //Some Procedures for Reading Infos - Constructor Create; - - Procedure ResetVariables; - Procedure ReadParamInfo; - end; - -var - Params: TCMDParams; - -const - cHelp = 'help'; - cDebug = 'debug'; - cMediaInterfaces = 'showinterfaces'; - cUseLocalPaths = 'localpaths'; - - -implementation - -uses SysUtils, - uPlatform; -// uINI -- Nasty requirement... ( removed with permission of blindy ) - - -//------------- -// Constructor - Create class, Reset Variables and Read Infos -//------------- -Constructor TCMDParams.Create; -begin - inherited; - - if FindCmdLineSwitch( cHelp ) or FindCmdLineSwitch( 'h' ) then - showhelp(); - - ResetVariables; - ReadParamInfo; -end; - -procedure TCMDParams.showhelp(); - - function s( aString : String ) : string; - begin - result := aString + StringofChar( ' ', 15 - length( aString ) ); - end; - -begin - - writeln( '' ); - writeln( '**************************************************************' ); - writeln( ' UltraStar Deluxe - Command line switches ' ); - writeln( '**************************************************************' ); - writeln( '' ); - writeln( ' '+s( 'Switch' ) +' : Purpose' ); - writeln( ' ----------------------------------------------------------' ); - writeln( ' '+s( cMediaInterfaces ) + #9 + ' : Show in-use media interfaces' ); - writeln( ' '+s( cUseLocalPaths ) + #9 + ' : Use relative paths' ); - writeln( ' '+s( cDebug ) + #9 + ' : Display Debugging info' ); - - - - writeln( '' ); - - platform.halt; -end; - -//------------- -// ResetVariables - Reset Class Variables -//------------- -Procedure TCMDParams.ResetVariables; -begin - Debug := False; - Benchmark := False; - NoLog := False; - FullScreen := False; - Joypad := False; - - //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} - sResolution := ''; - sLanguage := ''; - Depth := -1; - Screens := -1; - - //Some Strings Set when Reading Infos {Length=0 Not Set} - SongPath := ''; - ConfigFile := ''; - ScoreFile := ''; -end; - -//------------- -// ReadParamInfo - Read Infos from Parameters -//------------- -Procedure TCMDParams.ReadParamInfo; -var - I: Integer; - PCount: Integer; - Command: String; -begin - PCount := ParamCount; - //Log.LogError('ParamCount: ' + Inttostr(PCount)); - - - //Check all Parameters - For I := 1 to PCount do - begin - Command := Paramstr(I); - //Log.LogError('Start parsing Command: ' + Command); - //Is String Parameter ? - if (Length(Command) > 1) AND (Command[1] = '-') then - begin - //Remove - from Command - Command := Lowercase(Trim(Copy(Command, 2, Length(Command) - 1))); - //Log.LogError('Command prepared: ' + Command); - - //Check Command - - // Boolean Triggers: - if (Command = 'debug') then - Debug := True - else if (Command = 'benchmark') then - Benchmark := True - else if (Command = 'nolog') then - NoLog := True - else if (Command = 'fullscreen') then - Fullscreen := True - else if (Command = 'window') then - Fullscreen := False - else if (Command = 'joypad') then - Joypad := True - - //Integer Variables - else if (Command = 'depth') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - Command := ParamStr(I + 1); - - //Check for valid Value - If (Command = '16') then - Depth := 0 - Else If (Command = '32') then - Depth := 1; - end; - end - - else if (Command = 'screens') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - Command := ParamStr(I + 1); - - //Check for valid Value - If (Command = '1') then - Screens := 0 - Else If (Command = '2') then - Screens := 1; - end; - end - - //Pseudo Integer Values - else if (Command = 'language') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - //Write Value to String - sLanguage := Lowercase(ParamStr(I + 1)); - end; - end - - else if (Command = 'resolution') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - //Write Value to String - sResolution := Lowercase(ParamStr(I + 1)); - end; - end - - //String Values - else if (Command = 'songpath') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - //Write Value to String - SongPath := ParamStr(I + 1); - end; - end - - else if (Command = 'configfile') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - //Write Value to String - ConfigFile := ParamStr(I + 1); - - //is this a relative PAth -> then add Gamepath - if Not ((Length(ConfigFile) > 2) AND (ConfigFile[2] = ':')) then - ConfigFile := ExtractFilePath(ParamStr(0)) + Configfile; - end; - end - - else if (Command = 'scorefile') then - begin - //Check if there is another Parameter to get the Value from - if (PCount > I) then - begin - //Write Value to String - ScoreFile := ParamStr(I + 1); - end; - end; - - end; - - end; - -{ Log.LogError('Values: '); - - if Debug then - Log.LogError('Debug'); - - if Benchmark then - Log.LogError('Benchmark'); - - if NoLog then - Log.LogError('NoLog'); - - if Fullscreen then - Log.LogError('FullScreen'); - - if JoyStick then - Log.LogError('Joystick'); - - - Log.LogError('Screens: ' + Inttostr(Screens)); - Log.LogError('Depth: ' + Inttostr(Depth)); - - Log.LogError('Resolution: ' + Inttostr(Resolution)); - Log.LogError('Resolution: ' + Inttostr(Language)); - - Log.LogError('sResolution: ' + sResolution); - Log.LogError('sLanguage: ' + sLanguage); - - Log.LogError('ConfigFile: ' + ConfigFile); - Log.LogError('SongPath: ' + SongPath); - Log.LogError('ScoreFile: ' + ScoreFile); } - -end; - -//------------- -// GetLanguage - Get Language ID from saved String Information -//------------- -Function TCMDParams.GetLanguage: Integer; -var - I: integer; -begin - Result := -1; -{* JB - 12sep07 to remove uINI dependency - - //Search for Language - For I := 0 to high(ILanguage) do - if (LowerCase(ILanguage[I]) = sLanguage) then - begin - Result := I; - Break; - end; -*} -end; - -//------------- -// GetResolution - Get Resolution ID from saved String Information -//------------- -Function TCMDParams.GetResolution: Integer; -var - I: integer; -begin - Result := -1; -{* JB - 12sep07 to remove uINI dependency - - //Search for Resolution - For I := 0 to high(IResolution) do - if (LowerCase(IResolution[I]) = sResolution) then - begin - Result := I; - Break; - end; -*} -end; - -end. diff --git a/src/Classes/UCommon.pas b/src/Classes/UCommon.pas deleted file mode 100644 index 41e3c1f1..00000000 --- a/src/Classes/UCommon.pas +++ /dev/null @@ -1,774 +0,0 @@ -unit UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - Classes, - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF} - sdl, - UConfig, - ULog; - -type - TMessageType = ( mtInfo, mtError ); - -procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo ); - -procedure ConsoleWriteLn(const msg: string); - -function GetResourceStream(const aName, aType : string): TStream; -function RWopsFromStream(Stream: TStream): PSDL_RWops; - -{$IFDEF FPC} -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -{$ENDIF} - -function StringReplaceW(text : WideString; search, rep: WideChar):WideString; -function AdaptFilePaths( const aPath : widestring ): widestring; - -procedure DisableFloatingPointExceptions(); -procedure SetDefaultNumericLocale(); -procedure RestoreNumericLocale(); - -{$IFNDEF MSWINDOWS} - procedure ZeroMemory( Destination: Pointer; Length: DWORD ); - function MakeLong(a, b: Word): Longint; - (* - #define LOBYTE(a) (BYTE)(a) - #define HIBYTE(a) (BYTE)((a)>>8) - #define LOWORD(a) (WORD)(a) - #define HIWORD(a) (WORD)((a)>>16) - #define MAKEWORD(a,b) (WORD)(((a)&0xff)|((b)<<8)) - *) -{$ENDIF} - -function FileExistsInsensitive(var FileName: string): boolean; - -(* - * Character classes - *) - -function IsAlphaChar(ch: WideChar): boolean; -function IsNumericChar(ch: WideChar): boolean; -function IsAlphaNumericChar(ch: WideChar): boolean; -function IsPunctuationChar(ch: WideChar): boolean; -function IsControlChar(ch: WideChar): boolean; - -// A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below) -procedure MergeSort(List: TList; CompareFunc: TListSortCompare); - -function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer; -procedure FreeAlignedMem(P: Pointer); - - -implementation - -uses - Math, - {$IFDEF Delphi} - Dialogs, - {$ENDIF} - UMain; - - -// data used by the ...Locale() functions -{$IFDEF LINUX} - -var - PrevNumLocale: string; - -const - LC_NUMERIC = 1; - -function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' name 'setlocale'; - -{$ENDIF} - -// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '') -// to set the language/country specific locale (e.g. charset) for this application. -// Unfortunately, LC_NUMERIC is set by this call too. -// It defines the decimal-separator and other country-specific numeric settings. -// This parameter is used by the C string-to-float parsing functions atof() and strtod(). -// After changing LC_NUMERIC some external C-based libs (like projectM) are not -// able to parse strings correctly -// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is). -// So we reset the numeric settings to the default ('C'). -// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not -// changed by this because it doesn't use the locale-settings. -// TODO: -// - Check if this is needed in MacOSX (at least the locale is set in cwstring) -// - Find out which libs are concerned by this problem. -// If only projectM is concerned by this problem set and restore the numeric locale -// for each call to projectM instead of changing it globally. -procedure SetDefaultNumericLocale(); -begin - {$ifdef LINUX} - PrevNumLocale := setlocale(LC_NUMERIC, nil); - setlocale(LC_NUMERIC, 'C'); - {$endif} -end; - -procedure RestoreNumericLocale(); -begin - {$ifdef LINUX} - setlocale(LC_NUMERIC, PChar(PrevNumLocale)); - {$endif} -end; - -(* - * If an invalid floating point operation was performed the Floating-point unit (FPU) - * generates a Floating-point exception (FPE). Dependending on the settings in - * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself - * (we will call this as "FPE disabled" later on) or is passed to the application - * (FPE enabled). - * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is - * considered an error and an exception is thrown. Otherwise the FPU will handle - * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without - * throwing an error to the application. - * The same applies to a division by INF that either raises an exception - * (FPE enabled) or returns 0.0 (FPE disabled). - * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED - * on program startup (at least with Intel CPUs), but for some strange reasons - * they are ENABLED in pascal (both delphi and FPC) by default. - * Many libs operating with floating-point values rely heavily on the C-specific - * behaviour. So using them in delphi is a ticking time-bomb because sooner or - * later they will crash because of an FPE (this problem occurs massively - * in OpenGL-based libs like projectM). In contrast to this no error will occur - * if the lib is linked to a C-program. - * - * Further info on FPUs: - * For x86 and x86_64 CPUs we have to consider two FPU instruction sets. - * The math co-processor i387 (aka 8087 or x87) set introduced with the i386 - * and SSE (Streaming SIMD Extensions) introduced with the Pentium3. - * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR) - * to control FPEs. Either has (among others) 6bits to enable/disable several - * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision). - * Those exception-types must all be masked (=1) to get the default C behaviour. - * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE). - * Instead of using assembler code, we can use Set8087CW() provided by delphi and - * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR. - * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program - * startup but only FPC enables FPEs (especially div-by-zero) for SSE too. - * So we have to mask FPEs for x87 in Delphi and FPC and for SSE in FPC only. - * FPC and Delphi both provide a SetExceptionMask() for control of the FPE - * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE - * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask() - * is what we need and it even is plattform and CPU independent. - * - * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers) - * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL - * headers they do not work properly with FPC. I already patched them, so they - * work at least until they are updated the next time. In addition Set8086CW() - * does not suffice to disable FPEs because the SSE FPEs are not disabled by this. - * FPEs with SSE are a big problem with some libs because many linux distributions - * optimize code for SSE or Pentium3 (for example: int(INF) which convert the - * double value "infinity" to an integer might be automatically optimized by - * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case - * to make USDX portable. - * - * Summary: - * Call this function on initialization to make sure FPEs are turned off. - * It will solve a lot of errors with FPEs in external libs. - *) -procedure DisableFloatingPointExceptions(); -begin - (* - // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR(). - // Note: Leave these lines for documentation purposes just in case - // SetExceptionMask() does not work anymore (due to bugs in FPC etc.). - {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)} - Set8087CW($133F); - {$IFEND} - {$IF Defined(FPC)} - if (has_sse_support) then - SetSSECSR($1F80); - {$IFEND} - *) - - // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and - // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore). - SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, - exOverflow, exUnderflow, exPrecision]); -end; - -function StringReplaceW(text : WideString; search, rep: WideChar) : WideString; -var - iPos : integer; -// sTemp : WideString; -begin -(* - result := text; - iPos := Pos(search, result); - while (iPos > 0) do - begin - sTemp := copy(result, iPos + length(search), length(result)); - result := copy(result, 1, iPos - 1) + rep + sTEmp; - iPos := Pos(search, result); - end; -*) - result := text; - - if search = rep then - exit; - - for iPos := 1 to length(result) do - begin - if result[iPos] = search then - result[iPos] := rep; - end; -end; - -function AdaptFilePaths( const aPath : widestring ): widestring; -begin - result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); -end; - - -{$IFNDEF MSWINDOWS} -procedure ZeroMemory( Destination: Pointer; Length: DWORD ); -begin - FillChar( Destination^, Length, 0 ); -end; - -function MakeLong(A, B: Word): Longint; -begin - Result := (LongInt(B) shl 16) + A; -end; - -(* -function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; - - // From http://en.wikipedia.org/wiki/RDTSC - function RDTSC: Int64; register; - asm - rdtsc - end; - -begin - // Use clock_gettime(CLOCK_REALTIME, ...) here (but not from the libc unit) - lpPerformanceCount := RDTSC(); - result := true; -end; - -function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -begin - // clock_getres(CLOCK_REALTIME, ...) - lpFrequency := 0; - result := true; -end; -*) -{$ENDIF} - -// Checks if a regular files or directory with the given name exists. -// The comparison is case insensitive. -function FileExistsInsensitive(var FileName: string): boolean; -var - FilePath, LocalFileName: string; - SearchInfo: TSearchRec; -begin -{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems - // speed up standard case - if FileExists(FileName) then - begin - Result := true; - exit; - end; - - Result := false; - - FilePath := ExtractFilePath(FileName); - if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then - begin - LocalFileName := ExtractFileName(FileName); - repeat - if (AnsiSameText(LocalFileName, SearchInfo.Name)) then - begin - FileName := FilePath + SearchInfo.Name; - Result := true; - break; - end; - until (FindNext(SearchInfo) <> 0); - end; - FindClose(SearchInfo); -{$ELSE} - Result := FileExists(FileName); -{$ENDIF} -end; - - -{$IFDEF Unix} - // include resource-file info (stored in the constant array "resources") - {$I ../resource.inc} -{$ENDIF} - -function GetResourceStream(const aName, aType: string): TStream; -{$IFDEF Unix} -var - ResIndex: integer; - Filename: string; -{$ENDIF} -begin - Result := nil; - - {$IFDEF Unix} - for ResIndex := 0 to High(resources) do - begin - if (resources[ResIndex][0] = aName ) and - (resources[ResIndex][1] = aType ) then - begin - try - Filename := ResourcesPath + resources[ResIndex][2]; - Result := TFileStream.Create(Filename, fmOpenRead); - except - Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream'); - end; - exit; - end; - end; - {$ELSE} - try - Result := TResourceStream.Create(HInstance, aName , PChar(aType)); - except - Log.LogError('Invalid resource: "'+ aType + ':' + aName +'"', 'GetResourceStream'); - end; - {$ENDIF} -end; - -// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++ - function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl; - var - stream : TStream; - origin : Word; - begin - stream := TStream( context.unknown ); - if ( stream = nil ) then - raise EInvalidContainer.Create( 'SDLStreamSeek on nil' ); - case whence of - 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0. - 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset. - 2 : origin := soFromEnd; - else - origin := soFromBeginning; // just in case - end; - Result := stream.Seek( offset, origin ); - end; - - function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl; - var - stream : TStream; - begin - stream := TStream( context.unknown ); - if ( stream = nil ) then - raise EInvalidContainer.Create( 'SDLStreamRead on nil' ); - try - Result := stream.read( Ptr^, Size * maxnum ) div size; - except - Result := -1; - end; - end; - - function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl; - var - stream : TStream; - begin - stream := TStream( context.unknown ); - if ( stream = nil ) then - raise EInvalidContainer.Create( 'SDLStreamClose on nil' ); - stream.Free; - Result := 1; - end; -// ----------------------------------------------- - -(* - * Creates an SDL_RWops handle from a TStream. - * The stream and RWops must be freed by the user after usage. - * Use SDL_FreeRW(...) to free the RWops data-struct. - *) -function RWopsFromStream(Stream: TStream): PSDL_RWops; -begin - Result := SDL_AllocRW(); - if (Result = nil) then - Exit; - - // set RW-callbacks - with Result^ do - begin - unknown := TUnknown(Stream); - seek := SDLStreamSeek; - read := SDLStreamRead; - write := nil; - close := SDLStreamClose; - type_ := 2; - end; -end; - - - -{$IFDEF FPC} -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -begin - RandomRange := Random(aMax-aMin) + aMin ; -end; -{$ENDIF} - - -{$IFDEF FPC} -var - MessageList: TStringList; - ConsoleHandler: TThreadID; - // Note: TRTLCriticalSection is defined in the units System and Libc, use System one - ConsoleCriticalSection: System.TRTLCriticalSection; - ConsoleEvent: PRTLEvent; - ConsoleQuit: boolean; -{$ENDIF} - -(* - * Write to console if one is available. - * It checks if a console is available before output so it will not - * crash on windows if none is available. - * Do not use this function directly because it is not thread-safe, - * use ConsoleWriteLn() instead. - *) -procedure _ConsoleWriteLn(const aString: string); {$IFDEF HasInline}inline;{$ENDIF} -begin - {$IFDEF MSWINDOWS} - // sanity check to avoid crashes with writeln() - if (IsConsole) then - begin - {$ENDIF} - Writeln(aString); - {$IFDEF MSWINDOWS} - end; - {$ENDIF} -end; - -{$IFDEF FPC} -{* - * The console-handlers main-function. - * TODO: create a quit-event on closing. - *} -function ConsoleHandlerFunc(param: pointer): PtrInt; -var - i: integer; - quit: boolean; -begin - quit := false; - while (not quit) do - begin - // wait for new output or quit-request - RTLeventWaitFor(ConsoleEvent); - - System.EnterCriticalSection(ConsoleCriticalSection); - // output pending messages - for i := 0 to MessageList.Count-1 do - begin - _ConsoleWriteLn(MessageList[i]); - end; - MessageList.Clear(); - - // use local quit-variable to avoid accessing - // ConsoleQuit outside of the critical section - if (ConsoleQuit) then - quit := true; - - RTLeventResetEvent(ConsoleEvent); - System.LeaveCriticalSection(ConsoleCriticalSection); - end; - result := 0; -end; -{$ENDIF} - -procedure InitConsoleOutput(); -begin - {$IFDEF FPC} - // init thread-safe output - MessageList := TStringList.Create(); - System.InitCriticalSection(ConsoleCriticalSection); - ConsoleEvent := RTLEventCreate(); - ConsoleQuit := false; - // must be a thread managed by FPC. Otherwise (e.g. SDL-thread) - // it will crash when using Writeln. - ConsoleHandler := BeginThread(@ConsoleHandlerFunc); - {$ENDIF} -end; - -procedure FinalizeConsoleOutput(); -begin - {$IFDEF FPC} - // terminate console-handler - System.EnterCriticalSection(ConsoleCriticalSection); - ConsoleQuit := true; - RTLeventSetEvent(ConsoleEvent); - System.LeaveCriticalSection(ConsoleCriticalSection); - WaitForThreadTerminate(ConsoleHandler, 0); - // free data - System.DoneCriticalsection(ConsoleCriticalSection); - RTLeventDestroy(ConsoleEvent); - MessageList.Free(); - {$ENDIF} -end; - -{* - * With FPC console output is not thread-safe. - * Using WriteLn() from external threads (like in SDL callbacks) - * will damage the heap and crash the program. - * Most probably FPC uses thread-local-data (TLS) to lock a mutex on - * the console-buffer. This does not work with external lib's threads - * because these do not have the TLS data and so it crashes while - * accessing unallocated memory. - * The solution is to create an FPC-managed thread which has the TLS data - * and use it to handle the console-output (hence it is called Console-Handler) - * It should be safe to do so, but maybe FPC requires the main-thread to access - * the console-buffer only. In this case output should be delegated to it. - * - * TODO: - check if it is safe if an FPC-managed thread different than the - * main-thread accesses the console-buffer in FPC. - * - check if Delphi's WriteLn is thread-safe. - * - check if we need to synchronize file-output too - *} -procedure ConsoleWriteLn(const msg: string); -begin -{$IFDEF CONSOLE} - {$IFDEF FPC} - // TODO: check for the main-thread and use a simple _ConsoleWriteLn() then? - //GetCurrentThreadThreadId(); - System.EnterCriticalSection(ConsoleCriticalSection); - MessageList.Add(msg); - RTLeventSetEvent(ConsoleEvent); - System.LeaveCriticalSection(ConsoleCriticalSection); - {$ELSE} - _ConsoleWriteLn(msg); - {$ENDIF} -{$ENDIF} -end; - -procedure ShowMessage(const msg: String; msgType: TMessageType); -{$IFDEF MSWINDOWS} -var Flags: Cardinal; -{$ENDIF} -begin -{$IF Defined(MSWINDOWS)} - case msgType of - mtInfo: Flags := MB_ICONINFORMATION or MB_OK; - mtError: Flags := MB_ICONERROR or MB_OK; - else Flags := MB_OK; - end; - MessageBox(0, PChar(msg), PChar(USDXVersionStr()), Flags); -{$ELSE} - ConsoleWriteln(msg); -{$IFEND} -end; - -function IsAlphaChar(ch: WideChar): boolean; -begin - // TODO: add chars > 255 when unicode-fonts work? - case ch of - 'A'..'Z', // A-Z - 'a'..'z', // a-z - #170,#181,#186, - #192..#214, - #216..#246, - #248..#255: - Result := true; - else - Result := false; - end; -end; - -function IsNumericChar(ch: WideChar): boolean; -begin - case ch of - '0'..'9': - Result := true; - else - Result := false; - end; -end; - -function IsAlphaNumericChar(ch: WideChar): boolean; -begin - Result := (IsAlphaChar(ch) or IsNumericChar(ch)); -end; - -function IsPunctuationChar(ch: WideChar): boolean; -begin - // TODO: add chars outside of Latin1 basic (0..127)? - case ch of - ' '..'/',':'..'@','['..'`','{'..'~': - Result := true; - else - Result := false; - end; -end; - -function IsControlChar(ch: WideChar): boolean; -begin - case ch of - #0..#31, - #127..#159: - Result := true; - else - Result := false; - end; -end; - -(* - * Recursive part of the MergeSort algorithm. - * OutList will be either InList or TempList and will be swapped in each - * depth-level of recursion. By doing this it we can directly merge into the - * output-list. If we only had In- and OutList parameters we had to merge into - * InList after the recursive calls and copy the data to the OutList afterwards. - *) -procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: integer; - CompareFunc: TListSortCompare); -var - LeftSize, RightSize: integer; // number of elements in left/right block - LeftEnd, RightEnd: integer; // Index after last element in left/right block - MidPos: integer; // index of first element in right block - Pos: integer; // position in output list -begin - LeftSize := BlockSize div 2; - RightSize := BlockSize - LeftSize; - MidPos := StartPos + LeftSize; - - // sort left and right halves of this block by recursive calls of this function - if (LeftSize >= 2) then - _MergeSort(InList, OutList, TempList, StartPos, LeftSize, CompareFunc) - else - TempList[StartPos] := InList[StartPos]; - if (RightSize >= 2) then - _MergeSort(InList, OutList, TempList, MidPos, RightSize, CompareFunc) - else - TempList[MidPos] := InList[MidPos]; - - // merge sorted left and right sub-lists into output-list - LeftEnd := MidPos; - RightEnd := StartPos + BlockSize; - Pos := StartPos; - while ((StartPos < LeftEnd) and (MidPos < RightEnd)) do - begin - if (CompareFunc(TempList[StartPos], TempList[MidPos]) <= 0) then - begin - OutList[Pos] := TempList[StartPos]; - Inc(StartPos); - end - else - begin - OutList[Pos] := TempList[MidPos]; - Inc(MidPos); - end; - Inc(Pos); - end; - - // copy remaining elements to output-list - while (StartPos < LeftEnd) do - begin - OutList[Pos] := TempList[StartPos]; - Inc(StartPos); - Inc(Pos); - end; - while (MidPos < RightEnd) do - begin - OutList[Pos] := TempList[MidPos]; - Inc(MidPos); - Inc(Pos); - end; -end; - -(* - * Stable alternative to the instable TList.Sort() (uses QuickSort) implementation. - * A stable sorting algorithm preserves preordered items. E.g. if sorting by - * songs by title first and artist afterwards, the songs of each artist will - * be ordered by title. In contrast to this an unstable algorithm (like QuickSort) - * may destroy an existing order, so the songs of an artist will not be ordered - * by title anymore after sorting by artist in the previous example. - * If you do not need a stable algorithm, use TList.Sort() instead. - *) -procedure MergeSort(List: TList; CompareFunc: TListSortCompare); -var - TempList: TList; -begin - TempList := TList.Create(); - TempList.Count := List.Count; - if (List.Count >= 2) then - _MergeSort(List, TempList, List, 0, List.Count, CompareFunc); - TempList.Free; -end; - - -type - // stores the unaligned pointer of data allocated by GetAlignedMem() - PMemAlignHeader = ^TMemAlignHeader; - TMemAlignHeader = Pointer; - -(** - * Use this function to assure that allocated memory is aligned on a specific - * byte boundary. - * Alignment must be a power of 2. - * - * Important: Memory allocated with GetAlignedMem() MUST be freed with - * FreeAlignedMem(), FreeMem() will cause a segmentation fault. - * - * Hint: If you do not need dynamic memory, consider to allocate memory - * statically and use the {$ALIGN x} compiler directive. Note that delphi - * supports an alignment "x" of up to 8 bytes only whereas FPC supports - * alignments on 16 and 32 byte boundaries too. - *) -{$WARNINGS OFF} -function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer; -var - OrigPtr: Pointer; -const - MIN_ALIGNMENT = 16; -begin - // Delphi and FPC (tested with 2.2.0) align memory blocks allocated with - // GetMem() at least on 8 byte boundaries. Delphi uses a minimal alignment - // of either 8 or 16 bytes depending on the size of the requested block - // (see System.GetMinimumBlockAlignment). As we do not want to change the - // boundary for the worse, we align at least on MIN_ALIGN. - if (Alignment < MIN_ALIGNMENT) then - Alignment := MIN_ALIGNMENT; - - // allocate unaligned memory - GetMem(OrigPtr, SizeOf(TMemAlignHeader) + Size + Alignment); - if (OrigPtr = nil) then - begin - Result := nil; - Exit; - end; - - // reserve space for the header - Result := Pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader)); - // align memory - Result := Pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment); - - // set header with info on old pointer for FreeMem - PMemAlignHeader(PtrUInt(Result) - SizeOf(TMemAlignHeader))^ := OrigPtr; -end; -{$WARNINGS ON} - -{$WARNINGS OFF} -procedure FreeAlignedMem(P: Pointer); -begin - if (P <> nil) then - FreeMem(PMemAlignHeader(PtrUInt(P) - SizeOf(TMemAlignHeader))^); -end; -{$WARNINGS ON} - - -initialization - InitConsoleOutput(); - -finalization - FinalizeConsoleOutput(); - -end. diff --git a/src/Classes/UConfig.pas b/src/Classes/UConfig.pas deleted file mode 100644 index b77c2a5a..00000000 --- a/src/Classes/UConfig.pas +++ /dev/null @@ -1,199 +0,0 @@ -unit UConfig; - -// ------------------------------------------------------------------- -// Note on version comparison (for developers only): -// ------------------------------------------------------------------- -// Delphi (in contrast to FPC) DOESN'T support MACROS. So we -// can't define a macro like VERSION_MAJOR(version) to extract -// parts of the version-number or to create version numbers for -// comparison purposes as with a MAKE_VERSION(maj, min, rev) macro. -// So we have to define constants for every part of the version here. -// -// In addition FPC (in contrast to delphi) DOES NOT support floating- -// point numbers in $IF compiler-directives (e.g. {$IF VERSION > 1.23}) -// It also DOESN'T support arithmetic operations so we aren't able to -// compare versions this way (brackets aren't supported too): -// {$IF VERSION > ((VER_MAJ*2)+(VER_MIN*23)+(VER_REL*1))} -// -// Hence we have to use fixed numbers in the directives. At least -// Pascal allows leading 0s so 0005 equals 5 (octals are -// preceded by & and not by 0 in FPC). -// We also fix the count of digits for each part of the version number -// to 3 (aaaiiirrr with aaa=major, iii=minor, rrr=release version) -// -// A check for a library with at least a version of 2.5.11 would look -// like this: -// {$IF LIB_VERSION >= 002005011} -// -// If you just need to check the major version do this: -// {$IF LIB_VERSION_MAJOR >= 23} -// -// IMPORTANT: -// Because this unit must be included in a uses-section it is -// not possible to use the version-numbers in this uses-clause. -// Example: -// interface -// uses -// versions, // include this file -// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // Error: USE_UNIT_XYZ not defined -// const -// {$IF USE_UNIT_XYZ}test = 2;{$IFEND} // OK -// uses -// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // OK -// -// Even if this file was an include-file no constants could be declared -// before the interface's uses clause. -// In FPC macros {$DEFINE VER:= 3} could be used to declare the version-numbers -// but this is incompatible to Delphi. In addition macros do not allow expand -// arithmetic expressions. Although you can define -// {$DEFINE FPC_VER:= FPC_VERSION*1000000+FPC_RELEASE*1000+FPC_PATCH} -// the following check would fail: -// {$IF FPC_VERSION_INT >= 002002000} -// would fail because FPC_VERSION_INT is interpreted as a string. -// -// PLEASE consider this if you use version numbers in $IF compiler- -// directives. Otherwise you might break portability. -// ------------------------------------------------------------------- - -interface - -{$IFDEF FPC} - {$MODE Delphi} - {$MACRO ON} // for evaluation of FPC_VERSION/RELEASE/PATCH -{$ENDIF} - -{$I switches.inc} - -uses - Sysutils; - -const - // IMPORTANT: - // If IncludeConstants is defined, the const-sections - // of the config-file will be included too. - // This switch is necessary because it is not possible to - // include the const-sections in the switches.inc. - // switches.inc is always included before the first uses- - // section but at that place no const-section is allowed. - // So we have to include the config-file in switches.inc - // with IncludeConstants undefined and in UConfig.pas with - // IncludeConstants defined (see the note above). - {$DEFINE IncludeConstants} - - // include config-file (defines + constants) - {$IF Defined(MSWindows)} - {$I ../config-win.inc} - {$ELSEIF Defined(Linux)} - {$I ../config-linux.inc} - {$ELSEIF Defined(Darwin)} - {$I ../config-darwin.inc} - {$ELSE} - {$MESSAGE Fatal 'Unknown OS'} - {$IFEND} - -{* Libraries *} - - VERSION_MAJOR = 1000000; - VERSION_MINOR = 1000; - VERSION_RELEASE = 1; - - (* - * Current version of UltraStar Deluxe - *) - USDX_VERSION_MAJOR = 1; - USDX_VERSION_MINOR = 1; - USDX_VERSION_RELEASE = 0; - USDX_VERSION_STATE = 'Alpha'; - USDX_STRING = 'UltraStar Deluxe'; - - (* - * FPC version numbers are already defined as built-in macros: - * FPC_VERSION (MAJOR) - * FPC_RELEASE (MINOR) - * FPC_PATCH (RELEASE) - * Since FPC_VERSION is already defined, we will use FPC_VERSION_INT as - * composed version number. - *) - {$IFNDEF FPC} - // Delphi 7 evaluates every $IF-directive even if it is disabled by a surrounding - // $IF or $IFDEF so the follwing will give you an error in delphi: - // {$IFDEF FPC}{$IF (FPC_VERSION > 2)}...{$IFEND}{$ENDIF} - // The reason for this error is that FPC_VERSION is not a valid constant. - // To avoid this error, we define dummys here. - FPC_VERSION = 0; - FPC_RELEASE = 0; - FPC_PATCH = 0; - {$ENDIF} - - FPC_VERSION_INT = (FPC_VERSION * VERSION_MAJOR) + - (FPC_RELEASE * VERSION_MINOR) + - (FPC_PATCH * VERSION_RELEASE); - - - {$IFDEF HaveFFmpeg} - - LIBAVCODEC_VERSION = (LIBAVCODEC_VERSION_MAJOR * VERSION_MAJOR) + - (LIBAVCODEC_VERSION_MINOR * VERSION_MINOR) + - (LIBAVCODEC_VERSION_RELEASE * VERSION_RELEASE); - - LIBAVFORMAT_VERSION = (LIBAVFORMAT_VERSION_MAJOR * VERSION_MAJOR) + - (LIBAVFORMAT_VERSION_MINOR * VERSION_MINOR) + - (LIBAVFORMAT_VERSION_RELEASE * VERSION_RELEASE); - - LIBAVUTIL_VERSION = (LIBAVUTIL_VERSION_MAJOR * VERSION_MAJOR) + - (LIBAVUTIL_VERSION_MINOR * VERSION_MINOR) + - (LIBAVUTIL_VERSION_RELEASE * VERSION_RELEASE); - - {$IFDEF HaveSWScale} - LIBSWSCALE_VERSION = (LIBSWSCALE_VERSION_MAJOR * VERSION_MAJOR) + - (LIBSWSCALE_VERSION_MINOR * VERSION_MINOR) + - (LIBSWSCALE_VERSION_RELEASE * VERSION_RELEASE); - {$ENDIF} - - {$ENDIF} - - {$IFDEF HaveProjectM} - PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) + - (PROJECTM_VERSION_MINOR * VERSION_MINOR) + - (PROJECTM_VERSION_RELEASE * VERSION_RELEASE); - {$ENDIF} - - {$IFDEF HavePortaudio} - PORTAUDIO_VERSION = (PORTAUDIO_VERSION_MAJOR * VERSION_MAJOR) + - (PORTAUDIO_VERSION_MINOR * VERSION_MINOR) + - (PORTAUDIO_VERSION_RELEASE * VERSION_RELEASE); - {$ENDIF} - - {$IFDEF HaveLibsamplerate} - LIBSAMPLERATE_VERSION = (LIBSAMPLERATE_VERSION_MAJOR * VERSION_MAJOR) + - (LIBSAMPLERATE_VERSION_MINOR * VERSION_MINOR) + - (LIBSAMPLERATE_VERSION_RELEASE * VERSION_RELEASE); - {$ENDIF} - -function USDXVersionStr(): string; -function USDXShortVersionStr(): string; - -implementation - -uses - StrUtils, Math; - -function USDXShortVersionStr(): string; -begin - Result := - USDX_STRING + - IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE); -end; - -function USDXVersionStr(): string; -begin - Result := - USDX_STRING + ' V ' + - IntToStr(USDX_VERSION_MAJOR) + '.' + - IntToStr(USDX_VERSION_MINOR) + '.' + - IntToStr(USDX_VERSION_RELEASE) + - IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE) + - ' Build'; -end; - -end. diff --git a/src/Classes/UCore.pas b/src/Classes/UCore.pas deleted file mode 100644 index fe23a68e..00000000 --- a/src/Classes/UCore.pas +++ /dev/null @@ -1,525 +0,0 @@ -unit UCore; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - uPluginDefs, - uCoreModule, - UHooks, - UServices, - UModules; - -{********************* - TCore - Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process - Also it does some Error Handling, and maybe sometime multithreaded Loading ;) -*********************} - -type - TModuleListItem = record - Module: TCoreModule; //Instance of the Modules Class - Info: TModuleInfo; //ModuleInfo returned by Modules Modulinfo Proc - NeedsDeInit: Boolean; //True if Module was succesful inited - end; - - TCore = class - private - //Some Hook Handles. See Plugin SDKs Hooks.txt for Infos - hLoadingFinished: THandle; - hMainLoop: THandle; - hTranslate: THandle; - hLoadTextures: THandle; - hExitQuery: THandle; - hExit: THandle; - hDebug: THandle; - hError: THandle; - sReportError: THandle; - sReportDebug: THandle; - sShowMessage: THandle; - sRetranslate: THandle; - sReloadTextures: THandle; - sGetModuleInfo: THandle; - sGetApplicationHandle: THandle; - - Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; - - //Cur + Last Executed Setting and Getting ;) - iCurExecuted: Integer; - iLastExecuted: Integer; - - procedure SetCurExecuted(Value: Integer); - - //Function Get all Modules and Creates them - function GetModules: Boolean; - - //Loads Core and all Modules - function Load: Boolean; - - //Inits Core and all Modules - function Init: Boolean; - - //DeInits Core and all Modules - function DeInit: Boolean; - - //Load the Core - function LoadCore: Boolean; - - //Init the Core - function InitCore: Boolean; - - //DeInit the Core - function DeInitCore: Boolean; - - //Called one Time per Frame - function MainLoop: Boolean; - - public - Hooks: THookManager; //Teh Hook Manager ;) - Services: TServiceManager;//The Service Manager - - Name: String; //Name of this Application - Version: LongWord; //Version of this ". For Info Look PluginDefs Functions - - LastErrorReporter:String; //Who Reported the Last Error String - LastErrorString: String; //Last Error String reported - - property CurExecuted: Integer read iCurExecuted write SetCurExecuted; //ID of Plugin or Module curently Executed - property LastExecuted: Integer read iLastExecuted; - - //--------------- - //Main Methods to control the Core: - //--------------- - constructor Create(const cName: String; const cVersion: LongWord); - - //Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown - procedure Run; - - //Method for other Classes to get Pointer to a specific Module - function GetModulebyName(const Name: String): PCoreModule; - - //-------------- - // Hook and Service Procs: - //-------------- - function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) - function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) - function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) - function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook - function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook - function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam - function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle - end; - -var - Core: TCore; - -implementation - -uses - {$IFDEF win32} - Windows, - {$ENDIF} - SysUtils; - -//------------- -// Create - Creates Class + Hook and Service Manager -//------------- -constructor TCore.Create(const cName: String; const cVersion: LongWord); -begin - inherited Create; - - Name := cName; - Version := cVersion; - iLastExecuted := 0; - iCurExecuted := 0; - - LastErrorReporter := ''; - LastErrorString := ''; - - Hooks := THookManager.Create(50); - Services := TServiceManager.Create; -end; - -//------------- -//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown -//------------- -procedure TCore.Run; -var - Success: Boolean; - - procedure HandleError(const ErrorMsg: string); - begin - if (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg + ': ' + LastErrorString)) - else - Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg)); - - //DeInit - DeInit; - end; - -begin - //Get Modules - try - Success := GetModules(); - except - Success := False; - end; - - if (not Success) then - begin - HandleError('Error Getting Modules'); - Exit; - end; - - //Loading - try - Success := Load(); - except - Success := False; - end; - - if (not Success) then - begin - HandleError('Error loading Modules'); - Exit; - end; - - //Init - try - Success := Init(); - except - Success := False; - end; - - if (not Success) then - begin - HandleError('Error initing Modules'); - Exit; - end; - - //Call Translate Hook - if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then - begin - HandleError('Error translating'); - Exit; - end; - - //Calls LoadTextures Hook - if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then - begin - HandleError('Error loading textures'); - Exit; - end; - - //Calls Loading Finished Hook - if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then - begin - HandleError('Error calling LoadingFinished Hook'); - Exit; - end; - - //Start MainLoop - while Success do - begin - Success := MainLoop(); - // to-do : Call Display Draw here - end; -end; - -//------------- -//Called one Time per Frame -//------------- -function TCore.MainLoop: Boolean; -begin - Result := False; -end; - -//------------- -//Function Get all Modules and Creates them -//------------- -function TCore.GetModules: Boolean; -var - i: Integer; -begin - Result := False; - for i := 0 to high(Modules) do - begin - try - Modules[i].NeedsDeInit := False; - Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create; - Modules[i].Module.Info(@Modules[i].Info); - except - ReportError(Integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); - Exit; - end; - end; - Result := True; -end; - -//------------- -//Loads Core and all Modules -//------------- -function TCore.Load: Boolean; -var - i: Integer; -begin - Result := LoadCore; - - for i := 0 to High(CORE_MODULES_TO_LOAD) do - begin - try - Result := Modules[i].Module.Load; - except - Result := False; - end; - - if (not Result) then - begin - ReportError(Integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); - break; - end; - end; -end; - -//------------- -//Inits Core and all Modules -//------------- -function TCore.Init: Boolean; -var - i: Integer; -begin - Result := InitCore; - - for i := 0 to High(CORE_MODULES_TO_LOAD) do - begin - try - Result := Modules[i].Module.Init; - except - Result := False; - end; - - if (not Result) then - begin - ReportError(Integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); - break; - end; - - Modules[i].NeedsDeInit := Result; - end; -end; - -//------------- -//DeInits Core and all Modules -//------------- -function TCore.DeInit: boolean; -var - i: integer; -begin - - for i := High(CORE_MODULES_TO_LOAD) downto 0 do - begin - try - if (Modules[i].NeedsDeInit) then - Modules[i].Module.DeInit; - except - end; - end; - - DeInitCore; - - Result := true; -end; - -//------------- -//Load the Core -//------------- -function TCore.LoadCore: Boolean; -begin - hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished'); - hMainLoop := Hooks.AddEvent('Core/MainLoop'); - hTranslate := Hooks.AddEvent('Core/Translate'); - hLoadTextures := Hooks.AddEvent('Core/LoadTextures'); - hExitQuery := Hooks.AddEvent('Core/ExitQuery'); - hExit := Hooks.AddEvent('Core/Exit'); - hDebug := Hooks.AddEvent('Core/NewDebugInfo'); - hError := Hooks.AddEvent('Core/NewError'); - - sReportError := Services.AddService('Core/ReportError', nil, Self.ReportError); - sReportDebug := Services.AddService('Core/ReportDebug', nil, Self.ReportDebug); - sShowMessage := Services.AddService('Core/ShowMessage', nil, Self.ShowMessage); - sRetranslate := Services.AddService('Core/Retranslate', nil, Self.Retranslate); - sReloadTextures := Services.AddService('Core/ReloadTextures', nil, Self.ReloadTextures); - sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo); - sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle); - - //A little Test - Hooks.AddSubscriber('Core/NewError', HookTest); - - result := true; -end; - -//------------- -//Init the Core -//------------- -function TCore.InitCore: Boolean; -begin - //Don not init something atm. - result := true; -end; - -//------------- -//DeInit the Core -//------------- -function TCore.DeInitCore: Boolean; -begin - // TODO: write TService-/HookManager.Free and call it here - Result := true; -end; - -//------------- -//Method for other classes to get pointer to a specific module -//------------- -function TCore.GetModuleByName(const Name: String): PCoreModule; -var i: Integer; -begin - Result := nil; - for i := 0 to High(Modules) do - begin - if (Modules[i].Info.Name = Name) then - begin - Result := @Modules[i].Module; - Break; - end; - end; -end; - -//------------- -// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) -//------------- -function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer; -{$IFDEF MSWINDOWS} -var Params: Cardinal; -{$ENDIF} -begin - Result := -1; - - {$IFDEF MSWINDOWS} - if (lParam <> nil) then - begin - Params := MB_OK; - case wParam of - CORE_SM_ERROR: Params := Params or MB_ICONERROR; - CORE_SM_WARNING: Params := Params or MB_ICONWARNING; - CORE_SM_INFO: Params := Params or MB_ICONINFORMATION; - end; - - //Show: - Result := Messagebox(0, lParam, PChar(Name), Params); - end; - {$ENDIF} - - // TODO: write ShowMessage for other OSes -end; - -//------------- -// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) -//------------- -function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer; -begin - //Update LastErrorReporter and LastErrorString - LastErrorReporter := String(PChar(lParam)); - LastErrorString := String(PChar(Pointer(wParam))); - - Hooks.CallEventChain(hError, wParam, lParam); - - // FIXME: return a correct result - Result := 0; -end; - -//------------- -// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) -//------------- -function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer; -begin - Hooks.CallEventChain(hDebug, wParam, lParam); - - // FIXME: return a correct result - Result := 0; -end; - -//------------- -// Calls Translate hook -//------------- -function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer; -begin - Hooks.CallEventChain(hTranslate, 1, nil); - - // FIXME: return a correct result - Result := 0; -end; - -//------------- -// Calls LoadTextures hook -//------------- -function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer; -begin - Hooks.CallEventChain(hLoadTextures, 1, nil); - - // FIXME: return a correct result - Result := 0; -end; - -//------------- -// If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam -//------------- -function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; -var - I: integer; -begin - if (Pointer(lParam) = nil) then - begin - Result := Length(Modules); - end - else - begin - try - for I := 0 to High(Modules) do - begin - AModuleInfo(Pointer(lParam))[I].Name := Modules[I].Info.Name; - AModuleInfo(Pointer(lParam))[I].Version := Modules[I].Info.Version; - AModuleInfo(Pointer(lParam))[I].Description := Modules[I].Info.Description; - end; - Result := Length(Modules); - except - Result := -1; - end; - end; -end; - -//------------- -// Returns Application Handle -//------------- -function TCore.GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; -begin - Result := hInstance; -end; - -//------------- -// Called when setting CurExecuted -//------------- -procedure TCore.SetCurExecuted(Value: Integer); -begin - //Set Last Executed - iLastExecuted := iCurExecuted; - - //Set Cur Executed - iCurExecuted := Value; -end; - -end. diff --git a/src/Classes/UCoreModule.pas b/src/Classes/UCoreModule.pas deleted file mode 100644 index 031fb04e..00000000 --- a/src/Classes/UCoreModule.pas +++ /dev/null @@ -1,128 +0,0 @@ -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 - Destructor Destroy; override; - end; - cCoreModule = class of TCoreModule; - -implementation - -//------------- -// Just the Constructor -//------------- -Constructor TCoreModule.Create; -begin - //Dummy maaaan ;) - inherited; -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 -//------------- -Destructor TCoreModule.Destroy; -begin - //Dummy ftw!! - inherited; -end; - -end. diff --git a/src/Classes/UCovers.pas b/src/Classes/UCovers.pas deleted file mode 100644 index 7bb57b4a..00000000 --- a/src/Classes/UCovers.pas +++ /dev/null @@ -1,430 +0,0 @@ -unit UCovers; - -{ - TODO: - - adjust database to new song-loading (e.g. use SongIDs) - - support for deletion of outdated covers - - support for update of changed covers - - use paths relative to the song for removable disks support - (a drive might have a different drive-name the next time it is connected, - so "H:/songs/..." will not match "I:/songs/...") -} - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - sdl, - SQLite3, - SQLiteTable3, - SysUtils, - Classes, - UImage, - UTexture; - -type - ECoverDBException = class(Exception) - end; - - TCover = class - private - ID: int64; - Filename: WideString; - public - constructor Create(ID: int64; Filename: WideString); - function GetPreviewTexture(): TTexture; - function GetTexture(): TTexture; - end; - - TThumbnailInfo = record - CoverWidth: integer; // Original width of cover - CoverHeight: integer; // Original height of cover - PixelFormat: TImagePixelFmt; // Pixel-format of thumbnail - end; - - TCoverDatabase = class - private - DB: TSQLiteDatabase; - procedure InitCoverDatabase(); - function CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface; - function LoadCover(CoverID: int64): TTexture; - procedure DeleteCover(CoverID: int64); - function FindCoverIntern(const Filename: WideString): int64; - procedure Open(); - function GetVersion(): integer; - procedure SetVersion(Version: integer); - public - constructor Create(); - destructor Destroy; override; - function AddCover(const Filename: WideString): TCover; - function FindCover(const Filename: WideString): TCover; - function CoverExists(const Filename: WideString): boolean; - function GetMaxCoverSize(): integer; - procedure SetMaxCoverSize(Size: integer); - end; - - TBlobWrapper = class(TCustomMemoryStream) - function Write(const Buffer; Count: Integer): Integer; override; - end; - -var - Covers: TCoverDatabase; - -implementation - -uses - UMain, - ULog, - UPlatform, - UIni, - Math, - DateUtils; - -const - COVERDB_FILENAME = 'cover.db'; - COVERDB_VERSION = 01; // 0.1 - COVER_TBL = 'Cover'; - COVER_THUMBNAIL_TBL = 'CoverThumbnail'; - COVER_IDX = 'Cover_Filename_IDX'; - -// Note: DateUtils.DateTimeToUnix() will throw an exception in FPC -function DateTimeToUnixTime(time: TDateTime): int64; -begin - Result := Round((time - UnixDateDelta) * SecsPerDay); -end; - -// Note: DateUtils.UnixToDateTime() will throw an exception in FPC -function UnixTimeToDateTime(timestamp: int64): TDateTime; -begin - Result := timestamp / SecsPerDay + UnixDateDelta; -end; - - -{ TBlobWrapper } - -function TBlobWrapper.Write(const Buffer; Count: Integer): Integer; -begin - SetPointer(Pointer(Buffer), Count); - Result := Count; -end; - - -{ TCover } - -constructor TCover.Create(ID: int64; Filename: WideString); -begin - Self.ID := ID; - Self.Filename := Filename; -end; - -function TCover.GetPreviewTexture(): TTexture; -begin - Result := Covers.LoadCover(ID); -end; - -function TCover.GetTexture(): TTexture; -begin - Result := Texture.LoadTexture(Filename); -end; - - -{ TCoverDatabase } - -constructor TCoverDatabase.Create(); -begin - inherited; - - Open(); - InitCoverDatabase(); -end; - -destructor TCoverDatabase.Destroy; -begin - DB.Free; - inherited; -end; - -function TCoverDatabase.GetVersion(): integer; -begin - Result := DB.GetTableValue('PRAGMA user_version'); -end; - -procedure TCoverDatabase.SetVersion(Version: integer); -begin - DB.ExecSQL(Format('PRAGMA user_version = %d', [Version])); -end; - -function TCoverDatabase.GetMaxCoverSize(): integer; -begin - Result := ITextureSizeVals[Ini.TextureSize]; -end; - -procedure TCoverDatabase.SetMaxCoverSize(Size: integer); -var - I: integer; -begin - // search for first valid cover-size > Size - for I := 0 to Length(ITextureSizeVals)-1 do - begin - if (Size <= ITextureSizeVals[I]) then - begin - Ini.TextureSize := I; - Exit; - end; - end; - - // fall-back to highest size - Ini.TextureSize := High(ITextureSizeVals); -end; - -procedure TCoverDatabase.Open(); -var - Version: integer; - Filename: string; -begin - Filename := UTF8Encode(Platform.GetGameUserPath() + COVERDB_FILENAME); - - DB := TSQLiteDatabase.Create(Filename); - Version := GetVersion(); - - // check version, if version is too old/new, delete database file - if ((Version <> 0) and (Version <> COVERDB_VERSION)) then - begin - Log.LogInfo('Outdated cover-database file found', 'TCoverDatabase.Open'); - // close and delete outdated file - DB.Free; - if (not DeleteFile(Filename)) then - raise ECoverDBException.Create('Could not delete ' + Filename); - // reopen - DB := TSQLiteDatabase.Create(Filename); - Version := 0; - end; - - // set version number after creation - if (Version = 0) then - SetVersion(COVERDB_VERSION); - - // speed-up disk-writing. The default FULL-synchronous mode is too slow. - // With this option disk-writing is approx. 4 times faster but the database - // might be corrupted if the OS crashes, although this is very unlikely. - DB.ExecSQL('PRAGMA synchronous = OFF;'); - - // the next line rather gives a slow-down instead of a speed-up, so we do not use it - //DB.ExecSQL('PRAGMA temp_store = MEMORY;'); -end; - -procedure TCoverDatabase.InitCoverDatabase(); -begin - DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_TBL+'] (' + - '[ID] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, ' + - '[Filename] TEXT UNIQUE NOT NULL, ' + - '[Date] INTEGER NOT NULL, ' + - '[Width] INTEGER NOT NULL, ' + - '[Height] INTEGER NOT NULL ' + - ')'); - - DB.ExecSQL('CREATE INDEX IF NOT EXISTS ['+COVER_IDX+'] ON ['+COVER_TBL+'](' + - '[Filename] ASC' + - ')'); - - DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_THUMBNAIL_TBL+'] (' + - '[ID] INTEGER NOT NULL PRIMARY KEY, ' + - '[Format] INTEGER NOT NULL, ' + - '[Width] INTEGER NOT NULL, ' + - '[Height] INTEGER NOT NULL, ' + - '[Data] BLOB NULL' + - ')'); -end; - -function TCoverDatabase.FindCoverIntern(const Filename: WideString): int64; -begin - Result := DB.GetTableValue('SELECT [ID] FROM ['+COVER_TBL+'] ' + - 'WHERE [Filename] = ?', - [UTF8Encode(Filename)]); -end; - -function TCoverDatabase.FindCover(const Filename: WideString): TCover; -var - CoverID: int64; -begin - Result := nil; - try - CoverID := FindCoverIntern(Filename); - if (CoverID > 0) then - Result := TCover.Create(CoverID, Filename); - except on E: Exception do - Log.LogError(E.Message, 'TCoverDatabase.FindCover'); - end; -end; - -function TCoverDatabase.CoverExists(const Filename: WideString): boolean; -begin - Result := false; - try - Result := (FindCoverIntern(Filename) > 0); - except on E: Exception do - Log.LogError(E.Message, 'TCoverDatabase.CoverExists'); - end; -end; - -function TCoverDatabase.AddCover(const Filename: WideString): TCover; -var - CoverID: int64; - Thumbnail: PSDL_Surface; - CoverData: TBlobWrapper; - FileDate: TDateTime; - Info: TThumbnailInfo; -begin - Result := nil; - - //if (not FileExists(Filename)) then - // Exit; - - // TODO: replace '\' with '/' in filename - FileDate := Now(); //FileDateToDateTime(FileAge(Filename)); - - Thumbnail := CreateThumbnail(Filename, Info); - if (Thumbnail = nil) then - Exit; - - CoverData := TBlobWrapper.Create; - CoverData.Write(Thumbnail^.pixels, Thumbnail^.h * Thumbnail^.pitch); - - try - // Note: use a transaction to speed-up file-writing. - // Without data written by the first INSERT might be moved at the second INSERT. - DB.BeginTransaction(); - - // add general cover info - DB.ExecSQL('INSERT INTO ['+COVER_TBL+'] ' + - '([Filename], [Date], [Width], [Height]) VALUES' + - '(?, ?, ?, ?)', - [UTF8Encode(Filename), DateTimeToUnixTime(FileDate), - Info.CoverWidth, Info.CoverHeight]); - - // get auto-generated cover ID - CoverID := DB.GetLastInsertRowID(); - - // add thumbnail info - DB.ExecSQL('INSERT INTO ['+COVER_THUMBNAIL_TBL+'] ' + - '([ID], [Format], [Width], [Height], [Data]) VALUES' + - '(?, ?, ?, ?, ?)', - [CoverID, Ord(Info.PixelFormat), - Thumbnail^.w, Thumbnail^.h, CoverData]); - - Result := TCover.Create(CoverID, Filename); - except on E: Exception do - Log.LogError(E.Message, 'TCoverDatabase.AddCover'); - end; - - DB.Commit(); - CoverData.Free; - SDL_FreeSurface(Thumbnail); -end; - -function TCoverDatabase.LoadCover(CoverID: int64): TTexture; -var - Width, Height: integer; - PixelFmt: TImagePixelFmt; - Data: PChar; - DataSize: integer; - Filename: WideString; - Table: TSQLiteUniTable; -begin - Table := nil; - - try - Table := DB.GetUniTable(Format( - 'SELECT C.[Filename], T.[Format], T.[Width], T.[Height], T.[Data] ' + - 'FROM ['+COVER_TBL+'] C ' + - 'INNER JOIN ['+COVER_THUMBNAIL_TBL+'] T ' + - 'USING(ID) ' + - 'WHERE [ID] = %d', [CoverID])); - - Filename := UTF8Decode(Table.FieldAsString(0)); - PixelFmt := TImagePixelFmt(Table.FieldAsInteger(1)); - Width := Table.FieldAsInteger(2); - Height := Table.FieldAsInteger(3); - - Data := Table.FieldAsBlobPtr(4, DataSize); - if (Data <> nil) and - (PixelFmt = ipfRGB) then - begin - Result := Texture.CreateTexture(Data, Filename, Width, Height, 24) - end - else - begin - FillChar(Result, SizeOf(TTexture), 0); - end; - except on E: Exception do - Log.LogError(E.Message, 'TCoverDatabase.LoadCover'); - end; - - Table.Free; -end; - -procedure TCoverDatabase.DeleteCover(CoverID: int64); -begin - DB.ExecSQL(Format('DELETE FROM ['+COVER_TBL+'] WHERE [ID] = %d', [CoverID])); - DB.ExecSQL(Format('DELETE FROM ['+COVER_THUMBNAIL_TBL+'] WHERE [ID] = %d', [CoverID])); -end; - -(** - * Returns a pointer to an array of bytes containing the texture data in the - * requested size - *) -function TCoverDatabase.CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface; -var - TargetAspect, SourceAspect: double; - //TargetWidth, TargetHeight: integer; - Thumbnail: PSDL_Surface; - MaxSize: integer; -begin - Result := nil; - - MaxSize := GetMaxCoverSize(); - - Thumbnail := LoadImage(Filename); - if (not assigned(Thumbnail)) then - begin - Log.LogError('Could not load cover: "'+ Filename +'"', 'TCoverDatabase.AddCover'); - Exit; - end; - - // Convert pixel format as needed - AdjustPixelFormat(Thumbnail, TEXTURE_TYPE_PLAIN); - - Info.CoverWidth := Thumbnail^.w; - Info.CoverHeight := Thumbnail^.h; - Info.PixelFormat := ipfRGB; - - (* TODO: keep aspect ratio - TargetAspect := Width / Height; - SourceAspect := TexSurface.w / TexSurface.h; - - // Scale texture to covers dimensions (keep aspect) - if (SourceAspect >= TargetAspect) then - begin - TargetWidth := Width; - TargetHeight := Trunc(Width / SourceAspect); - end - else - begin - TargetHeight := Height; - TargetWidth := Trunc(Height * SourceAspect); - end; - *) - - // TODO: do not scale if image is smaller - ScaleImage(Thumbnail, MaxSize, MaxSize); - - Result := Thumbnail; -end; - -end. - diff --git a/src/Classes/UDLLManager.pas b/src/Classes/UDLLManager.pas deleted file mode 100644 index 3d32a72a..00000000 --- a/src/Classes/UDLLManager.pas +++ /dev/null @@ -1,253 +0,0 @@ -unit UDLLManager; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses ModiSDK, - UFiles; - -type - TDLLMan = class - private - hLib: THandle; - P_Init: fModi_Init; - P_Draw: fModi_Draw; - P_Finish: fModi_Finish; - P_RData: pModi_RData; - public - Plugins: array of TPluginInfo; - PluginPaths: array of String; - Selected: ^TPluginInfo; - - constructor Create; - - procedure GetPluginList; - procedure ClearPluginInfo(No: Cardinal); - function LoadPluginInfo(Filename: String; No: Cardinal): boolean; - - function LoadPlugin(No: Cardinal): boolean; - procedure UnLoadPlugin; - - function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; - function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; - function PluginFinish (var Playerinfo: TPlayerinfo): byte; - procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); - end; - -var - DLLMan: TDLLMan; - -const - DLLPath = 'Plugins'; - - {$IFDEF MSWINDOWS} - DLLExt = '.dll'; - {$ENDIF} - {$IFDEF LINUX} - DLLExt = '.so'; - {$ENDIF} - {$IFDEF DARWIN} - DLLExt = '.dylib'; - {$ENDIF} - -implementation - -uses {$IFDEF MSWINDOWS} - windows, - {$ELSE} - dynlibs, - {$ENDIF} - ULog, - SysUtils; - - -constructor TDLLMan.Create; -begin - inherited; - SetLength(Plugins, 0); - SetLength(PluginPaths, Length(Plugins)); - GetPluginList; -end; - -procedure TDLLMan.GetPluginList; -var - SR: TSearchRec; -begin - - if FindFirst(DLLPath +PathDelim+ '*' + DLLExt, faAnyFile , SR) = 0 then - begin - repeat - SetLength(Plugins, Length(Plugins)+1); - SetLength(PluginPaths, Length(Plugins)); - - if LoadPluginInfo(SR.Name, High(Plugins)) then //Loaded succesful - begin - PluginPaths[High(PluginPaths)] := SR.Name; - end - else //Error Loading - begin - SetLength(Plugins, Length(Plugins)-1); - SetLength(PluginPaths, Length(Plugins)); - end; - - until FindNext(SR) <> 0; - FindClose(SR); - end; -end; - -procedure TDLLMan.ClearPluginInfo(No: Cardinal); -begin - //Set to Party Modi Plugin - Plugins[No].Typ := 8; - - Plugins[No].Name := 'unknown'; - Plugins[No].NumPlayers := 0; - - Plugins[No].Creator := 'Nobody'; - Plugins[No].PluginDesc := 'NO_PLUGIN_DESC'; - - Plugins[No].LoadSong := True; - Plugins[No].ShowScore := True; - Plugins[No].ShowBars := False; - Plugins[No].ShowNotes := True; - Plugins[No].LoadVideo := True; - Plugins[No].LoadBack := True; - - Plugins[No].TeamModeOnly := False; - Plugins[No].GetSoundData := False; - Plugins[No].Dummy := False; - - - Plugins[No].BGShowFull := False; - Plugins[No].BGShowFull_O := True; - - Plugins[No].ShowRateBar:= False; - Plugins[No].ShowRateBar_O := True; - - Plugins[No].EnLineBonus := False; - Plugins[No].EnLineBonus_O := True; -end; - -function TDLLMan.LoadPluginInfo(Filename: String; No: Cardinal): boolean; -var - hLibg: THandle; - Info: pModi_PluginInfo; - I: Integer; -begin - Result := False; - //Clear Plugin Info - ClearPluginInfo(No); - - {//Workaround Plugins Loaded 2 Times - For I := low(PluginPaths) to high(PluginPaths) do - if (PluginPaths[I] = Filename) then - exit; } - - //Load Libary - hLibg := LoadLibrary(PChar(DLLPath +PathDelim+ Filename)); - //If Loaded - if (hLibg <> 0) then - begin - //Load Info Procedure - @Info := GetProcAddress (hLibg, PChar('PluginInfo')); - - //If Loaded - if (@Info <> nil) then - begin - //Load PluginInfo - Info (Plugins[No]); - Result := True; - end - else - Log.LogError('Could not Load Plugin "' + Filename + '": Info Procedure not Found'); - - FreeLibrary (hLibg); - end - else - Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded'); -end; - -function TDLLMan.LoadPlugin(No: Cardinal): boolean; -begin - Result := False; - //Load Libary - hLib := LoadLibrary(PChar(DLLPath +PathDelim+ PluginPaths[No])); - //If Loaded - if (hLib <> 0) then - begin - //Load Info Procedure - @P_Init := GetProcAddress (hLib, PChar('Init')); - @P_Draw := GetProcAddress (hLib, PChar('Draw')); - @P_Finish := GetProcAddress (hLib, PChar('Finish')); - - //If Loaded - if (@P_Init <> nil) And (@P_Draw <> nil) And (@P_Finish <> nil) then - begin - Selected := @Plugins[No]; - Result := True; - end - else - begin - Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Procedures not Found'); - - end; - end - else - Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Libary not Loaded'); -end; - -procedure TDLLMan.UnLoadPlugin; -begin -if (hLib <> 0) then - FreeLibrary (hLib); - -//Selected := nil; -@P_Init := nil; -@P_Draw := nil; -@P_Finish := nil; -@P_RData := nil; -end; - -function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; -var - Methods: TMethodRec; -begin - Methods.LoadTex := LoadTex; - Methods.Print := Print; - Methods.LoadSound := LoadSound; - Methods.PlaySound := PlaySound; - - if (@P_Init <> nil) then - Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods) - else - Result := False -end; - -function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; -begin -if (@P_Draw <> nil) then - Result := P_Draw (PlayerInfo, CurSentence) -else - Result := False -end; - -function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte; -begin -if (@P_Finish <> nil) then - Result := P_Finish (PlayerInfo) -else - Result := 0; -end; - -procedure TDLLMan.PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); -begin -if (@P_RData <> nil) then - P_RData (handle, buffer, len, user); -end; - -end. diff --git a/src/Classes/UDataBase.pas b/src/Classes/UDataBase.pas deleted file mode 100644 index cd315df3..00000000 --- a/src/Classes/UDataBase.pas +++ /dev/null @@ -1,533 +0,0 @@ -unit UDataBase; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses USongs, - USong, - Classes, - SQLiteTable3; - -//-------------------- -//DataBaseSystem - Class including all DB Methods -//-------------------- -type - TStatType = ( - stBestScores, // Best Scores - stBestSingers, // Best Singers - stMostSungSong, // Most sung Songs - stMostPopBand // Most popular Band - ); - - // abstract super-class for statistic results - TStatResult = class - public - Typ: TStatType; - end; - - TStatResultBestScores = class(TStatResult) - public - Singer: WideString; - Score: Word; - Difficulty: Byte; - SongArtist: WideString; - SongTitle: WideString; - end; - - TStatResultBestSingers = class(TStatResult) - public - Player: WideString; - AverageScore: Word; - end; - - TStatResultMostSungSong = class(TStatResult) - public - Artist: WideString; - Title: WideString; - TimesSung: Word; - end; - - TStatResultMostPopBand = class(TStatResult) - public - ArtistName: WideString; - TimesSungTot: Word; - end; - - - TDataBaseSystem = class - private - ScoreDB: TSQLiteDatabase; - fFilename: string; - - function GetVersion(): integer; - procedure SetVersion(Version: integer); - public - property Filename: string read fFilename; - - destructor Destroy; override; - - procedure Init(const Filename: string); - procedure ReadScore(Song: TSong); - procedure AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer); - procedure WriteScore(Song: TSong); - - function GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList; - procedure FreeStats(StatList: TList); - function GetTotalEntrys(Typ: TStatType): Cardinal; - function GetStatReset: TDateTime; - end; - -var - DataBase: TDataBaseSystem; - -implementation - -uses - ULog, - DateUtils, - StrUtils, - SysUtils; - -const - cDBVersion = 01; // 0.1 - cUS_Scores = 'us_scores'; - cUS_Songs = 'us_songs'; - cUS_Statistics_Info = 'us_statistics_info'; - -(** - * Opens Database and Create Tables if not Exist - *) -procedure TDataBaseSystem.Init(const Filename: string); -var - Version: integer; -begin - if Assigned(ScoreDB) then - Exit; - - Log.LogStatus('Initializing database: "'+Filename+'"', 'TDataBaseSystem.Init'); - - try - - // Open Database - ScoreDB := TSQLiteDatabase.Create(Filename); - fFilename := Filename; - - // Close and delete outdated file - Version := GetVersion(); - if ((Version <> 0) and (Version <> cDBVersion)) then - begin - Log.LogInfo('Outdated cover-database file found', 'TDataBaseSystem.Init'); - // Close and delete outdated file - ScoreDB.Free; - if (not DeleteFile(Filename)) then - raise Exception.Create('Could not delete ' + Filename); - // Reopen - ScoreDB := TSQLiteDatabase.Create(Filename); - Version := 0; - end; - - // Set version number after creation - if (Version = 0) then - SetVersion(cDBVersion); - - - // SQLite does not handle VARCHAR(n) or INT(n) as expected. - // Texts do not have a restricted length, no matter which type is used, - // so use the native TEXT type. INT(n) is always INTEGER. - // In addition, SQLiteTable3 will fail if other types than the native SQLite - // types are used (especially FieldAsInteger). Also take care to write the - // types in upper-case letters although SQLite does not care about this - - // SQLiteTable3 is very sensitive in this regard. - - ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Scores+'] (' + - '[SongID] INTEGER NOT NULL, ' + - '[Difficulty] INTEGER NOT NULL, ' + - '[Player] TEXT NOT NULL, ' + - '[Score] INTEGER NOT NULL' + - ');'); - - ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Songs+'] (' + - '[ID] INTEGER PRIMARY KEY, ' + - '[Artist] TEXT NOT NULL, ' + - '[Title] TEXT NOT NULL, ' + - '[TimesPlayed] INTEGER NOT NULL' + - ');'); - - if not ScoreDB.TableExists(cUS_Statistics_Info) then - begin - ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Statistics_Info+'] (' + - '[ResetTime] INTEGER' + - ');'); - // insert creation timestamp - ScoreDB.ExecSQL(Format('INSERT INTO ['+cUS_Statistics_Info+'] ' + - '([ResetTime]) VALUES(%d);', - [DateTimeToUnix(Now())])); - end; - - except - on E: Exception do - begin - Log.LogError(E.Message, 'TDataBaseSystem.Init'); - FreeAndNil(ScoreDB); - end; - end; - -end; - -(** - * Frees Database - *) -destructor TDataBaseSystem.Destroy; -begin - Log.LogInfo('TDataBaseSystem.Free', 'TDataBaseSystem.Destroy'); - ScoreDB.Free; - inherited; -end; - -(** - * Read Scores into SongArray - *) -procedure TDataBaseSystem.ReadScore(Song: TSong); -var - TableData: TSQLiteUniTable; - Difficulty: Integer; -begin - if not Assigned(ScoreDB) then - Exit; - - TableData := nil; - - try - // Search Song in DB - TableData := ScoreDB.GetUniTable( - 'SELECT [Difficulty], [Player], [Score] FROM ['+cUS_Scores+'] ' + - 'WHERE [SongID] = (' + - 'SELECT [ID] FROM ['+cUS_Songs+'] ' + - 'WHERE [Artist] = ? AND [Title] = ? ' + - 'LIMIT 1) ' + - 'ORDER BY [Score] DESC LIMIT 15', - [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); - - // Empty Old Scores - SetLength(Song.Score[0], 0); - SetLength(Song.Score[1], 0); - SetLength(Song.Score[2], 0); - - // Go through all Entrys - while (not TableData.EOF) do - begin - // Add one Entry to Array - Difficulty := TableData.FieldAsInteger(TableData.FieldIndex['Difficulty']); - if ((Difficulty >= 0) and (Difficulty <= 2)) and - (Length(Song.Score[Difficulty]) < 5) then - begin - SetLength(Song.Score[Difficulty], Length(Song.Score[Difficulty]) + 1); - - Song.Score[Difficulty, High(Song.Score[Difficulty])].Name := - UTF8Decode(TableData.FieldByName['Player']); - Song.Score[Difficulty, High(Song.Score[Difficulty])].Score := - TableData.FieldAsInteger(TableData.FieldIndex['Score']); - end; - - TableData.Next; - end; // while - - except - for Difficulty := 0 to 2 do - begin - SetLength(Song.Score[Difficulty], 1); - Song.Score[Difficulty, 1].Name := 'Error Reading ScoreDB'; - end; - end; - - TableData.Free; -end; - -(** - * Adds one new score to DB - *) -procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer); -var - ID: Integer; - TableData: TSQLiteTable; -begin - if not Assigned(ScoreDB) then - Exit; - - // Prevent 0 Scores from being added - if (Score <= 0) then - Exit; - - TableData := nil; - - try - - ID := ScoreDB.GetTableValue( - 'SELECT [ID] FROM ['+cUS_Songs+'] ' + - 'WHERE [Artist] = ? AND [Title] = ?', - [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); - if (ID = 0) then - begin - // Create song if it does not exist - ScoreDB.ExecSQL( - 'INSERT INTO ['+cUS_Songs+'] ' + - '([ID], [Artist], [Title], [TimesPlayed]) VALUES ' + - '(NULL, ?, ?, 0);', - [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); - // Get song-ID - ID := ScoreDB.GetLastInsertRowID(); - end; - // Create new entry - ScoreDB.ExecSQL( - 'INSERT INTO ['+cUS_Scores+'] ' + - '([SongID] ,[Difficulty], [Player], [Score]) VALUES ' + - '(?, ?, ?, ?);', - [ID, Level, UTF8Encode(Name), Score]); - - // Delete last position when there are more than 5 entrys. - // Fixes crash when there are > 5 ScoreEntrys - // Note: GetUniTable is not applicable here, as the results are used while - // table entries are deleted. - TableData := ScoreDB.GetTable( - 'SELECT [Player], [Score] FROM ['+cUS_Scores+'] ' + - 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' + - '[Difficulty] = ' + InttoStr(Level) +' ' + - 'ORDER BY [Score] DESC LIMIT -1 OFFSET 5'); - - while (not TableData.EOF) do - begin - // Note: Score is an int-value, so in contrast to Player, we do not bind - // this value. Otherwise we had to convert the string to an int to avoid - // an automatic cast of this field to the TEXT type (although it might even - // work that way). - ScoreDB.ExecSQL( - 'DELETE FROM ['+cUS_Scores+'] ' + - 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' + - '[Difficulty] = ' + InttoStr(Level) +' AND ' + - '[Player] = ? AND ' + - '[Score] = ' + TableData.FieldByName['Score'], - [TableData.FieldByName['Player']]); - - TableData.Next; - end; - - except on E: Exception do - Log.LogError(E.Message, 'TDataBaseSystem.AddScore'); - end; - - TableData.Free; -end; - -(** - * Not needed with new System. - * Used for increment played count - *) -procedure TDataBaseSystem.WriteScore(Song: TSong); -begin - if not Assigned(ScoreDB) then - Exit; - - try - // Increase TimesPlayed - ScoreDB.ExecSQL( - 'UPDATE ['+cUS_Songs+'] ' + - 'SET [TimesPlayed] = [TimesPlayed] + 1 ' + - 'WHERE [Title] = ? AND [Artist] = ?;', - [UTF8Encode(Song.Title), UTF8Encode(Song.Artist)]); - except on E: Exception do - Log.LogError(E.Message, 'TDataBaseSystem.WriteScore'); - end; -end; - -(** - * Writes some stats to array. - * Returns nil if the database is not ready or a list with zero or more statistic - * entries. - * Free the result-list with FreeStats() after usage to avoid memory leaks. - *) -function TDataBaseSystem.GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList; -var - Query: String; - TableData: TSQLiteUniTable; - Stat: TStatResult; -begin - Result := nil; - - if not Assigned(ScoreDB) then - Exit; - - {Todo: Add Prevention that only players with more than 5 scores are selected at type 2} - - // Create query - case Typ of - stBestScores: begin - Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title] FROM ['+cUS_Scores+'] ' + - 'INNER JOIN ['+cUS_Songs+'] ON ([SongID] = [ID]) ORDER BY [Score]'; - end; - stBestSingers: begin - Query := 'SELECT [Player], ROUND(AVG([Score])) FROM ['+cUS_Scores+'] ' + - 'GROUP BY [Player] ORDER BY AVG([Score])'; - end; - stMostSungSong: begin - Query := 'SELECT [Artist], [Title], [TimesPlayed] FROM ['+cUS_Songs+'] ' + - 'ORDER BY [TimesPlayed]'; - end; - stMostPopBand: begin - Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM ['+cUS_Songs+'] ' + - 'GROUP BY [Artist] ORDER BY SUM([TimesPlayed])'; - end; - end; - - // Add order direction - Query := Query + IfThen(Reversed, ' ASC', ' DESC'); - - // Add limit - Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';'; - - // Execute query - try - TableData := ScoreDB.GetUniTable(Query); - except - on E: Exception do - begin - Log.LogError(E.Message, 'TDataBaseSystem.GetStats'); - Exit; - end; - end; - - Result := TList.Create; - Stat := nil; - - // Copy result to stats array - while not TableData.EOF do - begin - case Typ of - stBestScores: begin - Stat := TStatResultBestScores.Create; - with TStatResultBestScores(Stat) do - begin - Singer := UTF8Decode(TableData.Fields[0]); - Difficulty := TableData.FieldAsInteger(1); - Score := TableData.FieldAsInteger(2); - SongArtist := UTF8Decode(TableData.Fields[3]); - SongTitle := UTF8Decode(TableData.Fields[4]); - end; - end; - stBestSingers: begin - Stat := TStatResultBestSingers.Create; - with TStatResultBestSingers(Stat) do - begin - Player := UTF8Decode(TableData.Fields[0]); - AverageScore := TableData.FieldAsInteger(1); - end; - end; - stMostSungSong: begin - Stat := TStatResultMostSungSong.Create; - with TStatResultMostSungSong(Stat) do - begin - Artist := UTF8Decode(TableData.Fields[0]); - Title := UTF8Decode(TableData.Fields[1]); - TimesSung := TableData.FieldAsInteger(2); - end; - end; - stMostPopBand: begin - Stat := TStatResultMostPopBand.Create; - with TStatResultMostPopBand(Stat) do - begin - ArtistName := UTF8Decode(TableData.Fields[0]); - TimesSungTot := TableData.FieldAsInteger(1); - end; - end - else - Log.LogCritical('Unknown stat-type', 'TDataBaseSystem.GetStats'); - end; - - Stat.Typ := Typ; - Result.Add(Stat); - - TableData.Next; - end; - - TableData.Free; -end; - -procedure TDataBaseSystem.FreeStats(StatList: TList); -var - I: integer; -begin - if (StatList = nil) then - Exit; - for I := 0 to StatList.Count-1 do - TStatResult(StatList[I]).Free; - StatList.Free; -end; - -(** - * Gets total number of entrys for a stats query - *) -function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): Cardinal; -var - Query: String; -begin - Result := 0; - - if not Assigned(ScoreDB) then - Exit; - - try - // Create query - case Typ of - stBestScores: - Query := 'SELECT COUNT([SongID]) FROM ['+cUS_Scores+'];'; - stBestSingers: - Query := 'SELECT COUNT(DISTINCT [Player]) FROM ['+cUS_Scores+'];'; - stMostSungSong: - Query := 'SELECT COUNT([ID]) FROM ['+cUS_Songs+'];'; - stMostPopBand: - Query := 'SELECT COUNT(DISTINCT [Artist]) FROM ['+cUS_Songs+'];'; - end; - - Result := ScoreDB.GetTableValue(Query); - except on E: Exception do - Log.LogError(E.Message, 'TDataBaseSystem.GetTotalEntrys'); - end; - -end; - -(** - * Gets reset date of statistic data - *) -function TDataBaseSystem.GetStatReset: TDateTime; -var - Query: string; - ResetTime: int64; -begin - Result := 0; - - if not Assigned(ScoreDB) then - Exit; - - try - Query := 'SELECT [ResetTime] FROM ['+cUS_Statistics_Info+'];'; - Result := UnixToDateTime(ScoreDB.GetTableValue(Query)); - except on E: Exception do - Log.LogError(E.Message, 'TDataBaseSystem.GetStatReset'); - end; -end; - -function TDataBaseSystem.GetVersion(): integer; -begin - Result := ScoreDB.GetTableValue('PRAGMA user_version'); -end; - -procedure TDataBaseSystem.SetVersion(Version: integer); -begin - ScoreDB.ExecSQL(Format('PRAGMA user_version = %d', [Version])); -end; - -end. diff --git a/src/Classes/UDraw.pas b/src/Classes/UDraw.pas deleted file mode 100644 index ff0920f5..00000000 --- a/src/Classes/UDraw.pas +++ /dev/null @@ -1,1390 +0,0 @@ -unit UDraw; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UThemes, - ModiSDK, - UGraphicClasses; - -procedure SingDraw; -procedure SingModiDraw (PlayerInfo: TPlayerInfo); -procedure SingDrawBackground; -procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); -procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); -procedure SingDrawLyricHelper(Left, LyricsMid: real); -procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer); -procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); -procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer); -procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer); - -// TimeBar -procedure SingDrawTimeBar(); - -//Draw Editor NoteLines -procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); - - -type - TRecR = record - Top: real; - Left: real; - Right: real; - Bottom: real; - - Width: real; - WMid: real; - Height: real; - HMid: real; - - Mid: real; - end; - -var - NotesW: real; - NotesH: real; - Starfr: integer; - StarfrG: integer; - - //SingBar - TickOld: cardinal; - TickOld2:cardinal; - -const - Przedz = 32; - -implementation - -uses - gl, - UGraphic, - SysUtils, - UMusic, - URecord, - ULog, - UScreenSing, - UScreenSingModi, - ULyrics, - UMain, - TextGL, - UTexture, - UDrawTexture, - UIni, - Math, - UDLLManager; - -procedure SingDrawBackground; -var - Rec: TRecR; - TexRec: TRecR; -begin - if (ScreenSing.Tex_Background.TexNum > 0) then begin - - glClearColor (1, 1, 1, 1); - glColor4f (1, 1, 1, 1); - - if (Ini.MovieSize <= 1) then //HalfSize BG - begin - (* half screen + gradient *) - Rec.Top := 110; // 80 - Rec.Bottom := Rec.Top + 20; - Rec.Left := 0; - Rec.Right := 800; - - TexRec.Top := (Rec.Top / 600) * ScreenSing.Tex_Background.TexH; - TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; - TexRec.Left := 0; - TexRec.Right := ScreenSing.Tex_Background.TexW; - - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum); - glEnable(GL_BLEND); - glBegin(GL_QUADS); - (* gradient draw *) - (* top *) - glColor4f(1, 1, 1, 0); - glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); - glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); - glColor4f(1, 1, 1, 1); - glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); - (* mid *) - Rec.Top := Rec.Bottom; - Rec.Bottom := 490 - 20; // 490 - 20 - TexRec.Top := TexRec.Bottom; - TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; - glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); - (* bottom *) - Rec.Top := Rec.Bottom; - Rec.Bottom := 490; // 490 - TexRec.Top := TexRec.Bottom; - TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; - glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); - glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); - glColor4f(1, 1, 1, 0); - glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); - - glEnd; - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - end - else //Full Size BG - begin - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum); - //glEnable(GL_BLEND); - glBegin(GL_QUADS); - - glTexCoord2f(0, 0); glVertex2f(0, 0); - glTexCoord2f(0, ScreenSing.Tex_Background.TexH); glVertex2f(0, 600); - glTexCoord2f( ScreenSing.Tex_Background.TexW, ScreenSing.Tex_Background.TexH); glVertex2f(800, 600); - glTexCoord2f( ScreenSing.Tex_Background.TexW, 0); glVertex2f(800, 0); - - glEnd; - glDisable(GL_TEXTURE_2D); - //glDisable(GL_BLEND); - end; - end; -end; - -procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); -var - SampleIndex: integer; - Sound: TCaptureBuffer; - MaxX, MaxY: real; -begin; - Sound := AudioInputProcessor.Sound[NrSound]; - - // Log.LogStatus('Oscilloscope', 'SingDraw'); - glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); - {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then - glColor3f(1, 1, 1); } - - MaxX := W-1; - MaxY := (H-1) / 2; - - Sound.LockAnalysisBuffer(); - - glBegin(GL_LINE_STRIP); - for SampleIndex := 0 to High(Sound.AnalysisBuffer) do - begin - glVertex2f(X + MaxX * SampleIndex/High(Sound.AnalysisBuffer), - Y + MaxY * (1 - Sound.AnalysisBuffer[SampleIndex]/-Low(Smallint))); - end; - glEnd; - - Sound.UnlockAnalysisBuffer(); -end; - - - -procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); -var - Count: integer; -begin - glEnable(GL_BLEND); - glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); - glBegin(GL_LINES); - for Count := 0 to 9 do begin - glVertex2f(Left, Top + Count * Space); - glVertex2f(Right, Top + Count * Space); - end; - glEnd; - glDisable(GL_BLEND); -end; - -procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer); -var - Count: integer; - TempR: real; -begin - TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - glEnable(GL_BLEND); - glBegin(GL_LINES); - for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do begin - if (Count mod Lines[NrLines].Resolution) = Lines[NrLines].NotesGAP then - glColor4f(0, 0, 0, 1) - else - glColor4f(0, 0, 0, 0.3); - glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top); - glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top + 135); - end; - glEnd; - glDisable(GL_BLEND); -end; - -// draw blank Notebars -procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); -var - Rec: TRecR; - Count: integer; - TempR: real; - R,G,B: real; - - PlayerNumber: Integer; - - GoldenStarPos : real; - - lTmpA , - lTmpB : real; -begin -// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it's always set to zero -// So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero -// This could also come quite in handy when we do the duet mode, cause just the notes for the player that has to sing should be drawn then -// BUT this is not implemented yet, all notes are drawn! :D - - PlayerNumber := NrLines + 1; // Player 1 is 0 - NrLines := 0; - -// exploit done - - glColor3f(1, 1, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - lTmpA := (Right-Left); - lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - - if ( lTmpA > 0 ) AND - ( lTmpB > 0 ) THEN - begin - TempR := lTmpA / lTmpB; - end - else - begin - TempR := 0; - end; - - - with Lines[NrLines].Line[Lines[NrLines].Current] do begin - for Count := 0 to HighNote do begin - with Note[Count] do begin - if NoteType <> ntFreestyle then begin - - - if Ini.EffectSing = 0 then - // If Golden note Effect of then Change not Color - begin - case NoteType of - ntNormal: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself - ntGolden: glColor4f(1, 1, 0.3, 1); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); - we could - end; // case - end //Else all Notes same Color - else - glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself - // Czesci == teil, element == piece, element | koniec == end / ending - // lewa czesc - left part - Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; - Rec.Bottom := Rec.Top + 2 * NotesH; - glBindTexture(GL_TEXTURE_2D, Tex_plain_Left[PlayerNumber].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - //We keep the postion of the top left corner b4 it's overwritten - GoldenStarPos := Rec.Left; - //done - - // srodkowa czesc - middle part - Rec.Left := Rec.Right; - Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == length - - glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // prawa czesc - right part - Rec.Left := Rec.Right; - Rec.Right := Rec.Right + NotesW; - - glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // Golden Star Patch - if (NoteType = ntGolden) AND (Ini.EffectSing=1) then - begin - GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); - end; - - end; // if not FreeStyle - end; // with - end; // for - end; // with - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - - -// draw sung notes -procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer); -var - TempR: real; - Rec: TRecR; - N: integer; - R, G, B, A: real; - NotesH2: real; -begin - //Log.LogStatus('Player notes', 'SingDraw'); - - //if NrGracza = 0 then LoadColor(R, G, B, 'P1Light') - //else LoadColor(R, G, B, 'P2Light'); - - //R := 71/255; - //G := 175/255; - //B := 247/255; - - glColor3f(1, 1, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - //if Player[NrGracza].LengthNote > 0 then - begin - TempR := W / (Lines[0].Line[Lines[0].Current].End_ - Lines[0].Line[Lines[0].Current].Note[0].Start); - for N := 0 to Player[PlayerIndex].HighNote do - begin - with Player[PlayerIndex].Note[N] do - begin - // Left part of note - Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - - // Draw it in half size, if not hit - if Hit then - begin - NotesH2 := NotesH - end - else - begin - NotesH2 := int(NotesH * 0.65); - end; - - Rec.Top := Y - (Tone-Lines[0].Line[Lines[0].Current].BaseNote)*Space/2 - NotesH2; - Rec.Bottom := Rec.Top + 2 *NotesH2; - - // draw the left part - glColor3f(1, 1, 1); - glBindTexture(GL_TEXTURE_2D, Tex_Left[PlayerIndex+1].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // Middle part of the note - Rec.Left := Rec.Right; - Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX; - - // (nowe) - dunno - if (Start+Length-1 = LyricsState.CurrentBeatD) then - Rec.Right := Rec.Right - (1-Frac(LyricsState.MidBeatD)) * TempR; - // the left note is more right than the right note itself, sounds weird - so we fix that xD - if Rec.Right <= Rec.Left then - Rec.Right := Rec.Left; - - // draw the middle part - glBindTexture(GL_TEXTURE_2D, Tex_Mid[PlayerIndex+1].TexNum); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - glColor3f(1, 1, 1); - - // the right part of the note - Rec.Left := Rec.Right; - Rec.Right := Rec.Right + NotesW; - - glBindTexture(GL_TEXTURE_2D, Tex_Right[PlayerIndex+1].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // Perfect note is stored - if Perfect and (Ini.EffectSing=1) then - begin - A := 1 - 2*(LyricsState.GetCurrentTime() - GetTimeFromBeat(Start+Length)); - if not (Start+Length-1 = LyricsState.CurrentBeatD) then - begin - //Star animation counter - //inc(Starfr); - //Starfr := Starfr mod 128; - GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); - end; - end; - end; // with - end; // for - - // actually we need a comparison here, to determine if the singing process - // is ahead Rec.Right even if there is no singing - - if (Ini.EffectSing = 1) then - GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, PlayerIndex); - end; // if -end; - -//draw Note glow -procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer); -var - Rec: TRecR; - Count: integer; - TempR: real; - R,G,B: real; - X1, X2, X3, X4: real; - W, H: real; - - lTmpA , - lTmpB : real; -begin - if (Player[PlayerIndex].ScoreTotalInt >= 0) then - begin - glColor4f(1, 1, 1, sqrt((1+sin( AudioPlayback.Position * 3))/4)/ 2 + 0.5 ); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - lTmpA := (Right-Left); - lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - - if ( lTmpA > 0 ) and - ( lTmpB > 0 ) then - begin - TempR := lTmpA / lTmpB; - end - else - begin - TempR := 0; - end; - - with Lines[NrLines].Line[Lines[NrLines].Current] do - begin - for Count := 0 to HighNote do - begin - with Note[Count] do - begin - if NoteType <> ntFreestyle then - begin - // begin: 14, 20 - // easy: 6, 11 - W := NotesW * 2 + 2; - H := NotesH * 1.5 + 3.5; - - X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie - X1 := X2-W; - - X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie - X4 := X3+W; - - // left - Rec.Left := X1; - Rec.Right := X2; - Rec.Top := Top - (Tone-BaseNote)*Space/2 - H; - Rec.Bottom := Rec.Top + 2 * H; - - glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[PlayerIndex+1].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // srodkowa czesc - Rec.Left := X2; - Rec.Right := X3; - - glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[PlayerIndex+1].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // prawa czesc - Rec.Left := X3; - Rec.Right := X4; - - glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[PlayerIndex+1].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - end; // if not FreeStyle - end; // with - end; // for - end; // with - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; -end; - -(** - * Draws the lyrics helper bar. - * Left: position the bar starts at - * LyricsMid: the middle of the lyrics relative to the position Left - *) -procedure SingDrawLyricHelper(Left, LyricsMid: real); -var - Bounds: TRecR; // bounds of the lyric help bar - BarProgress: real; // progress of the lyrics helper - BarMoveDelta: real; // current beat relative to the beat the bar starts to move at - BarAlpha: real; // transparency - CurLine: PLine; // current lyric line (beat specific) - LineWidth: real; // lyric line width - FirstNoteBeat: integer; // beat of the first note in the current line - FirstNoteDelta: integer; // time in beats between the start of the current line and its first note - MoveStartX: real; // x-pos. the bar starts to move from - MoveDist: real; // number of pixels the bar will move - LyricEngine: TLyricEngine; -const - BarWidth = 50; // width of the lyric helper bar - BarHeight = 30; // height of the lyric helper bar - BarMoveLimit = 40; // max. number of beats remaining before the bar starts to move -begin - // get current lyrics line and the time in beats of its first note - CurLine := @Lines[0].Line[Lines[0].Current]; - - // FIXME: accessing ScreenSing is not that generic - LyricEngine := ScreenSing.Lyrics; - - // do not draw the lyrics helper if the current line does not contain any note - if (Length(CurLine.Note) > 0) then - begin - // start beat of the first note of this line - FirstNoteBeat := CurLine.Note[0].Start; - // time in beats between the start of the current line and its first note - FirstNoteDelta := FirstNoteBeat - CurLine.Start; - - // beats from current beat to the first note of the line - BarMoveDelta := FirstNoteBeat - LyricsState.MidBeat; - - if (FirstNoteDelta > 8) and // if the wait-time is large enough - (BarMoveDelta > 0) then // and the first note of the line is not reached - begin - // let the bar blink to the beat - BarAlpha := 0.75 + cos(BarMoveDelta/2) * 0.25; - - // if the number of beats to the first note is too big, - // the bar stays on the left side. - if (BarMoveDelta > BarMoveLimit) then - BarMoveDelta := BarMoveLimit; - - // limit number of beats the bar moves - if (FirstNoteDelta > BarMoveLimit) then - FirstNoteDelta := BarMoveLimit; - - // calc bar progress - BarProgress := 1 - BarMoveDelta / FirstNoteDelta; - - // retrieve the width of the upper lyrics line on the display - if (LyricEngine.GetUpperLine() <> nil) then - LineWidth := LyricEngine.GetUpperLine().Width - else - LineWidth := 0; - - // distance the bar will move (LyricRec.Left to beginning of text) - MoveDist := LyricsMid - LineWidth / 2 - BarWidth; - // if the line is too long the helper might move from right to left - // so we have to assure the start position is left of the text. - if (MoveDist >= 0) then - MoveStartX := Left - else - MoveStartX := Left + MoveDist; - - // determine lyric help bar position and size - Bounds.Left := MoveStartX + BarProgress * MoveDist; - Bounds.Right := Bounds.Left + BarWidth; - Bounds.Top := Skin_LyricsT + 3; - Bounds.Bottom := Bounds.Top + BarHeight + 3; - - // draw lyric help bar - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glColor4f(1, 1, 1, BarAlpha); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Bounds.Left, Bounds.Top); - glTexCoord2f(0, 1); glVertex2f(Bounds.Left, Bounds.Bottom); - glTexCoord2f(1, 1); glVertex2f(Bounds.Right, Bounds.Bottom); - glTexCoord2f(1, 0); glVertex2f(Bounds.Right, Bounds.Top); - glEnd; - glDisable(GL_BLEND); - end; - end; -end; - -procedure SingDraw; -var - NR: TRecR; // lyrics area bounds (NR = NoteRec?) - LyricEngine: TLyricEngine; -begin - // positions - if Ini.SingWindow = 0 then - NR.Left := 120 - else - NR.Left := 20; - - NR.Right := 780; - - NR.Width := NR.Right - NR.Left; - NR.WMid := NR.Width / 2; - NR.Mid := NR.Left + NR.WMid; - - // FIXME: accessing ScreenSing is not that generic - LyricEngine := ScreenSing.Lyrics; - - // background //BG Fullsize Mod - //SingDrawBackground; - - // draw time-bar - SingDrawTimeBar(); - - // draw note-lines - - if (PlayersPlay = 1) and (Ini.NoteLines = 1) then - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); - - if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then - begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); - end; - - if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); - end; - - // draw Lyrics - LyricEngine.Draw(LyricsState.MidBeat); - SingDrawLyricHelper(NR.Left, NR.WMid); - - // oscilloscope - if Ini.Oscilloscope = 1 then begin - if PlayersPlay = 1 then - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - - if PlayersPlay = 2 then begin - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); - end; - if ScreenAct = 2 then begin - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3); - end; - end; - - if PlayersPlay = 3 then begin - SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); - end; - if ScreenAct = 2 then begin - SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4); - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5); - end; - end; - - end; - - // Set the note heights according to the difficulty level - case Ini.Difficulty of - 0: - begin - NotesH := 11; // 9 - NotesW := 6; // 5 - end; - 1: - begin - NotesH := 8; // 7 - NotesW := 4; // 4 - end; - 2: - begin - NotesH := 5; - NotesW := 3; - end; - end; - - // Draw the Notes - if PlayersPlay = 1 then begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes - end; - - if (PlayersPlay = 2) then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - - SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); - end; - - if PlayersPlay = 3 then begin - NotesW := NotesW * 0.8; - NotesH := NotesH * 0.8; - - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - - SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); - SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); - end; - - if ScreenAct = 1 then begin - SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); - end; - - if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); - end; - end; - - if PlayersPlay = 6 then begin - NotesW := NotesW * 0.8; - NotesH := NotesH * 0.8; - - if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); - end; - - if ScreenAct = 1 then begin - SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); - SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); - SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); - SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); - end; - - if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); - end; - end; - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - -// q'n'd for using the game mode dll's -procedure SingModiDraw (PlayerInfo: TPlayerInfo); -var - Count: integer; - Pet2: integer; - TempR: real; - Rec: TRecR; - TexRec: TRecR; - NR: TRecR; - FS: real; - BarFrom: integer; - BarAlpha: real; - BarWspol: real; - TempCol: real; - Tekst: string; - PetCz: integer; -begin - // positions - if Ini.SingWindow = 0 then begin - NR.Left := 120; - end else begin - NR.Left := 20; - end; - - NR.Right := 780; - NR.Width := NR.Right - NR.Left; - NR.WMid := NR.Width / 2; - NR.Mid := NR.Left + NR.WMid; - - // time bar - SingDrawTimeBar(); - - if DLLMan.Selected.ShowNotes then - begin - if PlayersPlay = 1 then - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); - if (PlayersPlay = 2) or (PlayersPlay = 4) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); - end; - - if (PlayersPlay = 3) or (PlayersPlay = 6) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); - end; - end; - - // Draw Lyrics - ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat); - - // todo: Lyrics -{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie - FS := 1.3; - BarFrom := Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start; - if BarFrom > 40 then BarFrom := 40; - if (Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more - (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat > 0) and // przed tekstem - (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (LyricsState.MidBeat - (Lines[0].Line[Lines[0].Current].StartNote - BarFrom)) / BarFrom; - Rec.Left := NR.Left + BarWspol * (ScreenSingModi.LyricMain.ClientX - NR.Left - 50) + 10*ScreenX; - Rec.Right := Rec.Left + 50; - Rec.Top := Skin_LyricsT + 3; - Rec.Bottom := Rec.Top + 33;//SingScreen.LyricMain.Size * 3; - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); - glBegin(GL_QUADS); - glColor4f(1, 1, 1, 0); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glColor4f(1, 1, 1, 0.5); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - glDisable(GL_BLEND); - end; - } - - // oscilloscope | the thing that moves when you yell into your mic (imho) - if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then begin - if PlayersPlay = 1 then - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - - if PlayersPlay = 2 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3); - end; - end; - - if PlayersPlay = 3 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); - end; - - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); - end; - if ScreenAct = 2 then begin - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); - if PlayerInfo.Playerinfo[4].Enabled then - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4); - if PlayerInfo.Playerinfo[5].Enabled then - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5); - end; - end; - - end; - -// resize the notes according to the difficulty level - case Ini.Difficulty of - 0: - begin - NotesH := 11; // 9 - NotesW := 6; // 5 - end; - 1: - begin - NotesH := 8; // 7 - NotesW := 4; // 4 - end; - 2: - begin - NotesH := 5; - NotesW := 3; - end; - end; - - if (DLLMAn.Selected.ShowNotes And DLLMan.Selected.LoadSong) then - begin - if (PlayersPlay = 1) And PlayerInfo.Playerinfo[0].Enabled then begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); - end; - - if (PlayersPlay = 2) then begin - if PlayerInfo.Playerinfo[0].Enabled then - begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - end; - if PlayerInfo.Playerinfo[1].Enabled then - begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); - end; - - end; - - if PlayersPlay = 3 then begin - NotesW := NotesW * 0.8; - NotesH := NotesH * 0.8; - - if PlayerInfo.Playerinfo[0].Enabled then - begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - end; - - if PlayerInfo.Playerinfo[1].Enabled then - begin - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - end; - - if PlayerInfo.Playerinfo[2].Enabled then - begin - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - end; - - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); - end; - - SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - - if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); - end; - if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); - end; - end; - - if PlayersPlay = 6 then begin - NotesW := NotesW * 0.8; - NotesH := NotesH * 0.8; - - if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); - end; - - SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - - if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); - end; - if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); - end; - end; - end; - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - - -{//SingBar Mod -procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); -var - R: Real; - G: Real; - B: Real; - A: cardinal; - I: Integer; - -begin; - - //SingBar Background - glColor4f(1, 1, 1, 0.8); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Back.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, 1); glVertex2f(X, Y+H); - glTexCoord2f(1, 1); glVertex2f(X+W, Y+H); - glTexCoord2f(1, 0); glVertex2f(X+W, Y); - glEnd; - - //SingBar coloured Bar - Case Percent of - 0..22: begin - R := 1; - G := 0; - B := 0; - end; - 23..42: begin - R := 1; - G := ((Percent-23)/100)*5; - B := 0; - end; - 43..57: begin - R := 1; - G := 1; - B := 0; - end; - 58..77: begin - R := 1-(Percent - 58)/100*5; - G := 1; - B := 0; - end; - 78..99: begin - R := 0; - G := 1; - B := 0; - end; - End; //Case - - glColor4f(R, G, B, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Bar.TexNum); - //Size= Player[PlayerNum].ScorePercent of W - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, 1); glVertex2f(X, Y+H); - glTexCoord2f(1, 1); glVertex2f(X+(W/100 * (Percent +1)), Y+H); - glTexCoord2f(1, 0); glVertex2f(X+(W/100 * (Percent +1)), Y); - glEnd; - - //SingBar Front - glColor4f(1, 1, 1, 0.6); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Front.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, 1); glVertex2f(X, Y+H); - glTexCoord2f(1, 1); glVertex2f(X+W, Y+H); - glTexCoord2f(1, 0); glVertex2f(X+W, Y); - glEnd; -end; -//end Singbar Mod - -//PhrasenBonus - Line Bonus Pop Up -procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); -var -Length, X2: Real; //Length of Text -Size: Integer; //Size of Popup -begin -if Alpha <> 0 then -begin - -//Set Font Propertys -SetFontStyle(2); //Font: Outlined1 -if Age < 5 then SetFontSize(Age + 1) else SetFontSize(6); -SetFontItalic(False); - -//Check Font Size -Length := glTextWidth ( PChar(Text)) + 3; //Little Space for a Better Look ^^ - -//Text -SetFontPos (X + 50 - (Length / 2), Y + 12); //Position - - -if Age < 5 then Size := Age * 10 else Size := 50; - - //Draw Background - //glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color - glColor4f(1, 1, 1, Alpha); - - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - //glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - - //New Method, Not Variable - glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); - glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2)); - glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2)); - glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2)); - glEnd; - - glColor4f(1, 1, 1, Alpha); //Set Color - //Draw Text - glPrint (PChar(Text)); -end; -end; -//PhrasenBonus - Line Bonus Mod} - -// Draw Note Bars for Editor -//There are 11 Resons for a new Procdedure: (nice binary :D ) -// 1. It don't look good when you Draw the Golden Note Star Effect in the Editor -// 2. You can see the Freestyle Notes in the Editor SemiTransparent -// 3. Its easier and Faster then changing the old Procedure -procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); -var - Rec: TRecR; - Count: integer; - TempR: real; -begin - glColor3f(1, 1, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - with Lines[NrLines].Line[Lines[NrLines].Current] do begin - for Count := 0 to HighNote do begin - with Note[Count] do begin - - // Golden Note Patch - case NoteType of - ntFreestyle: glColor4f(1, 1, 1, 0.35); - ntNormal: glColor4f(1, 1, 1, 0.85); - ntGolden: Glcolor4f(1, 1, 0.3, 0.85); - end; // case - - - - // lewa czesc - left part - Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; - Rec.Bottom := Rec.Top + 2 * NotesH; - glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // srodkowa czesc - middle part - Rec.Left := Rec.Right; - Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; - - glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // prawa czesc - right part - Rec.Left := Rec.Right; - Rec.Right := Rec.Right + NotesW; - - glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - end; // with - end; // for - end; // with - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - -procedure SingDrawTimeBar(); -var - x,y: real; - width, height: real; - LyricsProgress: real; - CurLyricsTime: real; -begin - x := Theme.Sing.StaticTimeProgress.x; - y := Theme.Sing.StaticTimeProgress.y; - - width := Theme.Sing.StaticTimeProgress.w; - height := Theme.Sing.StaticTimeProgress.h; - - glColor4f(Theme.Sing.StaticTimeProgress.ColR, - Theme.Sing.StaticTimeProgress.ColG, - Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - - glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(x, y); - - CurLyricsTime := LyricsState.GetCurrentTime(); - if (CurLyricsTime > 0) and - (LyricsState.TotalTime > 0) then - begin - LyricsProgress := CurLyricsTime / LyricsState.TotalTime; - glTexCoord2f((width * LyricsProgress) / 8, 0); - glVertex2f(x + width * LyricsProgress, y); - - glTexCoord2f((width * LyricsProgress) / 8, 1); - glVertex2f(x + width * LyricsProgress, y + height); - end; - - glTexCoord2f(0, 1); - glVertex2f(x, y + height); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - glcolor4f(1, 1, 1, 1); -end; - -end. - diff --git a/src/Classes/UEditorLyrics.pas b/src/Classes/UEditorLyrics.pas deleted file mode 100644 index 25e8423e..00000000 --- a/src/Classes/UEditorLyrics.pas +++ /dev/null @@ -1,229 +0,0 @@ -unit UEditorLyrics; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - gl, - UMusic, - UTexture; - -type - TWord = record - X: real; - Y: real; - Size: real; - Width: real; - Text: string; - ColR: real; - ColG: real; - ColB: real; - FontStyle: integer; - Italic: boolean; - Selected: boolean; - end; - - TEditorLyrics = class - private - AlignI: integer; - XR: real; - YR: real; - SizeR: real; - SelectedI: integer; - FontStyleI: integer; // font number - Word: array of TWord; - - 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 SetFStyle(Value: integer); - procedure AddWord(Text: string); - procedure Refresh; - public - ColR: real; - ColG: real; - ColB: real; - ColSR: real; - ColSG: real; - ColSB: real; - Italic: boolean; - - constructor Create; - destructor Destroy; override; - - procedure AddLine(NrLine: integer); - - 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 FontStyle: integer write SetFStyle; - end; - -implementation - -uses - TextGL, UGraphic, UDrawTexture, Math, USkins; - -constructor TEditorLyrics.Create; -begin - inherited; -end; - -destructor TEditorLyrics.Destroy; -begin - SetLength(Word, 0); - inherited; -end; - -procedure TEditorLyrics.SetX(Value: real); -begin - XR := Value; -end; - -procedure TEditorLyrics.SetY(Value: real); -begin - YR := Value; -end; - -function TEditorLyrics.GetClientX: real; -begin - Result := Word[0].X; -end; - -procedure TEditorLyrics.SetAlign(Value: integer); -begin - AlignI := Value; -end; - -function TEditorLyrics.GetSize: real; -begin - Result := SizeR; -end; - -procedure TEditorLyrics.SetSize(Value: real); -begin - SizeR := Value; -end; - -procedure TEditorLyrics.SetSelected(Value: integer); -var - W: integer; -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; - 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; - end; - - Refresh; -end; - -procedure TEditorLyrics.SetFStyle(Value: integer); -begin - FontStyleI := Value; -end; - -procedure TEditorLyrics.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; - 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].Italic := Italic; - - Refresh; -end; - -procedure TEditorLyrics.AddLine(NrLine: integer); -var - N: integer; -begin - Clear; - for N := 0 to Lines[0].Line[NrLine].HighNote do begin - Italic := Lines[0].Line[NrLine].Note[N].NoteType = ntFreestyle; - AddWord(Lines[0].Line[NrLine].Note[N].Text); - end; - Selected := -1; -end; - -procedure TEditorLyrics.Clear; -begin - SetLength(Word, 0); - SelectedI := -1; -end; - -procedure TEditorLyrics.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 TEditorLyrics.Draw; -var - W: integer; -begin - for W := 0 to High(Word) do - 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; -end; - -end. diff --git a/src/Classes/UFiles.pas b/src/Classes/UFiles.pas deleted file mode 100644 index ca43bb21..00000000 --- a/src/Classes/UFiles.pas +++ /dev/null @@ -1,150 +0,0 @@ -unit UFiles; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} -{$I switches.inc} - -uses SysUtils, - ULog, - UMusic, - USongs, - USong; - -procedure ResetSingTemp; -function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean; - -var - SongFile: TextFile; // all procedures in this unit operates on this file - FileLineNo: integer; //Line which is readed at Last, for error reporting - - // variables available for all procedures - Base : array[0..1] of integer; - Rel : array[0..1] of integer; - Mult : integer = 1; - MultBPM : integer = 4; - -implementation - -uses TextGL, - UIni, - UPlatform, - UMain; - -//-------------------- -// Resets the temporary Sentence Arrays for each Player and some other Variables -//-------------------- -procedure ResetSingTemp; -var - Count: integer; -begin - SetLength(Lines, Length(Player)); - for Count := 0 to High(Player) do begin - SetLength(Lines[Count].Line, 1); - SetLength(Lines[Count].Line[0].Note, 0); - Lines[Count].Line[0].Lyric := ''; - Lines[Count].Line[0].LyricWidth := 0; - Player[Count].Score := 0; - Player[Count].LengthNote := 0; - Player[Count].HighNote := -1; - end; - - (* FIXME - //Reset Path and Filename Values to Prevent Errors in Editor - if assigned( CurrentSong ) then - begin - SetLength(CurrentSong.BPM, 0); - CurrentSong.Path := ''; - CurrentSong.FileName := ''; - end; - *) - -// CurrentSong := nil; -end; - - -//-------------------- -// Saves a Song -//-------------------- -function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean; -var - C: integer; - N: integer; - S: string; - B: integer; - RelativeSubTime: integer; - NoteState: String; - -begin -// Relative := true; // override (idea - use shift+S to save with relative) - AssignFile(SongFile, Name); - Rewrite(SongFile); - - Writeln(SongFile, '#TITLE:' + Song.Title + ''); - Writeln(SongFile, '#ARTIST:' + Song.Artist); - - if Song.Creator <> '' then Writeln(SongFile, '#CREATOR:' + Song.Creator); - if Song.Edition <> 'Unknown' then Writeln(SongFile, '#EDITION:' + Song.Edition); - if Song.Genre <> 'Unknown' then Writeln(SongFile, '#GENRE:' + Song.Genre); - if Song.Language <> 'Unknown' then Writeln(SongFile, '#LANGUAGE:' + Song.Language); - - Writeln(SongFile, '#MP3:' + Song.Mp3); - - if Song.Cover <> '' then Writeln(SongFile, '#COVER:' + Song.Cover); - if Song.Background <> '' then Writeln(SongFile, '#BACKGROUND:' + Song.Background); - if Song.Video <> '' then Writeln(SongFile, '#VIDEO:' + Song.Video); - if Song.VideoGAP <> 0 then Writeln(SongFile, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP)); - if Song.Resolution <> 4 then Writeln(SongFile, '#RESOLUTION:' + IntToStr(Song.Resolution)); - if Song.NotesGAP <> 0 then Writeln(SongFile, '#NOTESGAP:' + IntToStr(Song.NotesGAP)); - if Song.Start <> 0 then Writeln(SongFile, '#START:' + FloatToStr(Song.Start)); - if Song.Finish <> 0 then Writeln(SongFile, '#END:' + IntToStr(Song.Finish)); - if Relative then Writeln(SongFile, '#RELATIVE:yes'); - - Writeln(SongFile, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4)); - Writeln(SongFile, '#GAP:' + FloatToStr(Song.GAP)); - - RelativeSubTime := 0; - for B := 1 to High(CurrentSong.BPM) do - Writeln(SongFile, 'B ' + FloatToStr(CurrentSong.BPM[B].StartBeat) + ' ' + FloatToStr(CurrentSong.BPM[B].BPM/4)); - - for C := 0 to Lines.High do begin - for N := 0 to Lines.Line[C].HighNote do begin - with Lines.Line[C].Note[N] do begin - - - //Golden + Freestyle Note Patch - case Lines.Line[C].Note[N].NoteType of - ntFreestyle: NoteState := 'F '; - ntNormal: NoteState := ': '; - ntGolden: NoteState := '* '; - end; // case - S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Length) + ' ' + IntToStr(Tone) + ' ' + Text; - - - Writeln(SongFile, S); - end; // with - end; // N - - if C < Lines.High then begin // don't write end of last sentence - if not Relative then - S := '- ' + IntToStr(Lines.Line[C+1].Start) - else begin - S := '- ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime) + - ' ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime); - RelativeSubTime := Lines.Line[C+1].Start; - end; - Writeln(SongFile, S); - end; - - end; // C - - - Writeln(SongFile, 'E'); - CloseFile(SongFile); - - Result := true; -end; - -end. diff --git a/src/Classes/UGraphic.pas b/src/Classes/UGraphic.pas deleted file mode 100644 index 2432503c..00000000 --- a/src/Classes/UGraphic.pas +++ /dev/null @@ -1,760 +0,0 @@ -unit UGraphic; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SDL, - gl, - glext, - UTexture, - TextGL, - ULog, - SysUtils, - ULyrics, - UImage, - UMusic, - UScreenLoading, - UScreenWelcome, - UScreenMain, - UScreenName, - UScreenLevel, - UScreenOptions, - UScreenOptionsGame, - UScreenOptionsGraphics, - UScreenOptionsSound, - UScreenOptionsLyrics, - UScreenOptionsThemes, - UScreenOptionsRecord, - UScreenOptionsAdvanced, - UScreenSong, - UScreenSing, - UScreenScore, - UScreenTop5, - UScreenEditSub, - UScreenEdit, - UScreenEditConvert, - UScreenEditHeader, - UScreenOpen, - UThemes, - USkins, - UScreenSongMenu, - UScreenSongJumpto, - {Party Screens} - UScreenSingModi, - UScreenPartyNewRound, - UScreenPartyScore, - UScreenPartyOptions, - UScreenPartyWin, - UScreenPartyPlayer, - {Stats Screens} - UScreenStatMain, - UScreenStatDetail, - {CreditsScreen} - UScreenCredits, - {Popup for errors, etc.} - UScreenPopup; - -type - TRecR = record - Top: real; - Left: real; - Right: real; - Bottom: real; - end; - -var - Screen: PSDL_Surface; - LoadingThread: PSDL_Thread; - Mutex: PSDL_Mutex; - - RenderW: integer; - RenderH: integer; - ScreenW: integer; - ScreenH: integer; - Screens: integer; - ScreenAct: integer; - ScreenX: integer; - - ScreenLoading: TScreenLoading; - ScreenWelcome: TScreenWelcome; - ScreenMain: TScreenMain; - ScreenName: TScreenName; - ScreenLevel: TScreenLevel; - ScreenSong: TScreenSong; - ScreenSing: TScreenSing; - ScreenScore: TScreenScore; - ScreenTop5: TScreenTop5; - ScreenOptions: TScreenOptions; - ScreenOptionsGame: TScreenOptionsGame; - ScreenOptionsGraphics: TScreenOptionsGraphics; - ScreenOptionsSound: TScreenOptionsSound; - ScreenOptionsLyrics: TScreenOptionsLyrics; - ScreenOptionsThemes: TScreenOptionsThemes; - ScreenOptionsRecord: TScreenOptionsRecord; - ScreenOptionsAdvanced: TScreenOptionsAdvanced; - ScreenEditSub: TScreenEditSub; - ScreenEdit: TScreenEdit; - ScreenEditConvert: TScreenEditConvert; - ScreenEditHeader: TScreenEditHeader; - ScreenOpen: TScreenOpen; - - ScreenSongMenu: TScreenSongMenu; - ScreenSongJumpto: TScreenSongJumpto; - - //Party Screens - ScreenSingModi: TScreenSingModi; - ScreenPartyNewRound: TScreenPartyNewRound; - ScreenPartyScore: TScreenPartyScore; - ScreenPartyWin: TScreenPartyWin; - ScreenPartyOptions: TScreenPartyOptions; - ScreenPartyPlayer: TScreenPartyPlayer; - - //StatsScreens - ScreenStatMain: TScreenStatMain; - ScreenStatDetail: TScreenStatDetail; - - //CreditsScreen - ScreenCredits: TScreenCredits; - - //popup mod - ScreenPopupCheck: TScreenPopupCheck; - ScreenPopupError: TScreenPopupError; - - //Notes - Tex_Left: array[0..6] of TTexture; //rename to tex_note_left - Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid - Tex_Right: array[0..6] of TTexture; //rename to tex_note_right - - Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left - Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid - Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right - - Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left - Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid - Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right - - Tex_Note_Star: TTexture; - Tex_Note_Perfect_Star: TTexture; - - - Tex_Ball: TTexture; - Tex_Lyric_Help_Bar: TTexture; - FullScreen: boolean; - - Tex_TimeProgress: TTexture; - - //Sing Bar Mod - Tex_SingBar_Back: TTexture; - Tex_SingBar_Bar: TTexture; - Tex_SingBar_Front: TTexture; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - Tex_SingLineBonusBack: array[0..8] of TTexture; - //End PhrasenBonus - Line Bonus Mod - - //ScoreBG Texs - Tex_ScoreBG: array [0..5] of TTexture; - - //Score Screen Textures - Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture; - Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture; - - Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture; - Tex_Score_NoteBarRound_Light : array [1..6] of TTexture; - - Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture; - Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture; - - Tex_Score_Ratings : array [0..7] of TTexture; - -const - Skin_BGColorR = 1; - Skin_BGColorG = 1; - Skin_BGColorB = 1; - - Skin_SpectrumR = 0; - Skin_SpectrumG = 0; - Skin_SpectrumB = 0; - - Skin_Spectograph1R = 0.6; - Skin_Spectograph1G = 0.8; - Skin_Spectograph1B = 1; - - Skin_Spectograph2R = 0; - Skin_Spectograph2G = 0; - Skin_Spectograph2B = 0.2; - - Skin_SzczytR = 0.8; - Skin_SzczytG = 0; - Skin_SzczytB = 0; - - Skin_SzczytLimitR = 0; - Skin_SzczytLimitG = 0.8; - Skin_SzczytLimitB = 0; - - Skin_FontR = 0; - Skin_FontG = 0; - Skin_FontB = 0; - - Skin_FontHighlightR = 0.3; // 0.3 - Skin_FontHighlightG = 0.3; // 0.3 - Skin_FontHighlightB = 1; // 1 - - Skin_TimeR = 0.25; //0,0,0 - Skin_TimeG = 0.25; - Skin_TimeB = 0.25; - - Skin_OscR = 0; - Skin_OscG = 0; - Skin_OscB = 0; - - Skin_LyricsT = 494; // 500 / 510 / 400 - Skin_SpectrumT = 470; - Skin_SpectrumBot = 570; - Skin_SpectrumH = 100; - - Skin_P1_LinesR = 0.5; // 0.6 0.6 1 - Skin_P1_LinesG = 0.5; - Skin_P1_LinesB = 0.5; - - Skin_P2_LinesR = 0.5; // 1 0.6 0.6 - Skin_P2_LinesG = 0.5; - Skin_P2_LinesB = 0.5; - - Skin_P1_NotesB = 250; - Skin_P2_NotesB = 430; // 430 / 300 - - Skin_P1_ScoreT = 50; - Skin_P1_ScoreL = 20; - - Skin_P2_ScoreT = 50; - Skin_P2_ScoreL = 640; - -procedure Initialize3D (Title: string); -procedure Reinitialize3D; -procedure SwapBuffers; - -procedure LoadTextures; -procedure InitializeScreen; -procedure LoadLoadingScreen; -procedure LoadScreens; -procedure UnLoadScreens; - -function LoadingThreadFunction: integer; - - -implementation - -uses - UMain, - UIni, - UDisplay, - UCommandLine, - Classes; - -procedure LoadFontTextures; -begin - Log.LogStatus('Building Fonts', 'LoadTextures'); - BuildFont; -end; - -procedure LoadTextures; - - -var - P: integer; - R, G, B: real; - Col: integer; -begin - // zaladowanie tekstur - Log.LogStatus('Loading Textures', 'LoadTextures'); - - Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch? - Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); //brauch man die noch? - Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch? - - Log.LogStatus('Loading Textures - A', 'LoadTextures'); - - // P1-6 - // TODO... do it once for each player... this is a bit crappy !! - // can we make it any better !? - for P := 1 to 6 do - begin - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - - Tex_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_COLORIZED, Col); - Tex_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_COLORIZED, Col); - Tex_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_COLORIZED, Col); - - Tex_plain_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainLeft'), TEXTURE_TYPE_COLORIZED, Col); - Tex_plain_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainMid'), TEXTURE_TYPE_COLORIZED, Col); - Tex_plain_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainRight'), TEXTURE_TYPE_COLORIZED, Col); - - Tex_BG_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGLeft'), TEXTURE_TYPE_COLORIZED, Col); - Tex_BG_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGMid'), TEXTURE_TYPE_COLORIZED, Col); - Tex_BG_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGRight'), TEXTURE_TYPE_COLORIZED, Col); - end; - - Log.LogStatus('Loading Textures - B', 'LoadTextures'); - - Tex_Note_Perfect_Star := Texture.LoadTexture(Skin.GetTextureFileName('NotePerfectStar'), TEXTURE_TYPE_TRANSPARENT, 0); - Tex_Note_Star := Texture.LoadTexture(Skin.GetTextureFileName('NoteStar') , TEXTURE_TYPE_TRANSPARENT, $FFFFFF); - Tex_Ball := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); - Tex_Lyric_Help_Bar := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); - - - //TimeBar mod - Tex_TimeProgress := Texture.LoadTexture(Skin.GetTextureFileName('TimeBar')); - //eoa TimeBar mod - - //SingBar Mod - Tex_SingBar_Back := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBack'), TEXTURE_TYPE_PLAIN, 0); - Tex_SingBar_Bar := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBar'), TEXTURE_TYPE_PLAIN, 0); - Tex_SingBar_Front := Texture.LoadTexture(Skin.GetTextureFileName('SingBarFront'), TEXTURE_TYPE_PLAIN, 0); - //end Singbar Mod - - Log.LogStatus('Loading Textures - C', 'LoadTextures'); - - //Line Bonus PopUp - for P := 0 to 8 do - begin - Case P of - 0: begin - R := 1; - G := 0; - B := 0; - end; - 1..3: begin - R := 1; - G := (P * 0.25); - B := 0; - end; - 4: begin - R := 1; - G := 1; - B := 0; - end; - 5..7: begin - R := 1-((P-4)*0.25); - G := 1; - B := 0; - end; - 8: begin - R := 0; - G := 1; - B := 0; - end; - End; - - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), TEXTURE_TYPE_COLORIZED, Col); - end; - -//## backgrounds for the scores ## - for P := 0 to 5 do begin - LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), TEXTURE_TYPE_COLORIZED, Col); - end; - - - Log.LogStatus('Loading Textures - D', 'LoadTextures'); - -// ###################### -// Score screen textures -// ###################### - -//## the bars that visualize the score ## - for P := 1 to 6 do begin -//NoteBar ScoreBar - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), TEXTURE_TYPE_COLORIZED, Col); - Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), TEXTURE_TYPE_COLORIZED, Col); -//LineBonus ScoreBar - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), TEXTURE_TYPE_COLORIZED, Col); - Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), TEXTURE_TYPE_COLORIZED, Col); -//GoldenNotes ScoreBar - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), TEXTURE_TYPE_COLORIZED, Col); - Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), TEXTURE_TYPE_COLORIZED, Col); - end; - -//## rating pictures that show a picture according to your rate ## - for P := 0 to 7 do begin - Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), TEXTURE_TYPE_TRANSPARENT, 0); - end; - - Log.LogStatus('Loading Textures - Done', 'LoadTextures'); -end; - -(* - * Load OpenGL extensions. Must be called after SDL_SetVideoMode() and each - * time the pixel-format or render-context (RC) changes. - *) -procedure LoadOpenGLExtensions; -begin - // Load OpenGL 1.2 extensions for OpenGL 1.2 compatibility - if (not Load_GL_version_1_2()) then - begin - Log.LogCritical('Failed loading OpenGL 1.2', 'UGraphic.Initialize3D'); - end; - - // Other extensions e.g. OpenGL 1.3-2.0 or Framebuffer-Object might be loaded here - // ... - //Load_GL_EXT_framebuffer_object(); -end; - -procedure Initialize3D (Title: string); -var - Icon: PSDL_Surface; -begin - Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); - if ( SDL_InitSubSystem(SDL_INIT_VIDEO) = -1 ) then - begin - Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); - exit; - end; - - // load icon image (must be 32x32 for win32) - Icon := LoadImage('WINDOWICON'); - if (Icon <> nil) then - SDL_WM_SetIcon(Icon, 0); - - SDL_WM_SetCaption(PChar(Title), nil); - - //Log.BenchmarkStart(2); - - InitializeScreen; - - //Log.BenchmarkEnd(2); - //Log.LogBenchmark('--> Setting Screen', 2); - - //Log.BenchmarkStart(2); - Texture := TTextureUnit.Create; - // FIXME: this does not seem to be correct as Limit is the max. of either - // width or height. - Texture.Limit := 1024*1024; - - //LoadTextures; - //Log.BenchmarkEnd(2); - //Log.LogBenchmark('--> Loading Textures', 2); - - { - Log.BenchmarkStart(2); - Lyric:= TLyric.Create; - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Fonts', 2); - } - - // Note: do not initialize video modules earlier. They might depend on some - // SDL video functions or OpenGL extensions initialized in InitializeScreen() - InitializeVideo(); - - //Log.BenchmarkStart(2); - - Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D'); - Display := TDisplay.Create; - - //Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); - - //Log.LogStatus('Loading Screens', 'Initialize3D'); - //Log.BenchmarkStart(3); - - Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D'); - LoadFontTextures(); - - // Show the Loading Screen ------------- - Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D'); - LoadLoadingScreen; - - - Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D'); - LoadTextures; // jb - - - - // now that we have something to display while loading, - // start thread that loads the rest of ultrastar - //Mutex := SDL_CreateMutex; - //SDL_UnLockMutex(Mutex); - - // does not work this way because the loading thread tries to access opengl. - // See comment below - //LoadingThread := SDL_CreateThread(@LoadingThread, nil); - - // this would be run in the loadingthread - Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D'); - LoadScreens; - - - // TODO: - // here should be a loop which - // * draws the loading screen (form time to time) - // * controlls the "process of the loading screen - // * checks if the loadingthread has loaded textures (check mutex) and - // * load the textures into opengl - // * tells the loadingthread, that the memory for the texture can be reused - // to load the netx texture (over another mutex) - // * runs as long as the loadingthread tells, that everything is loaded and ready (using a third mutex) - // - // therefor loadtexture have to be changed, that it, instat of caling some opengl functions - // for itself, it should change mutex - // the mainthread have to know somehow what opengl function have to be called with which parameters like - // texturetype, textureobjekt, textur-buffer-adress, ... - - // wait for loading thread to finish - // currently does not work this way - // SDL_WaitThread(LoadingThread, I); - // SDL_DestroyMutex(Mutex); - - Display.CurrentScreen^.FadeTo( @ScreenMain ); - - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Screens', 2); - - Log.LogStatus('Finish', 'Initialize3D'); -end; - -procedure SwapBuffers; -begin - SDL_GL_SwapBuffers; - glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, RenderW, RenderH, 0, -1, 100); - glMatrixMode(GL_MODELVIEW); -end; - -procedure Reinitialize3D; -begin - InitializeScreen; -end; - -procedure InitializeScreen; -var - S: string; - I: integer; - W, H: integer; - Depth: Integer; -begin - if (Params.Screens <> -1) then - Screens := Params.Screens + 1 - else - Screens := Ini.Screens + 1; - - SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); // Z-Buffer depth - SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); - - // VSYNC works for windows only at the moment. SDL_GL_SWAP_CONTROL under - // linux uses GLX_MESA_swap_control which is not supported by nvidea cards. - // Maybe use glXSwapIntervalSGI(1) from the GLX_SGI_swap_control extension instead. - //SDL_GL_SetAttribute(SDL_GL_SWAP_CONTROL, 1); // VSYNC (currently Windows only) - - // If there is a resolution in Parameters, use it, else use the Ini value - I := Params.Resolution; - if (I <> -1) then - S := IResolution[I] - else - S := IResolution[Ini.Resolution]; - - I := Pos('x', S); - W := StrToInt(Copy(S, 1, I-1)) * Screens; - H := StrToInt(Copy(S, I+1, 1000)); - - if (Params.Depth <> -1) then - Depth := Params.Depth - else - Depth := Ini.Depth; - - Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); - //SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); - - if (Ini.FullScreen = 0) and (Not Params.FullScreen) then - begin - Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed'); - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE) - end - else - begin - Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen'); - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN ); - SDL_ShowCursor(0); - end; - - if (screen = nil) then - begin - Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); - exit; - end; - - LoadOpenGLExtensions(); - - // define virtual (Render) and real (Screen) screen size - RenderW := 800; - RenderH := 600; - ScreenW := W; - ScreenH := H; - - // clear screen once window is being shown - // Note: SwapBuffers uses RenderW/H, so they must be defined before - glClearColor(1, 1, 1, 1); - glClear(GL_COLOR_BUFFER_BIT); - SwapBuffers; -end; - -procedure LoadLoadingScreen; -begin - ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; - - Display.CurrentScreen := @ScreenLoading; - - swapbuffers; - - ScreenLoading.Draw; - Display.Draw; - - SwapBuffers; -end; - -procedure LoadScreens; -begin -{ ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; - Display.CurrentScreen := @ScreenLoading; - ScreenLoading.Draw; - Display.Draw; - SwapBuffers; -} - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); -{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} - ScreenMain := TScreenMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); - ScreenName := TScreenName.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); - ScreenLevel := TScreenLevel.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); - ScreenSong := TScreenSong.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); - ScreenSing := TScreenSing.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); - ScreenScore := TScreenScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); - ScreenTop5 := TScreenTop5.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); - ScreenOptions := TScreenOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); - ScreenOptionsGame := TScreenOptionsGame.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); - ScreenOptionsGraphics := TScreenOptionsGraphics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); - ScreenOptionsSound := TScreenOptionsSound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); - ScreenOptionsLyrics := TScreenOptionsLyrics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); - ScreenOptionsThemes := TScreenOptionsThemes.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); - ScreenOptionsRecord := TScreenOptionsRecord.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); - ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); - ScreenEditSub := TScreenEditSub.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); - ScreenEdit := TScreenEdit.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); - ScreenEditConvert := TScreenEditConvert.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); -// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); -// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); - ScreenOpen := TScreenOpen.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); - ScreenSingModi := TScreenSingModi.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); - ScreenSongJumpto := TScreenSongJumpto.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); - ScreenPopupCheck := TScreenPopupCheck.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); - ScreenPopupError := TScreenPopupError.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); - ScreenPartyNewRound := TScreenPartyNewRound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); - ScreenPartyScore := TScreenPartyScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); - ScreenPartyWin := TScreenPartyWin.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); - ScreenPartyOptions := TScreenPartyOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); - ScreenPartyPlayer := TScreenPartyPlayer.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); - ScreenStatMain := TScreenStatMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); - ScreenStatDetail := TScreenStatDetail.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); - ScreenCredits := TScreenCredits.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); - -end; - -function LoadingThreadFunction: integer; -begin - LoadScreens; - Result:= 1; -end; - -procedure UnLoadScreens; -begin - freeandnil( ScreenMain ); - freeandnil( ScreenName ); - freeandnil( ScreenLevel); - freeandnil( ScreenSong ); - freeandnil( ScreenSongMenu ); - freeandnil( ScreenSing ); - freeandnil( ScreenScore); - freeandnil( ScreenTop5 ); - freeandnil( ScreenOptions ); - freeandnil( ScreenOptionsGame ); - freeandnil( ScreenOptionsGraphics ); - freeandnil( ScreenOptionsSound ); - freeandnil( ScreenOptionsLyrics ); -// freeandnil( ScreenOptionsThemes ); - freeandnil( ScreenOptionsRecord ); - freeandnil( ScreenOptionsAdvanced ); - freeandnil( ScreenEditSub ); - freeandnil( ScreenEdit ); - freeandnil( ScreenEditConvert ); - freeandnil( ScreenOpen ); - freeandnil( ScreenSingModi ); - freeandnil( ScreenSongMenu ); - freeandnil( ScreenSongJumpto); - freeandnil( ScreenPopupCheck ); - freeandnil( ScreenPopupError ); - freeandnil( ScreenPartyNewRound ); - freeandnil( ScreenPartyScore ); - freeandnil( ScreenPartyWin ); - freeandnil( ScreenPartyOptions ); - freeandnil( ScreenPartyPlayer ); - freeandnil( ScreenStatMain ); - freeandnil( ScreenStatDetail ); -end; - -end. diff --git a/src/Classes/UGraphicClasses.pas b/src/Classes/UGraphicClasses.pas deleted file mode 100644 index b7174991..00000000 --- a/src/Classes/UGraphicClasses.pas +++ /dev/null @@ -1,673 +0,0 @@ -// notes: -unit UGraphicClasses; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses UTexture,SDL; - -const DelayBetweenFrames : Cardinal = 60; -type - - TParticleType=(GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle, ColoredStar, Flare); - - TColour3f = Record - r, g, b: Real; - end; - - TParticle = Class - X, Y : Real; //Position - Screen : Integer; - W, H : Cardinal; //dimensions of particle - Col : array of TColour3f; // Colour(s) of particle - Scale : array of Real; // Scaling factors of particle layers - Frame : Byte; //act. Frame - Tex : Cardinal; //Tex num from Textur Manager - Live : Byte; //How many Cycles before Kill - RecIndex : Integer; //To which rectangle this particle belongs (only GoldenNote) - StarType : TParticleType; // GoldenNote | PerfectNote | NoteHitTwinkle | PerfectLineTwinkle - Alpha : Real; // used for fading... - mX, mY : Real; // movement-vector for PerfectLineTwinkle - SizeMod : Real; // experimental size modifier - SurviveSentenceChange : Boolean; - - Constructor Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); - Destructor Destroy(); override; - procedure Draw; - procedure LiveOn; - end; - - RectanglePositions = Record - xTop, yTop, xBottom, yBottom : Real; - TotalStarCount : Integer; - CurrentStarCount : Integer; - Screen : Integer; - end; - - PerfectNotePositions = Record - xPos, yPos : Real; - Screen : Integer; - end; - - TEffectManager = Class - Particle : array of TParticle; - LastTime : Cardinal; - RecArray : Array of RectanglePositions; - TwinkleArray : Array[0..5] of Real; // store x-position of last twinkle for every player - PerfNoteArray : Array of PerfectNotePositions; - - FlareTex: TTexture; - - constructor Create; - destructor Destroy; override; - procedure Draw; - function Spawn(X, Y: Real; - Screen: Integer; - Live: Byte; - StartFrame: Integer; - RecArrayIndex: Integer; // this is only used with GoldenNotes - StarType: TParticleType; - Player: Cardinal // for PerfectLineTwinkle - ): Cardinal; - procedure SpawnRec(); - procedure Kill(index: Cardinal); - procedure KillAll(); - procedure SentenceChange(); - procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); - procedure SavePerfectNotePos(Xtop, Ytop: Real); - procedure GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer); - procedure SpawnPerfectLineTwinkle(); - end; - -var GoldenRec : TEffectManager; - -implementation - -uses sysutils, - gl, - UIni, - UMain, - UThemes, - USkins, - UGraphic, - UDrawTexture, - UCommon, - math; - -//TParticle -Constructor TParticle.Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); -begin - inherited Create; - // in this constructor we set all initial values for our particle - X := cX; - Y := cY; - Screen := cScreen; - Live := cLive; - Frame:= cFrame; - RecIndex := cRecArrayIndex; - StarType := cStarType; - Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out - SetLength(Scale,1); - Scale[0] := 1; - SurviveSentenceChange := False; - SizeMod := 1; - case cStarType of - GoldenNote: - begin - Tex := Tex_Note_Star.TexNum; - W := 20; - H := 20; - SetLength(Scale,4); - Scale[1]:=0.8; - Scale[2]:=0.4; - Scale[3]:=0.3; - SetLength(Col,4); - Col[0].r := 1; - Col[0].g := 0.7; - Col[0].b := 0.1; - - Col[1].r := 1; - Col[1].g := 1; - Col[1].b := 0.4; - - Col[2].r := 1; - Col[2].g := 1; - Col[2].b := 1; - - Col[3].r := 1; - Col[3].g := 1; - Col[3].b := 1; - end; - PerfectNote: - begin - Tex := Tex_Note_Perfect_Star.TexNum; - W := 30; - H := 30; - SetLength(Col,1); - Col[0].r := 1; - Col[0].g := 1; - Col[0].b := 0.95; - end; - NoteHitTwinkle: - begin - Tex := Tex_Note_Star.TexNum; - Alpha := (Live/16); // linear fade-out - W := 15; - H := 15; - Setlength(Col,1); - Col[0].r := 1; - Col[0].g := 1; - Col[0].b := RandomRange(10*Live,100)/90; //0.9; - end; - PerfectLineTwinkle: - begin - Tex := Tex_Note_Star.TexNum; - W := RandomRange(10,20); - H := W; - SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - SurviveSentenceChange:=True; - // assign colours according to player given - SetLength(Scale,3); - Scale[1]:=0.3; - Scale[2]:=0.2; - SetLength(Col,3); - case Player of - 0: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light'); - 1: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P2Light'); - 2: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P3Light'); - 3: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P4Light'); - 4: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P5Light'); - 5: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P6Light'); - else LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light'); - end; - Col[1].r := 1; - Col[1].g := 1; - Col[1].b := 0.4; - Col[2].r:=Col[0].r+0.5; - Col[2].g:=Col[0].g+0.5; - Col[2].b:=Col[0].b+0.5; - mX := RandomRange(-5,5); - mY := RandomRange(-5,5); - end; - ColoredStar: - begin - Tex := Tex_Note_Star.TexNum; - W := RandomRange(10,20); - H := W; - SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - SurviveSentenceChange:=True; - // assign colours according to player given - SetLength(Scale,1); - SetLength(Col,1); - Col[0].b := (Player and $ff)/255; - Col[0].g := ((Player shr 8) and $ff)/255; - Col[0].r := ((Player shr 16) and $ff)/255; - mX := 0; - mY := 0; - end; - Flare: - begin - Tex := Tex_Note_Star.TexNum; - W := 7; - H := 7; - SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - mX := RandomRange(-5,5); - mY := RandomRange(-5,5); - SetLength(Scale,4); - Scale[1]:=0.8; - Scale[2]:=0.4; - Scale[3]:=0.3; - SetLength(Col,4); - Col[0].r := 1; - Col[0].g := 0.7; - Col[0].b := 0.1; - - Col[1].r := 1; - Col[1].g := 1; - Col[1].b := 0.4; - - Col[2].r := 1; - Col[2].g := 1; - Col[2].b := 1; - - Col[3].r := 1; - Col[3].g := 1; - Col[3].b := 1; - - end; - else // just some random default values - begin - Tex := Tex_Note_Star.TexNum; - Alpha := 1; - W := 20; - H := 20; - SetLength(Col,1); - Col[0].r := 1; - Col[0].g := 1; - Col[0].b := 1; - end; - end; -end; - -Destructor TParticle.Destroy(); -begin - SetLength(Scale,0); - SetLength(Col,0); - inherited; -end; - -procedure TParticle.LiveOn; -begin - //Live = 0 => Live forever ?? but if this is 0 they would be killed in the Manager at Draw - if (Live > 0) then - Dec(Live); - - // animate frames - Frame := ( Frame + 1 ) mod 16; - - // make our particles do funny stuff (besides being animated) - // changes of any particle-values throughout its life are done here - case StarType of - GoldenNote: - begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out - end; - PerfectNote: - begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out - end; - NoteHitTwinkle: - begin - Alpha := (Live/10); // linear fade-out - end; - PerfectLineTwinkle: - begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out - SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - // move around - X := X + mX; - Y := Y + mY; - end; - ColoredStar: - begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out - end; - Flare: - begin - Alpha := (-cos((Frame+1)/16*1.7*pi+0.3*pi)+1); // neat fade-in-and-out - SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - // move around - X := X + mX; - Y := Y + mY; - mY:=mY+1.8; -// mX:=mX/2; - end; - end; -end; - -procedure TParticle.Draw; -var L: Cardinal; -begin - if ScreenAct = Screen then - // this draws (multiple) texture(s) of our particle - for L:=0 to High(Col) do - begin - glColor4f(Col[L].r, Col[L].g, Col[L].b, Alpha); - - glBindTexture(GL_TEXTURE_2D, Tex); - glEnable(GL_TEXTURE_2D); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glEnable(GL_BLEND); - - begin - glBegin(GL_QUADS); - glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); - glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); - glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); - glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); - glEnd; - end; - end; - glcolor4f(1,1,1,1); -end; -// end of TParticle - -// TEffectManager - -constructor TEffectManager.Create; -var c: Cardinal; -begin - inherited; - LastTime := SDL_GetTicks(); - for c:=0 to 5 do - begin - TwinkleArray[c] := 0; - end; -end; - -destructor TEffectManager.Destroy; -begin - Killall; - inherited; -end; - - -procedure TEffectManager.Draw; -var - I: Integer; - CurrentTime: Cardinal; -//const -// DelayBetweenFrames : Cardinal = 100; -begin - - CurrentTime := SDL_GetTicks(); - //Manage particle life - if (CurrentTime - LastTime) > DelayBetweenFrames then - begin - LastTime := CurrentTime; - for I := 0 to high(Particle) do - Particle[I].LiveOn; - end; - - I := 0; - //Kill dead particles - while (I <= High(Particle)) do - begin - if (Particle[I].Live <= 0) then - begin - kill(I); - end - else - begin - inc(I); - end; - end; - - //Draw - for I := 0 to high(Particle) do - begin - Particle[I].Draw; - end; -end; - -// this method creates just one particle -function TEffectManager.Spawn(X, Y: Real; Screen: Integer; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : TParticleType; Player: Cardinal): Cardinal; -begin - Result := Length(Particle); - SetLength(Particle, (Result + 1)); - Particle[Result] := TParticle.Create(X, Y, Screen, Live, StartFrame, RecArrayIndex, StarType, Player); -end; - -// manage Sparkling of GoldenNote Bars -procedure TEffectManager.SpawnRec(); -Var - Xkatze, Ykatze : Real; - RandomFrame : Integer; - P : Integer; // P as seen on TV as Positionman -begin -//Spawn a random amount of stars within the given coordinates -//RandomRange(0,14) <- this one starts at a random frame, 16 is our last frame - would be senseless to start a particle with 16, cause it would be dead at the next frame -for P:= 0 to high(RecArray) do - begin - while (RecArray[P].TotalStarCount > RecArray[P].CurrentStarCount) do - begin - Xkatze := RandomRange(Ceil(RecArray[P].xTop), Ceil(RecArray[P].xBottom)); - Ykatze := RandomRange(Ceil(RecArray[P].yTop), Ceil(RecArray[P].yBottom)); - RandomFrame := RandomRange(0,14); - // Spawn a GoldenNote Particle - Spawn(Xkatze, Ykatze, RecArray[P].Screen, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0); - inc(RecArray[P].CurrentStarCount); - end; - end; - draw; -end; - -// kill one particle (with given index in our particle array) -procedure TEffectManager.Kill(Index: Cardinal); -var - LastParticleIndex : Integer; -begin -// delete particle indexed by Index, -// overwrite it's place in our particle-array with the particle stored at the last array index, -// shorten array - LastParticleIndex := high(Particle); - if not(LastParticleIndex = -1) then // is there still a particle to delete? - begin - if not(Particle[Index].RecIndex = -1) then // if it is a GoldenNote particle... - dec(RecArray[Particle[Index].RecIndex].CurrentStarCount); // take care of its associated GoldenRec - // now get rid of that particle - Particle[Index].Destroy; - Particle[Index] := Particle[LastParticleIndex]; - SetLength(Particle, LastParticleIndex); - end; -end; - -// clean up all particles and management structures -procedure TEffectManager.KillAll(); -var c: Cardinal; -begin -//It's the kill all kennies rotuine - while Length(Particle) > 0 do // kill all existing particles - Kill(0); - SetLength(RecArray,0); // remove GoldenRec positions - SetLength(PerfNoteArray,0); // remove PerfectNote positions - for c:=0 to 5 do - begin - TwinkleArray[c] := 0; // reset GoldenNoteHit memory - end; -end; - -procedure TEffectManager.SentenceChange(); -var c: Cardinal; -begin - c:=0; - while c <= High(Particle) do - begin - if Particle[c].SurviveSentenceChange then - inc(c) - else - Kill(c); - end; - SetLength(RecArray,0); // remove GoldenRec positions - SetLength(PerfNoteArray,0); // remove PerfectNote positions - for c:=0 to 5 do - begin - TwinkleArray[c] := 0; // reset GoldenNoteHit memory - end; -end; - -procedure TeffectManager.GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer); -//Twinkle stars while golden note hit -// this is called from UDraw.pas, SingDrawPlayerCzesc -var - C, P, XKatze, YKatze, LKatze: Integer; - H: Real; -begin - // make sure we spawn only one time at one position - if (TwinkleArray[Player] < Right) then - For P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle? - begin - H := (Top+Bottom)/2; // helper... - with RecArray[P] do - if ((xBottom >= Right) and (xTop <= Right) and - (yTop <= H) and (yBottom >= H)) - and (Screen = ScreenAct) then - begin - TwinkleArray[Player] := Right; // remember twinkle position for this player - for C := 1 to 10 do - begin - Ykatze := RandomRange(ceil(Top) , ceil(Bottom)); - XKatze := RandomRange(-7,3); - LKatze := RandomRange(7,13); - Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); - end; - for C := 1 to 3 do - begin - Ykatze := RandomRange(ceil(Top)-6 , ceil(Top)); - XKatze := RandomRange(-5,1); - LKatze := RandomRange(4,7); - Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); - end; - for C := 1 to 3 do - begin - Ykatze := RandomRange(ceil(Bottom), ceil(Bottom)+6); - XKatze := RandomRange(-5,1); - LKatze := RandomRange(4,7); - Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); - end; - for C := 1 to 3 do - begin - Ykatze := RandomRange(ceil(Top)-10 , ceil(Top)-6); - XKatze := RandomRange(-5,1); - LKatze := RandomRange(1,4); - Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); - end; - for C := 1 to 3 do - begin - Ykatze := RandomRange(ceil(Bottom)+6 , ceil(Bottom)+10); - XKatze := RandomRange(-5,1); - LKatze := RandomRange(1,4); - Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); - end; - - exit; // found a matching GoldenRec, did spawning stuff... done - end; - end; -end; - -procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); -var - P : Integer; // P like used in Positions - NewIndex : Integer; -begin - For P := 0 to high(RecArray) do // Do we already have that "new" position? - begin - if (ceil(RecArray[P].xTop) = ceil(Xtop)) and - (ceil(RecArray[P].yTop) = ceil(Ytop)) and - (ScreenAct = RecArray[p].Screen) then - exit; // it's already in the array, so we don't have to create a new one - end; - - // we got a new position, add the new positions to our array - NewIndex := Length(RecArray); - SetLength(RecArray, NewIndex + 1); - RecArray[NewIndex].xTop := Xtop; - RecArray[NewIndex].yTop := Ytop; - RecArray[NewIndex].xBottom := Xbottom; - RecArray[NewIndex].yBottom := Ybottom; - RecArray[NewIndex].TotalStarCount := ceil(Xbottom - Xtop) div 12 + 3; - RecArray[NewIndex].CurrentStarCount := 0; - RecArray[NewIndex].Screen := ScreenAct; -end; - -procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: Real); -var - P : Integer; // P like used in Positions - NewIndex : Integer; - RandomFrame : Integer; - Xkatze, Ykatze : Integer; -begin - For P := 0 to high(PerfNoteArray) do // Do we already have that "new" position? - begin - with PerfNoteArray[P] do - if (ceil(xPos) = ceil(Xtop)) and (ceil(yPos) = ceil(Ytop)) and - (Screen = ScreenAct) then - exit; // it's already in the array, so we don't have to create a new one - end; //for - - // we got a new position, add the new positions to our array - NewIndex := Length(PerfNoteArray); - SetLength(PerfNoteArray, NewIndex + 1); - PerfNoteArray[NewIndex].xPos := Xtop; - PerfNoteArray[NewIndex].yPos := Ytop; - PerfNoteArray[NewIndex].Screen := ScreenAct; - - for P:= 0 to 2 do - begin - Xkatze := RandomRange(ceil(Xtop) - 5 , ceil(Xtop) + 10); - Ykatze := RandomRange(ceil(Ytop) - 5 , ceil(Ytop) + 10); - RandomFrame := RandomRange(0,14); - Spawn(Xkatze, Ykatze, ScreenAct, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0); - end; //for - -end; - -procedure TEffectManager.SpawnPerfectLineTwinkle(); -var - P,I,Life: Cardinal; - Left, Right, Top, Bottom: Cardinal; - cScreen: Integer; -begin -// calculation of coordinates done with hardcoded values like in UDraw.pas -// might need to be adjusted if drawing of SingScreen is modified -// coordinates may still be a bit weird and need adjustment - if Ini.SingWindow = 0 then begin - Left := 130; - end else begin - Left := 30; - end; - Right := 770; - // spawn effect for every player with a perfect line - for P:=0 to PlayersPlay-1 do - if Player[P].LastSentencePerfect then - begin - // calculate area where notes of this player are drawn - case PlayersPlay of - 1: begin - Bottom:=Skin_P2_NotesB+10; - Top:=Bottom-105; - cScreen:=1; - end; - 2,4: begin - case P of - 0,2: begin - Bottom:=Skin_P1_NotesB+10; - Top:=Bottom-105; - end; - else begin - Bottom:=Skin_P2_NotesB+10; - Top:=Bottom-105; - end; - end; - case P of - 0,1: cScreen:=1; - else cScreen:=2; - end; - end; - 3,6: begin - case P of - 0,3: begin - Top:=130; - Bottom:=Top+85; - end; - 1,4: begin - Top:=255; - Bottom:=Top+85; - end; - 2,5: begin - Top:=380; - Bottom:=Top+85; - end; - end; - case P of - 0,1,2: cScreen:=1; - else cScreen:=2; - end; - end; - end; - // spawn Sparkling Stars inside calculated coordinates - for I:= 0 to 80 do - begin - Life:=RandomRange(8,16); - Spawn(RandomRange(Left,Right), RandomRange(Top,Bottom), cScreen, Life, 16-Life, -1, PerfectLineTwinkle, P); - end; - end; -end; - -end. - diff --git a/src/Classes/UHooks.pas b/src/Classes/UHooks.pas deleted file mode 100644 index f0ba3276..00000000 --- a/src/Classes/UHooks.pas +++ /dev/null @@ -1,434 +0,0 @@ -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: TwParam; lParam: TlParam): Integer; - Function EventExists (const EventName: PChar): Integer; - - Procedure DelbyOwner(const Owner: Integer); - end; - -function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; - -var - HookManager: THookManager; - -implementation -uses - ULog, - UCore; - -//------------ -// Create - Creates Class and Set Standard Values -//------------ -constructor THookManager.Create(const SpacetoAllocate: Word); -var I: Integer; -begin - inherited Create(); - - //Get the Space and "Zero" it - SetLength (Events, SpacetoAllocate); - For I := 0 to SpacetoAllocate-1 do - Events[I].Name[1] := chr(0); - - SpaceinEvents := SpacetoAllocate; - - {$IFDEF DEBUG} - debugWriteLn('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} - debugWriteLn('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} - debugWriteLn('HookManager: Add Event succesful: ''' + EventName + ''); - {$ENDIF} - end - {$IFDEF DEBUG} - else - debugWriteLn('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} - debugWriteLn('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 - debugWriteLn('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} - debugWriteLn('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} - debugWriteLn('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: TwParam; lParam: TlParam): 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} - debugWriteLn('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: TwParam; lParam: TlParam): integer; stdcall; -begin - Result := 0; //Don't break the chain - Core.ShowMessage(CORE_SM_INFO, PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam))))); -end; - -end. diff --git a/src/Classes/UImage.pas b/src/Classes/UImage.pas deleted file mode 100644 index d33c0d38..00000000 --- a/src/Classes/UImage.pas +++ /dev/null @@ -1,993 +0,0 @@ -unit UImage; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SDL; - -{$DEFINE HavePNG} -{$DEFINE HaveBMP} -{$DEFINE HaveJPG} - -const - PixelFmt_RGBA: TSDL_Pixelformat = ( - palette: nil; - BitsPerPixel: 32; - BytesPerPixel: 4; - Rloss: 0; - Gloss: 0; - Bloss: 0; - Aloss: 0; - Rshift: 0; - Gshift: 8; - Bshift: 16; - Ashift: 24; - Rmask: $000000ff; - Gmask: $0000ff00; - Bmask: $00ff0000; - Amask: $ff000000; - ColorKey: 0; - Alpha: 255 - ); - - PixelFmt_RGB: TSDL_Pixelformat = ( - palette: nil; - BitsPerPixel: 24; - BytesPerPixel: 3; - Rloss: 0; - Gloss: 0; - Bloss: 0; - Aloss: 0; - Rshift: 0; - Gshift: 8; - Bshift: 16; - Ashift: 0; - Rmask: $000000ff; - Gmask: $0000ff00; - Bmask: $00ff0000; - Amask: $00000000; - ColorKey: 0; - Alpha: 255 - ); - - PixelFmt_BGRA: TSDL_Pixelformat = ( - palette: nil; - BitsPerPixel: 32; - BytesPerPixel: 4; - Rloss: 0; - Gloss: 0; - Bloss: 0; - Aloss: 0; - Rshift: 16; - Gshift: 8; - Bshift: 0; - Ashift: 24; - Rmask: $00ff0000; - Gmask: $0000ff00; - Bmask: $000000ff; - Amask: $ff000000; - ColorKey: 0; - Alpha: 255 - ); - - PixelFmt_BGR: TSDL_Pixelformat = ( - palette: nil; - BitsPerPixel: 24; - BytesPerPixel: 3; - Rloss: 0; - Gloss: 0; - Bloss: 0; - Aloss: 0; - Rshift: 16; - Gshift: 8; - Bshift: 0; - Ashift: 0; - Rmask: $00ff0000; - Gmask: $0000ff00; - Bmask: $000000ff; - Amask: $00000000; - ColorKey: 0; - Alpha: 255 - ); - -type - TImagePixelFmt = ( - ipfRGBA, ipfRGB, ipfBGRA, ipfBGR - ); - -(******************************************************* - * Image saving - *******************************************************) - -{$IFDEF HavePNG} -function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean; -{$ENDIF} -{$IFDEF HaveBMP} -function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean; -{$ENDIF} -{$IFDEF HaveJPG} -function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean; -{$ENDIF} - -(******************************************************* - * Image loading - *******************************************************) - -function LoadImage(const Identifier: string): PSDL_Surface; - -(******************************************************* - * Image manipulation - *******************************************************) - -function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; -procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); -procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); -procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); - - -implementation - -uses - SysUtils, - Classes, - Math, - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF} - {$IFDEF HaveJPG} - {$IFDEF Delphi} - Graphics, - jpeg, - {$ELSE} - jpeglib, - jerror, - jcparam, - jdatadst, jcapimin, jcapistd, - {$ENDIF} - {$ENDIF} - {$IFDEF HavePNG} - png, - {$ENDIF} - zlib, - sdl_image, - sdlutils, - UCommon, - ULog; - - -function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean; -begin - Result := (pixelFmt.BitsPerPixel = 24) and - (pixelFmt.RMask = $0000FF) and - (pixelFmt.GMask = $00FF00) and - (pixelFmt.BMask = $FF0000); -end; - -function IsRGBASurface(pixelFmt: PSDL_PixelFormat): boolean; -begin - Result := (pixelFmt.BitsPerPixel = 32) and - (pixelFmt.RMask = $000000FF) and - (pixelFmt.GMask = $0000FF00) and - (pixelFmt.BMask = $00FF0000) and - (pixelFmt.AMask = $FF000000); -end; - -function IsBGRSurface(pixelFmt: PSDL_PixelFormat): boolean; -begin - Result := (pixelFmt.BitsPerPixel = 24) and - (pixelFmt.BMask = $0000FF) and - (pixelFmt.GMask = $00FF00) and - (pixelFmt.RMask = $FF0000); -end; - -function IsBGRASurface(pixelFmt: PSDL_PixelFormat): boolean; -begin - Result := (pixelFmt.BitsPerPixel = 32) and - (pixelFmt.BMask = $000000FF) and - (pixelFmt.GMask = $0000FF00) and - (pixelFmt.RMask = $00FF0000) and - (pixelFmt.AMask = $FF000000); -end; - -// Converts alpha-formats to BGRA, non-alpha to BGR, and leaves BGR(A) as is -// sets converted to true if the surface needed to be converted -function ConvertToBGR_BGRASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface; -var - pixelFmt: PSDL_PixelFormat; -begin - pixelFmt := Surface.format; - if (IsBGRSurface(pixelFmt) or IsBGRASurface(pixelFmt)) then - begin - Converted := false; - Result := Surface; - end - else - begin - // invalid format -> needs conversion - if (pixelFmt.AMask <> 0) then - Result := SDL_ConvertSurface(Surface, @PixelFmt_BGRA, SDL_SWSURFACE) - else - Result := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE); - Converted := true; - end; -end; - -// Converts alpha-formats to RGBA, non-alpha to RGB, and leaves RGB(A) as is -// sets converted to true if the surface needed to be converted -function ConvertToRGB_RGBASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface; -var - pixelFmt: PSDL_PixelFormat; -begin - pixelFmt := Surface.format; - if (IsRGBSurface(pixelFmt) or IsRGBASurface(pixelFmt)) then - begin - Converted := false; - Result := Surface; - end - else - begin - // invalid format -> needs conversion - if (pixelFmt.AMask <> 0) then - Result := SDL_ConvertSurface(Surface, @PixelFmt_RGBA, SDL_SWSURFACE) - else - Result := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE); - Converted := true; - end; -end; - - -(******************************************************* - * Image saving - *******************************************************) - -(*************************** - * PNG section - *****************************) - -{$IFDEF HavePNG} - -// delphi does not support setjmp()/longjmp() -> define our own error-handler -procedure user_error_fn(png_ptr: png_structp; error_msg: png_const_charp); cdecl; -begin - raise Exception.Create(error_msg); -end; - -procedure user_read_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl; -var - inFile: TFileStream; -begin - inFile := TFileStream(png_get_io_ptr(png_ptr)); - inFile.Read(data^, length); -end; - -procedure user_write_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl; -var - outFile: TFileStream; -begin - outFile := TFileStream(png_get_io_ptr(png_ptr)); - outFile.Write(data^, length); -end; - -procedure user_flush_data(png_ptr: png_structp); cdecl; -//var -// outFile: TFileStream; -begin - // binary files are flushed automatically, Flush() works with Text-files only - //outFile := TFileStream(png_get_io_ptr(png_ptr)); - //outFile.Flush(); -end; - -procedure DateTimeToPngTime(time: TDateTime; var pngTime: png_time); -var - year, month, day: word; - hour, minute, second, msecond: word; -begin - DecodeDate(time, year, month, day); - pngTime.year := year; - pngTime.month := month; - pngTime.day := day; - DecodeTime(time, hour, minute, second, msecond); - pngTime.hour := hour; - pngTime.minute := minute; - pngTime.second := second; -end; - -(* - * ImageData must be in RGB-format - *) -function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean; -var - png_ptr: png_structp; - info_ptr: png_infop; - pngFile: TFileStream; - row: integer; - rowData: array of png_bytep; -// rowStride: integer; - converted: boolean; - colorType: integer; -// time: png_time; -begin - Result := false; - - // open file for writing - try - pngFile := TFileStream.Create(FileName, fmCreate); - except - Log.LogError('Could not open file: "' + FileName + '"', 'WritePngImage'); - Exit; - end; - - // only 24bit (RGB) or 32bit (RGBA) data is supported, so convert to it - Surface := ConvertToRGB_RGBASurface(Surface, converted); - - png_ptr := nil; - - try - // initialize png (and enable a user-defined error-handler that throws an exception on error) - png_ptr := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, @user_error_fn, nil); - // the error-handler is called if png_create_write_struct() fails, so png_ptr should always be <> nil - if (png_ptr = nil) then - begin - Log.LogError('png_create_write_struct() failed', 'WritePngImage'); - if (converted) then - SDL_FreeSurface(Surface); - Exit; - end; - - info_ptr := png_create_info_struct(png_ptr); - - if (Surface^.format^.BitsPerPixel = 24) then - colorType := PNG_COLOR_TYPE_RGB - else - colorType := PNG_COLOR_TYPE_RGBA; - - // define write IO-functions (POSIX-style FILE-pointers are not available in Delphi) - png_set_write_fn(png_ptr, pngFile, @user_write_data, @user_flush_data); - png_set_IHDR( - png_ptr, info_ptr, - Surface.w, Surface.h, - 8, - colorType, - PNG_INTERLACE_NONE, - PNG_COMPRESSION_TYPE_DEFAULT, - PNG_FILTER_TYPE_DEFAULT - ); - - // TODO: do we need the modification time? - //DateTimeToPngTime(Now, time); - //png_set_tIME(png_ptr, info_ptr, @time); - - if (SDL_MUSTLOCK(Surface)) then - SDL_LockSurface(Surface); - - // setup data - SetLength(rowData, Surface.h); - for row := 0 to Surface.h-1 do - begin - // set rowData-elements to beginning of each image row - // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned) - rowData[row] := @PChar(Surface.pixels)[(Surface.h-row-1) * Surface.pitch]; - end; - - if (SDL_MUSTLOCK(Surface)) then - SDL_UnlockSurface(Surface); - - png_write_info(png_ptr, info_ptr); - png_write_image(png_ptr, png_bytepp(rowData)); - png_write_end(png_ptr, nil); - - Result := true; - except on E: Exception do - Log.LogError(E.message, 'WritePngImage'); - end; - - // free row-data - SetLength(rowData, 0); - - // free png-resources - if (png_ptr <> nil) then - png_destroy_write_struct(@png_ptr, nil); - - if (converted) then - SDL_FreeSurface(Surface); - - // close file - pngFile.Free; -end; - -{$ENDIF} - -(*************************** - * BMP section - *****************************) - -{$IFDEF HaveBMP} - -{$IFNDEF MSWINDOWS} -const - (* constants for the biCompression field *) - BI_RGB = 0; - BI_RLE8 = 1; - BI_RLE4 = 2; - BI_BITFIELDS = 3; - BI_JPEG = 4; - BI_PNG = 5; - -type - BITMAPINFOHEADER = record - biSize: longword; - biWidth: longint; - biHeight: longint; - biPlanes: word; - biBitCount: word; - biCompression: longword; - biSizeImage: longword; - biXPelsPerMeter: longint; - biYPelsPerMeter: longint; - biClrUsed: longword; - biClrImportant: longword; - end; - LPBITMAPINFOHEADER = ^BITMAPINFOHEADER; - TBITMAPINFOHEADER = BITMAPINFOHEADER; - PBITMAPINFOHEADER = ^BITMAPINFOHEADER; - - RGBTRIPLE = record - rgbtBlue: byte; - rgbtGreen: byte; - rgbtRed: byte; - end; - tagRGBTRIPLE = RGBTRIPLE; - TRGBTRIPLE = RGBTRIPLE; - PRGBTRIPLE = ^RGBTRIPLE; - - RGBQUAD = record - rgbBlue: byte; - rgbGreen: byte; - rgbRed: byte; - rgbReserved: byte; - end; - tagRGBQUAD = RGBQUAD; - TRGBQUAD = RGBQUAD; - PRGBQUAD = ^RGBQUAD; - - BITMAPINFO = record - bmiHeader: BITMAPINFOHEADER; - bmiColors: array[0..0] of RGBQUAD; - end; - LPBITMAPINFO = ^BITMAPINFO; - PBITMAPINFO = ^BITMAPINFO; - TBITMAPINFO = BITMAPINFO; - - {$PACKRECORDS 2} - BITMAPFILEHEADER = record - bfType: word; - bfSize: longword; - bfReserved1: word; - bfReserved2: word; - bfOffBits: longword; - end; - {$PACKRECORDS DEFAULT} -{$ENDIF} - -(* - * ImageData must be in BGR-format - *) -function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean; -var - bmpFile: TFileStream; - FileInfo: BITMAPINFOHEADER; - FileHeader: BITMAPFILEHEADER; - Converted: boolean; - Row: integer; - RowSize: integer; -begin - Result := false; - - // open file for writing - try - bmpFile := TFileStream.Create(FileName, fmCreate); - except - Log.LogError('Could not open file: "' + FileName + '"', 'WriteBMPImage'); - Exit; - end; - - // only 24bit (BGR) or 32bit (BGRA) data is supported, so convert to it - Surface := ConvertToBGR_BGRASurface(Surface, Converted); - - // aligned (4-byte) row-size in bytes - RowSize := ((Surface.w * Surface.format.BytesPerPixel + 3) div 4) * 4; - - // initialize bitmap info - FillChar(FileInfo, SizeOf(BITMAPINFOHEADER), 0); - with FileInfo do - begin - biSize := SizeOf(BITMAPINFOHEADER); - biWidth := Surface.w; - biHeight := Surface.h; - biPlanes := 1; - biBitCount := Surface^.format^.BitsPerPixel; - biCompression := BI_RGB; - biSizeImage := RowSize * Surface.h; - end; - - // initialize header-data - FillChar(FileHeader, SizeOf(BITMAPFILEHEADER), 0); - with FileHeader do - begin - bfType := $4D42; // = 'BM' - bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER); - bfSize := bfOffBits + FileInfo.biSizeImage; - end; - - // and move the whole stuff into the file ;-) - try - // write headers - bmpFile.Write(FileHeader, SizeOf(BITMAPFILEHEADER)); - bmpFile.Write(FileInfo, SizeOf(BITMAPINFOHEADER)); - - // write image-data - - if (SDL_MUSTLOCK(Surface)) then - SDL_LockSurface(Surface); - - // BMP needs 4-byte alignment - if (Surface.pitch mod 4 = 0) then - begin - // aligned correctly -> write whole image at once - bmpFile.Write(Surface.pixels^, FileInfo.biSizeImage); - end - else - begin - // misaligned -> write each line separately - // Note: for the last line unassigned memory (> last Surface.pixels element) - // will be copied to the padding area (last bytes of a row), - // but we do not care because the content of padding data is ignored anyhow. - for Row := 0 to Surface.h do - bmpFile.Write(PChar(Surface.pixels)[Row * Surface.pitch], RowSize); - end; - - if (SDL_MUSTLOCK(Surface)) then - SDL_UnlockSurface(Surface); - - Result := true; - finally - Log.LogError('Could not write file: "' + FileName + '"', 'WriteBMPImage'); - end; - - if (Converted) then - SDL_FreeSurface(Surface); - - // close file - bmpFile.Free; -end; - -{$ENDIF} - -(*************************** - * JPG section - *****************************) - -{$IFDEF HaveJPG} - -function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean; -var - {$IFDEF Delphi} - Bitmap: TBitmap; - BitmapInfo: TBitmapInfo; - Jpeg: TJpegImage; - row: integer; - {$ELSE} - cinfo: jpeg_compress_struct; - jerr : jpeg_error_mgr; - jpgFile: TFileStream; - rowPtr: array[0..0] of JSAMPROW; - {$ENDIF} - converted: boolean; -begin - Result := false; - - {$IFDEF Delphi} - // only 24bit (BGR) data is supported, so convert to it - if (IsBGRSurface(Surface.format)) then - converted := false - else - begin - Surface := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE); - converted := true; - end; - - // create and setup bitmap - Bitmap := TBitmap.Create; - Bitmap.PixelFormat := pf24bit; - Bitmap.Width := Surface.w; - Bitmap.Height := Surface.h; - - // setup bitmap info on source image (Surface parameter) - ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo)); - with BitmapInfo.bmiHeader do - begin - biSize := SizeOf(BITMAPINFOHEADER); - biWidth := Surface.w; - biHeight := Surface.h; - biPlanes := 1; - biBitCount := 24; - biCompression := BI_RGB; - end; - - if (SDL_MUSTLOCK(Surface)) then - SDL_LockSurface(Surface); - - // use fast Win32-API functions to copy data instead of Bitmap.Canvas.Pixels - if (Surface.pitch mod 4 = 0) then - begin - // if the image is aligned (to a 4-byte boundary) -> copy all data at once - // Note: surfaces created with SDL (e.g. with SDL_ConvertSurface) are aligned - SetDIBits(0, Bitmap.Handle, 0, Bitmap.Height, Surface.pixels, BitmapInfo, DIB_RGB_COLORS); - end - else - begin - // wrong alignment -> copy each line separately. - // Note: for the last line unassigned memory (> last Surface.pixels element) - // will be copied to the padding area (last bytes of a row), - // but we do not care because the content of padding data is ignored anyhow. - for row := 0 to Surface.h do - begin - SetDIBits(0, Bitmap.Handle, row, 1, @PChar(Surface.pixels)[row * Surface.pitch], - BitmapInfo, DIB_RGB_COLORS); - end; - end; - - if (SDL_MUSTLOCK(Surface)) then - SDL_UnlockSurface(Surface); - - // assign Bitmap to JPEG and store the latter - Jpeg := TJPEGImage.Create; - Jpeg.Assign(Bitmap); - Bitmap.Free; - Jpeg.CompressionQuality := Quality; - try - // compress image (don't forget this line, otherwise it won't be compressed) - Jpeg.Compress(); - Jpeg.SaveToFile(FileName); - except - Log.LogError('Could not save file: "' + FileName + '"', 'WriteJPGImage'); - Exit; - end; - Jpeg.Free; - {$ELSE} - // based on example.pas in FPC's packages/base/pasjpeg directory - - // only 24bit (RGB) data is supported, so convert to it - if (IsRGBSurface(Surface.format)) then - converted := false - else - begin - Surface := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE); - converted := true; - end; - - // allocate and initialize JPEG compression object - cinfo.err := jpeg_std_error(jerr); - // msg_level that will be displayed. (Nomssi) - //jerr.trace_level := 3; - // initialize the JPEG compression object - jpeg_create_compress(@cinfo); - - // open file for writing - try - jpgFile := TFileStream.Create(FileName, fmCreate); - except - Log.LogError('Could not open file: "' + FileName + '"', 'WriteJPGImage'); - Exit; - end; - - // specify data destination - jpeg_stdio_dest(@cinfo, @jpgFile); - - // set parameters for compression - cinfo.image_width := Surface.w; - cinfo.image_height := Surface.h; - cinfo.in_color_space := JCS_RGB; - cinfo.input_components := 3; - cinfo.data_precision := 8; - - // set default compression parameters - jpeg_set_defaults(@cinfo); - jpeg_set_quality(@cinfo, quality, true); - - // start compressor - jpeg_start_compress(@cinfo, true); - - if (SDL_MUSTLOCK(Surface)) then - SDL_LockSurface(Surface); - - while (cinfo.next_scanline < cinfo.image_height) do - begin - // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned) - rowPtr[0] := JSAMPROW(@PChar(Surface.pixels)[(Surface.h-cinfo.next_scanline-1) * Surface.pitch]); - jpeg_write_scanlines(@cinfo, JSAMPARRAY(@rowPtr), 1); - end; - - if (SDL_MUSTLOCK(Surface)) then - SDL_UnlockSurface(Surface); - - // finish compression - jpeg_finish_compress(@cinfo); - // close the output file - jpgFile.Free; - - // release JPEG compression object - jpeg_destroy_compress(@cinfo); - {$ENDIF} - - if (converted) then - SDL_FreeSurface(Surface); - - Result := true; -end; - -{$ENDIF} - - -(******************************************************* - * Image loading - *******************************************************) - - -(* - * Loads an image from the given file or resource - *) -function LoadImage(const Identifier: string): PSDL_Surface; -var - TexRWops: PSDL_RWops; - TexStream: TStream; - FileName: string; -begin - Result := nil; - TexRWops := nil; - - if Identifier = '' then - exit; - - //Log.LogStatus( Identifier, 'LoadImage' ); - - FileName := Identifier; - - if (FileExistsInsensitive(FileName)) then - begin - // load from file - //Log.LogStatus( 'Is File ( Loading : '+FileName+')', ' LoadImage' ); - try - Result := IMG_Load(PChar(FileName)); - //Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' ); - except - Log.LogError('Could not load from file "'+FileName+'"', 'LoadImage'); - Exit; - end; - end - else - begin - //Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - - TexStream := GetResourceStream(Identifier, 'TEX'); - if (not assigned(TexStream)) then - begin - Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'LoadImage'); - Exit; - end; - - TexRWops := RWopsFromStream(TexStream); - if (TexRWops = nil) then - begin - Log.LogError( 'Could not assign resource "'+Identifier+'"', 'LoadImage'); - TexStream.Free(); - Exit; - end; - - //Log.LogStatus( 'resource Assigned....' , Identifier); - try - Result := IMG_Load_RW(TexRWops, 0); - except - Log.LogError( 'Could not read resource "'+Identifier+'"', 'LoadImage'); - end; - - SDL_FreeRW(TexRWops); - TexStream.Free(); - end; -end; - - -(******************************************************* - * Image manipulation - *******************************************************) - - -function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; -begin - if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and - (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and - (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and - (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and - (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and - (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and - (fmt1^.Bshift = fmt2^.Bshift) - then - Result := true - else - Result := false; -end; - -procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); -var - TempSurface: PSDL_Surface; -begin - TempSurface := ImgSurface; - ImgSurface := SDL_ScaleSurfaceRect(TempSurface, - 0, 0, TempSurface^.W,TempSurface^.H, - Width, Height); - SDL_FreeSurface(TempSurface); -end; - -procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); -var - TempSurface: PSDL_Surface; - ImgFmt: PSDL_PixelFormat; -begin - TempSurface := ImgSurface; - - // create a new surface with given width and height - ImgFmt := TempSurface^.format; - ImgSurface := SDL_CreateRGBSurface( - SDL_SWSURFACE, Width, Height, ImgFmt^.BitsPerPixel, - ImgFmt^.RMask, ImgFmt^.GMask, ImgFmt^.BMask, ImgFmt^.AMask); - - // copy image from temp- to new surface - SDL_SetAlpha(ImgSurface, 0, 255); - SDL_SetAlpha(TempSurface, 0, 255); - SDL_BlitSurface(TempSurface, nil, ImgSurface, nil); - - SDL_FreeSurface(TempSurface); -end; - -(* -// Old slow floating point version of ColorizeTexture. -// For an easier understanding of the faster fixed point version below. -procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); -var - clr: array[0..2] of Double; // [0: R, 1: G, 2: B] - hsv: array[0..2] of Double; // [0: H(ue), 1: S(aturation), 2: V(alue)] - delta, f, p, q, t: Double; - max: Double; -begin - clr[0] := PixelColors[0]/255; - clr[1] := PixelColors[1]/255; - clr[2] := PixelColors[2]/255; - max := maxvalue(clr); - delta := max - minvalue(clr); - - hsv[0] := DestinationHue; // set H(ue) - hsv[2] := max; // set V(alue) - // calc S(aturation) - if (max = 0.0) then - hsv[1] := 0.0 - else - hsv[1] := delta/max; - - //ColorizePixel(PByteArray(Pixel), DestinationHue); - h_int := trunc(hsv[0]); // h_int = |_h_| - f := hsv[0]-h_int; // f = h-h_int - p := hsv[2]*(1.0-hsv[1]); // p = v*(1-s) - q := hsv[2]*(1.0-(hsv[1]*f)); // q = v*(1-s*f) - t := hsv[2]*(1.0-(hsv[1]*(1.0-f))); // t = v*(1-s*(1-f)) - case h_int of - 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p) - 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p) - 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t) - 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v) - 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v) - 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q) - end; - - // and store new rgb back into the image - PixelColors[0] := trunc(255*clr[0]); - PixelColors[1] := trunc(255*clr[1]); - PixelColors[2] := trunc(255*clr[2]); -end; -*) - -procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); - - //returns hue within range [0.0-6.0) - function col2hue(Color:Cardinal): double; - var - clr: array[0..2] of double; - hue, max, delta: double; - begin - clr[0] := ((Color and $ff0000) shr 16)/255; // R - clr[1] := ((Color and $ff00) shr 8)/255; // G - clr[2] := (Color and $ff) /255; // B - max := maxvalue(clr); - delta := max - minvalue(clr); - // calc hue - if (delta = 0.0) then hue := 0 - else if (clr[0] = max) then hue := (clr[1]-clr[2])/delta - else if (clr[1] = max) then hue := 2.0+(clr[2]-clr[0])/delta - else if (clr[2] = max) then hue := 4.0+(clr[0]-clr[1])/delta; - if (hue < 0.0) then - hue := hue + 6.0; - Result := hue; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; - Pixel: PByte; - PixelColors: PByteArray; - clr: array[0..2] of UInt32; // [0: R, 1: G, 2: B] - hsv: array[0..2] of UInt32; // [0: H(ue), 1: S(aturation), 2: V(alue)] - dhue: UInt32; - h_int: Cardinal; - delta, f, p, q, t: Longint; - max: Uint32; -begin - DestinationHue := col2hue(NewColor); - - dhue := Trunc(DestinationHue*1024); - - Pixel := ImgSurface^.Pixels; - - for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do - begin - PixelColors := PByteArray(Pixel); - // inlined colorize per pixel - - // uses fixed point math - // get color values - clr[0] := PixelColors[0] shl 10; - clr[1] := PixelColors[1] shl 10; - clr[2] := PixelColors[2] shl 10; - //calculate luminance and saturation from rgb - - max := clr[0]; - if clr[1] > max then max := clr[1]; - if clr[2] > max then max := clr[2]; - delta := clr[0]; - if clr[1] < delta then delta := clr[1]; - if clr[2] < delta then delta := clr[2]; - delta := max-delta; - hsv[0] := dhue; // shl 8 - hsv[2] := max; // shl 8 - if (max = 0) then - hsv[1] := 0 - else - hsv[1] := (delta shl 10) div max; // shl 8 - h_int := hsv[0] and $fffffC00; - f := hsv[0]-h_int; //shl 10 - p := (hsv[2]*(1024-hsv[1])) shr 10; - q := (hsv[2]*(1024-(hsv[1]*f) shr 10)) shr 10; - t := (hsv[2]*(1024-(hsv[1]*(1024-f)) shr 10)) shr 10; - h_int := h_int shr 10; - case h_int of - 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p) - 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p) - 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t) - 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v) - 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v) - 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q) - end; - - PixelColors[0] := clr[0] shr 10; - PixelColors[1] := clr[1] shr 10; - PixelColors[2] := clr[2] shr 10; - - Inc(Pixel, ImgSurface^.format.BytesPerPixel); - end; -end; - -end. diff --git a/src/Classes/UIni.pas b/src/Classes/UIni.pas deleted file mode 100644 index b286c917..00000000 --- a/src/Classes/UIni.pas +++ /dev/null @@ -1,928 +0,0 @@ -unit UIni; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - IniFiles, - ULog, - SysUtils; - -type - // TInputDeviceConfig stores the configuration for an input device. - // Configurations will be stored in the InputDeviceConfig array. - // Note that not all devices listed in InputDeviceConfig are active devices. - // Some might be unplugged and hence unavailable. - // Available devices are held in TAudioInputProcessor.DeviceList. Each - // TAudioInputDevice listed there has a CfgIndex field which is the index to - // its configuration in the InputDeviceConfig array. - // Name: - // the name of the input device - // Input: - // the index of the input source to use for recording - // ChannelToPlayerMap: - // mapping of recording channels to players, e.g. ChannelToPlayerMap[0] = 2 - // maps the channel 0 (left) to player 2. A player index of 0 means that - // the channel is not assigned to a player. - PInputDeviceConfig = ^TInputDeviceConfig; - TInputDeviceConfig = record - Name: string; - Input: integer; - ChannelToPlayerMap: array of integer; - end; - -type - -//Options - - TVisualizerOption = (voOff, voWhenNoVideo, voOn); - TBackgroundMusicOption = (bmoOff, bmoOn); - TIni = class - private - function RemoveFileExt(FullName: string): string; - function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; - function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; - function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: Boolean = False): integer; - function ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; - IniSection: string; IniProperty: string; Default: integer): integer; - - procedure LoadInputDeviceCfg(IniFile: TMemIniFile); - procedure SaveInputDeviceCfg(IniFile: TIniFile); - procedure LoadThemes(IniFile: TCustomIniFile); - procedure LoadPaths(IniFile: TCustomIniFile); - procedure LoadScreenModes(IniFile: TCustomIniFile); - - public - Name: array[0..11] of string; - - // Templates for Names Mod - NameTeam: array[0..2] of string; - NameTemplate: array[0..11] of string; - - //Filename of the opened iniFile - Filename: string; - - // Game - Players: integer; - Difficulty: integer; - Language: integer; - Tabs: integer; - Tabs_at_startup:integer; //Tabs at Startup fix - Sorting: integer; - Debug: integer; - - // Graphics - Screens: integer; - Resolution: integer; - Depth: integer; - VisualizerOption:integer; - FullScreen: integer; - TextureSize: integer; - SingWindow: integer; - Oscilloscope: integer; - Spectrum: integer; - Spectrograph: integer; - MovieSize: integer; - - // Sound - MicBoost: integer; - ClickAssist: integer; - BeatClick: integer; - SavePlayback: integer; - ThresholdIndex: integer; - AudioOutputBufferSizeIndex:integer; - VoicePassthrough:integer; - - //Song Preview - PreviewVolume: integer; - PreviewFading: integer; - - // Lyrics - LyricsFont: integer; - LyricsEffect: integer; - Solmization: integer; - NoteLines: integer; - - // Themes - Theme: integer; - SkinNo: integer; - Color: integer; - BackgroundMusicOption:integer; - - // Record - InputDeviceConfig: array of TInputDeviceConfig; - - // Advanced - LoadAnimation: integer; - EffectSing: integer; - ScreenFade: integer; - AskBeforeDel: integer; - OnSongClick: integer; - LineBonus: integer; - PartyPopup: integer; - - // Controller - Joypad: integer; - - procedure Load(); - procedure Save(); - procedure SaveNames; - procedure SaveLevel; - end; - -var - Ini: TIni; - IResolution: array of string; - ILanguage: array of string; - ITheme: array of string; - ISkin: array of string; - - - -const - IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); - IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 ); - - IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); - ITabs: array[0..1] of string = ('Off', 'On'); - - ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); - sEdition = 0; - sGenre = 1; - sLanguage = 2; - sFolder = 3; - sTitle = 4; - sArtist = 5; - sTitle2 = 6; - sArtist2 = 7; - - IDebug: array[0..1] of string = ('Off', 'On'); - - IScreens: array[0..1] of string = ('1', '2'); - IFullScreen: array[0..1] of string = ('Off', 'On'); - IDepth: array[0..1] of string = ('16 bit', '32 bit'); - IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On'); - - IBackgroundMusic: array[0..1] of string = ('Off', 'On'); - - - ITextureSize: array[0..2] of string = ('128', '256', '512'); - ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512); - - ISingWindow: array[0..1] of string = ('Small', 'Big'); - - //SingBar Mod - IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); -//IOscilloscope: array[0..1] of string = ('Off', 'On'); - - ISpectrum: array[0..1] of string = ('Off', 'On'); - ISpectrograph: array[0..1] of string = ('Off', 'On'); - IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); - - IClickAssist: array[0..1] of string = ('Off', 'On'); - IBeatClick: array[0..1] of string = ('Off', 'On'); - ISavePlayback: array[0..1] of string = ('Off', 'On'); - - IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); - IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20); - - IVoicePassthrough: array[0..1] of string = ('Off', 'On'); - - IAudioOutputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); - IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); - - IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); - IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); - - //Song Preview - IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); - IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 ); - - IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); - IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 ); - - - ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); - ILyricsEffect: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); - ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); - INoteLines: array[0..1] of string = ('Off', 'On'); - - IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); - - // Advanced - ILoadAnimation: array[0..1] of string = ('Off', 'On'); - IEffectSing: array[0..1] of string = ('Off', 'On'); - IScreenFade: array[0..1] of string =('Off', 'On'); - IAskbeforeDel: array[0..1] of string = ('Off', 'On'); - IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); - ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); - IPartyPopup: array[0..1] of string = ('Off', 'On'); - - IJoypad: array[0..1] of string = ('Off', 'On'); - - // Recording options - IChannelPlayer: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); - IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); - -implementation - -uses - StrUtils, - UMain, - SDL, - ULanguage, - UPlatform, - USkins, - URecord, - UCommandLine; - -(** - * Returns the filename without its fileextension - *) -function TIni.RemoveFileExt(FullName: string): string; -begin - Result := ChangeFileExt(FullName, ''); -end; - -(** - * Extracts an index of a key that is surrounded by a Prefix/Suffix pair. - * Example: ExtractKeyIndex('MyKey[1]', '[', ']') will return 1. - *) -function TIni.ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; -var - Value: string; - Start: integer; -begin - Result := -1; - - if Pos(Prefix, Key) > -1 then - begin - Start := Pos(Prefix, Key) + Length(Prefix); - - // copy all between prefix and suffix - Value := Copy(Key, Start, Pos(Suffix, Key)-1 - Start); - Result := StrToIntDef(Value, -1); - end; -end; - -(** - * Finds the maximum key-index in a key-list. - * The indexes of the list are surrounded by Prefix/Suffix, - * e.g. MyKey[1] (Prefix='[', Suffix=']') - *) -function TIni.GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; -var - i: integer; - KeyIndex: integer; -begin - Result := -1; - - for i := 0 to Keys.Count-1 do - begin - KeyIndex := ExtractKeyIndex(Keys[i], Prefix, Suffix); - if (KeyIndex > Result) then - Result := KeyIndex; - end; -end; - -(** - * Returns the index of Value in SearchArray - * or -1 if Value is not in SearchArray. - *) -function TIni.GetArrayIndex(const SearchArray: array of string; Value: string; - CaseInsensitiv: Boolean = False): integer; -var - i: integer; -begin - Result := -1; - - for i := 0 to High(SearchArray) do - begin - if (SearchArray[i] = Value) or - (CaseInsensitiv and (UpperCase(SearchArray[i]) = UpperCase(Value))) then - begin - Result := i; - Break; - end; - end; -end; - -(** - * Reads the property IniSeaction:IniProperty from IniFile and - * finds its corresponding index in SearchArray. - * If SearchArray does not contain the property value, the default value is - * returned. - *) -function TIni.ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; - IniSection: string; IniProperty: string; Default: integer): integer; -var - StrValue: string; -begin - StrValue := IniFile.ReadString(IniSection, IniProperty, SearchArray[Default]); - Result := GetArrayIndex(SearchArray, StrValue); - if (Result = -1) then - begin - Result := Default; - end; -end; - - -procedure TIni.LoadInputDeviceCfg(IniFile: TMemIniFile); -var - DeviceCfg: PInputDeviceConfig; - DeviceIndex: integer; - ChannelCount: integer; - ChannelIndex: integer; - RecordKeys: TStringList; - i: integer; -begin - RecordKeys := TStringList.Create(); - - // read all record-keys for filtering - IniFile.ReadSection('Record', RecordKeys); - - SetLength(InputDeviceConfig, 0); - - for i := 0 to RecordKeys.Count-1 do - begin - // find next device-name - DeviceIndex := ExtractKeyIndex(RecordKeys[i], 'DeviceName[', ']'); - if (DeviceIndex >= 0) then - begin - if not IniFile.ValueExists('Record', Format('DeviceName[%d]', [DeviceIndex])) then - break; - - // resize list - SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1); - - // read an input device's config. - // Note: All devices are appended to the list whether they exist or not. - // Otherwise an external device's config will be lost if it is not - // connected (e.g. singstar mics or USB-Audio devices). - DeviceCfg := @InputDeviceConfig[High(InputDeviceConfig)]; - DeviceCfg.Name := IniFile.ReadString('Record', Format('DeviceName[%d]', [DeviceIndex]), ''); - DeviceCfg.Input := IniFile.ReadInteger('Record', Format('Input[%d]', [DeviceIndex]), 0); - - // find the largest channel-number of the current device in the ini-file - ChannelCount := GetMaxKeyIndex(RecordKeys, 'Channel', Format('[%d]', [DeviceIndex])); - if (ChannelCount < 0) then - ChannelCount := 0; - - SetLength(DeviceCfg.ChannelToPlayerMap, ChannelCount); - - // read channel-to-player mapping for every channel of the current device - // or set non-configured channels to no player (=0). - for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do - begin - DeviceCfg.ChannelToPlayerMap[ChannelIndex] := - IniFile.ReadInteger('Record', Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex]), 0); - end; - end; - end; - - RecordKeys.Free(); - - // MicBoost - //MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off')); - // Threshold - // ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1])); -end; - -procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile); -var - DeviceIndex: integer; - ChannelIndex: integer; -begin - for DeviceIndex := 0 to High(InputDeviceConfig) do - begin - // DeviceName and DeviceInput - IniFile.WriteString('Record', Format('DeviceName[%d]', [DeviceIndex+1]), - InputDeviceConfig[DeviceIndex].Name); - IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]), - InputDeviceConfig[DeviceIndex].Input); - - // Channel-to-Player Mapping - for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do - begin - IniFile.WriteInteger('Record', - Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex+1]), - InputDeviceConfig[DeviceIndex].ChannelToPlayerMap[ChannelIndex]); - end; - end; - - // MicBoost - //IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]); - // Threshold - //IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]); -end; - -procedure TIni.LoadPaths(IniFile: TCustomIniFile); -var - PathStrings: TStringList; - I: integer; -begin - PathStrings := TStringList.Create; - IniFile.ReadSection('Directories', PathStrings); - - // Load song-paths - for I := 0 to PathStrings.Count-1 do - begin - if (AnsiStartsText('SongDir', PathStrings[I])) then - begin - AddSongPath(IniFile.ReadString('Directories', PathStrings[I], '')); - end; - end; - - PathStrings.Free; -end; - -procedure TIni.LoadThemes(IniFile: TCustomIniFile); -var - SearchResult: TSearchRec; - ThemeIni: TMemIniFile; - ThemeName: string; - I: integer; -begin - // Theme - SetLength(ITheme, 0); - Log.LogStatus('Searching for Theme : ' + ThemePath + '*.ini', 'Theme'); - - FindFirst(ThemePath + '*.ini',faAnyFile, SearchResult); - Repeat - Log.LogStatus('Found Theme: ' + SearchResult.Name, 'Theme'); - - //Read Themename from Theme - ThemeIni := TMemIniFile.Create(SearchResult.Name); - ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', RemoveFileExt(SearchResult.Name))); - ThemeIni.Free; - - //Search for Skins for this Theme - for I := Low(Skin.Skin) to High(Skin.Skin) do - begin - if UpperCase(Skin.Skin[I].Theme) = ThemeName then - begin - SetLength(ITheme, Length(ITheme)+1); - ITheme[High(ITheme)] := RemoveFileExt(SearchResult.Name); - break; - end; - end; - until FindNext(SearchResult) <> 0; - FindClose(SearchResult); - - // No Theme Found - if (Length(ITheme) = 0) then - begin - Log.CriticalError('Could not find any valid Themes.'); - end; - - Theme := GetArrayIndex(ITheme, IniFile.ReadString('Themes', 'Theme', 'DELUXE'), true); - if (Theme = -1) then - Theme := 0; - - // Skin - Skin.onThemeChange; - - SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[0])); -end; - -procedure TIni.LoadScreenModes(IniFile: TCustomIniFile); - - // swap two strings - procedure swap(var s1, s2: string); - var - s3: string; - begin - s3 := s1; - s1 := s2; - s2 := s3; - end; - -var - Modes: PPSDL_Rect; - I: integer; -begin - // Screens - Screens := GetArrayIndex(IScreens, IniFile.ReadString('Graphics', 'Screens', IScreens[0])); - - // FullScreen - FullScreen := GetArrayIndex(IFullScreen, IniFile.ReadString('Graphics', 'FullScreen', 'On')); - - // Resolution - SetLength(IResolution, 0); - - // Check if there are any modes available - // TODO: we should seperate windowed and fullscreen modes. Otherwise it is not - // possible to select a reasonable fullscreen mode when in windowed mode - if IFullScreen[FullScreen] = 'On' then - Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN or SDL_RESIZABLE) - else - Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ; - - if (Modes = nil) then - begin - Log.LogStatus( 'No resolutions Found' , 'Video'); - end - else if (Modes = PPSDL_Rect(-1)) then - begin - // Fallback to some standard resolutions - SetLength(IResolution, 10); - IResolution[0] := '640x480'; - IResolution[1] := '800x600'; - IResolution[2] := '1024x768'; - IResolution[3] := '1152x864'; - IResolution[4] := '1280x800'; - IResolution[5] := '1280x960'; - IResolution[6] := '1400x1050'; - IResolution[7] := '1440x900'; - IResolution[8] := '1600x1200'; - IResolution[9] := '1680x1050'; - - Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); - if Resolution = -1 then - begin - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IniFile.ReadString('Graphics', 'Resolution', '800x600'); - Resolution := High(IResolution); - end; - end - else - begin - while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) - begin - Log.LogStatus( 'Found Video Mode : ' + IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h) , 'Video'); - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); - Inc(Modes); - end; - - // reverse order - for I := 0 to (Length(IResolution) div 2) - 1 do - begin - swap(IResolution[I], IResolution[High(IResolution)-I]); - end; - Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); - - if Resolution = -1 then - begin - Resolution := GetArrayIndex(IResolution, '800x600'); - if Resolution = -1 then - Resolution := 0; - end; - end; - - // if no modes were set, then failback to 800x600 - // as per http://sourceforge.net/forum/message.php?msg_id=4544965 - // THANKS : linnex at users.sourceforge.net - if Length(IResolution) < 1 then - begin - Log.LogStatus( 'Found Video Mode : NONE !!! ( Defaulted to 800 x 600 )', 'Video'); - SetLength(IResolution, 1); - IResolution[0] := '800x600'; - Resolution := 0; - Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[0] , 'Graphics - Resolutions'); - - // Default to fullscreen OFF, in this case ! - FullScreen := 0; - end; - - // Depth - Depth := GetArrayIndex(IDepth, IniFile.ReadString('Graphics', 'Depth', '32 bit')); -end; - -procedure TIni.Load(); -var - IniFile: TMemIniFile; - I: integer; -begin - GamePath := Platform.GetGameUserPath; - - Log.LogStatus( 'GamePath : ' +GamePath , '' ); - - if (Params.ConfigFile <> '') then - try - FileName := Params.ConfigFile; - except - FileName := GamePath + 'config.ini'; - end - else - FileName := GamePath + 'config.ini'; - - Log.LogStatus( 'Using config : ' + FileName , 'Ini'); - IniFile := TMemIniFile.Create( FileName ); - - // Name - for I := 0 to 11 do - Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); - - // Templates for Names Mod - for I := 0 to 2 do - NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); - for I := 0 to 11 do - NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); - - // Players - Players := GetArrayIndex(IPlayers, IniFile.ReadString('Game', 'Players', IPlayers[0])); - - // Difficulty - Difficulty := GetArrayIndex(IDifficulty, IniFile.ReadString('Game', 'Difficulty', 'Easy')); - - // Language - Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English')); - //Language.ChangeLanguage(ILanguage[Language]); - - // Tabs - Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0])); - Tabs_at_startup := Tabs; //Tabs at Startup fix - - // Song Sorting - Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0])); - - // Debug - Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0])); - - LoadScreenModes(IniFile); - - // TextureSize - TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1])); - - // SingWindow - SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big')); - - // Oscilloscope - Oscilloscope := GetArrayIndex(IOscilloscope, IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar')); - - // Spectrum - Spectrum := GetArrayIndex(ISpectrum, IniFile.ReadString('Graphics', 'Spectrum', 'Off')); - - // Spectrograph - Spectrograph := GetArrayIndex(ISpectrograph, IniFile.ReadString('Graphics', 'Spectrograph', 'Off')); - - // MovieSize - MovieSize := GetArrayIndex(IMovieSize, IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2])); - - // ClickAssist - ClickAssist := GetArrayIndex(IClickAssist, IniFile.ReadString('Sound', 'ClickAssist', 'Off')); - - // BeatClick - BeatClick := GetArrayIndex(IBeatClick, IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0])); - - // SavePlayback - SavePlayback := GetArrayIndex(ISavePlayback, IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0])); - - // AudioOutputBufferSize - AudioOutputBufferSizeIndex := ReadArrayIndex(IAudioOutputBufferSize, IniFile, 'Sound', 'AudioOutputBufferSize', 0); - - //Preview Volume - PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7])); - - //Preview Fading - PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1])); - - //AudioRepeat aka VoicePassthrough - VoicePassthrough := GetArrayIndex(IVoicePassthrough, IniFile.ReadString('Sound', 'VoicePassthrough', IVoicePassthrough[0])); - - // Lyrics Font - LyricsFont := GetArrayIndex(ILyricsFont, IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1])); - - // Lyrics Effect - LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1])); - - // Solmization - Solmization := GetArrayIndex(ISolmization, IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0])); - - // NoteLines - NoteLines := GetArrayIndex(INoteLines, IniFile.ReadString('Lyrics', 'NoteLines', INoteLines[1])); - - LoadThemes(IniFile); - - // Color - Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[0])); - - LoadInputDeviceCfg(IniFile); - - // LoadAnimation - LoadAnimation := GetArrayIndex(ILoadAnimation, IniFile.ReadString('Advanced', 'LoadAnimation', 'On')); - - // ScreenFade - ScreenFade := GetArrayIndex(IScreenFade, IniFile.ReadString('Advanced', 'ScreenFade', 'On')); - - // Visualizations - // this could be of use later.. - // VisualizerOption := - // TVisualizerOption(GetEnumValue(TypeInfo(TVisualizerOption), - // IniFile.ReadString('Graphics', 'Visualization', 'Off'))); - // || VisualizerOption := TVisualizerOption(GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off'))); - VisualizerOption := GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off')); - -{** - * Background music - *} - BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'Off')); - - // EffectSing - EffectSing := GetArrayIndex(IEffectSing, IniFile.ReadString('Advanced', 'EffectSing', 'On')); - - // AskbeforeDel - AskBeforeDel := GetArrayIndex(IAskbeforeDel, IniFile.ReadString('Advanced', 'AskbeforeDel', 'On')); - - // OnSongClick - OnSongClick := GetArrayIndex(IOnSongClick, IniFile.ReadString('Advanced', 'OnSongClick', 'Sing')); - - // Linebonus - LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', 'At Score')); - - // PartyPopup - PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On')); - - // Joypad - Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0])); - - LoadPaths(IniFile); - - IniFile.Free; -end; - -procedure TIni.Save; -var - IniFile: TIniFile; -begin - if (FileExists(Filename) and FileIsReadOnly(Filename)) then - begin - Log.LogError('Config-file is read-only', 'TIni.Save'); - Exit; - end; - - IniFile := TIniFile.Create(Filename); - - // Players - IniFile.WriteString('Game', 'Players', IPlayers[Players]); - - // Difficulty - IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]); - - // Language - IniFile.WriteString('Game', 'Language', ILanguage[Language]); - - // Tabs - IniFile.WriteString('Game', 'Tabs', ITabs[Tabs]); - - // Sorting - IniFile.WriteString('Game', 'Sorting', ISorting[Sorting]); - - // Debug - IniFile.WriteString('Game', 'Debug', IDebug[Debug]); - - // Screens - IniFile.WriteString('Graphics', 'Screens', IScreens[Screens]); - - // FullScreen - IniFile.WriteString('Graphics', 'FullScreen', IFullScreen[FullScreen]); - - // Visualization - IniFile.WriteString('Graphics', 'Visualization', IVisualizer[VisualizerOption]); - - // Resolution - IniFile.WriteString('Graphics', 'Resolution', IResolution[Resolution]); - - // Depth - IniFile.WriteString('Graphics', 'Depth', IDepth[Depth]); - - // TextureSize - IniFile.WriteString('Graphics', 'TextureSize', ITextureSize[TextureSize]); - - // Sing Window - IniFile.WriteString('Graphics', 'SingWindow', ISingWindow[SingWindow]); - - // Oscilloscope - IniFile.WriteString('Graphics', 'Oscilloscope', IOscilloscope[Oscilloscope]); - - // Spectrum - IniFile.WriteString('Graphics', 'Spectrum', ISpectrum[Spectrum]); - - // Spectrograph - IniFile.WriteString('Graphics', 'Spectrograph', ISpectrograph[Spectrograph]); - - // Movie Size - IniFile.WriteString('Graphics', 'MovieSize', IMovieSize[MovieSize]); - - // ClickAssist - IniFile.WriteString('Sound', 'ClickAssist', IClickAssist[ClickAssist]); - - // BeatClick - IniFile.WriteString('Sound', 'BeatClick', IBeatClick[BeatClick]); - - // AudioOutputBufferSize - IniFile.WriteString('Sound', 'AudioOutputBufferSize', IAudioOutputBufferSize[AudioOutputBufferSizeIndex]); - - // Background music - IniFile.WriteString('Sound', 'BackgroundMusic', IBackgroundMusic[BackgroundMusicOption]); - - // Song Preview - IniFile.WriteString('Sound', 'PreviewVolume', IPreviewVolume[PreviewVolume]); - - // PreviewFading - IniFile.WriteString('Sound', 'PreviewFading', IPreviewFading[PreviewFading]); - - // SavePlayback - IniFile.WriteString('Sound', 'SavePlayback', ISavePlayback[SavePlayback]); - - // VoicePasstrough - IniFile.WriteString('Sound', 'VoicePassthrough', IVoicePassthrough[VoicePassthrough]); - - // Lyrics Font - IniFile.WriteString('Lyrics', 'LyricsFont', ILyricsFont[LyricsFont]); - - // Lyrics Effect - IniFile.WriteString('Lyrics', 'LyricsEffect', ILyricsEffect[LyricsEffect]); - - // Solmization - IniFile.WriteString('Lyrics', 'Solmization', ISolmization[Solmization]); - - // NoteLines - IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]); - - // Theme - IniFile.WriteString('Themes', 'Theme', ITheme[Theme]); - - // Skin - IniFile.WriteString('Themes', 'Skin', ISkin[SkinNo]); - - // Color - IniFile.WriteString('Themes', 'Color', IColor[Color]); - - SaveInputDeviceCfg(IniFile); - - //LoadAnimation - IniFile.WriteString('Advanced', 'LoadAnimation', ILoadAnimation[LoadAnimation]); - - //EffectSing - IniFile.WriteString('Advanced', 'EffectSing', IEffectSing[EffectSing]); - - //ScreenFade - IniFile.WriteString('Advanced', 'ScreenFade', IScreenFade[ScreenFade]); - - //AskbeforeDel - IniFile.WriteString('Advanced', 'AskbeforeDel', IAskbeforeDel[AskBeforeDel]); - - //OnSongClick - IniFile.WriteString('Advanced', 'OnSongClick', IOnSongClick[OnSongClick]); - - //Line Bonus - IniFile.WriteString('Advanced', 'LineBonus', ILineBonus[LineBonus]); - - //Party Popup - IniFile.WriteString('Advanced', 'PartyPopup', IPartyPopup[PartyPopup]); - - // Joypad - IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]); - - // Directories (add a template if section is missing) - if (not IniFile.SectionExists('Directories')) then - IniFile.WriteString('Directories', 'SongDir1', ''); - - IniFile.Free; -end; - -procedure TIni.SaveNames; -var - IniFile: TIniFile; - I: integer; -begin - if not FileIsReadOnly(Filename) then - begin - IniFile := TIniFile.Create(Filename); - - //Name Templates for Names Mod - for I := 1 to 12 do - IniFile.WriteString('Name', 'P' + IntToStr(I), Name[I-1]); - for I := 1 to 3 do - IniFile.WriteString('NameTeam', 'T' + IntToStr(I), NameTeam[I-1]); - for I := 1 to 12 do - IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), NameTemplate[I-1]); - - IniFile.Free; - end; -end; - -procedure TIni.SaveLevel; -var - IniFile: TIniFile; -begin - if not FileIsReadOnly(Filename) then - begin - IniFile := TIniFile.Create(Filename); - - // Difficulty - IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]); - - IniFile.Free; - end; -end; - -end. diff --git a/src/Classes/UJoystick.pas b/src/Classes/UJoystick.pas deleted file mode 100644 index 0ca7ba09..00000000 --- a/src/Classes/UJoystick.pas +++ /dev/null @@ -1,282 +0,0 @@ -unit UJoystick; - -interface - -{$I switches.inc} - - -uses SDL; - -type - TJoyButton = record - State: integer; - Enabled: boolean; - Type_: byte; - Sym: cardinal; - end; - - TJoyHatState = record - State: Boolean; - LastTick: Cardinal; - Enabled: boolean; - Type_: byte; - Sym: cardinal; - end; - - TJoyUnit = record - Button: array[0..15] of TJoyButton; - HatState: Array[0..3] of TJoyHatState; - end; - - TJoy = class - constructor Create; - procedure Update; - end; - -var - Joy: TJoy; - JoyUnit: TJoyUnit; - SDL_Joy: PSDL_Joystick; - JoyEvent: TSDL_Event; - -implementation - -uses SysUtils, - ULog; - -constructor TJoy.Create; -var - B, N: integer; -begin - inherited; - - //Old Corvus5 Method - {// joystick support - SDL_JoystickEventState(SDL_IGNORE); - SDL_InitSubSystem(SDL_INIT_JOYSTICK); - if SDL_NumJoysticks <> 1 then - Log.LogStatus('Joystick count <> 1', 'TJoy.Create'); - - SDL_Joy := SDL_JoystickOpen(0); - if SDL_Joy = nil then - Log.LogError('SDL_JoystickOpen failed', 'TJoy.Create'); - - if SDL_JoystickNumButtons(SDL_Joy) <> 16 then - Log.LogStatus('Joystick button count <> 16', 'TJoy.Create'); - -// SDL_JoystickEventState(SDL_ENABLE); - // Events don't work - thay hang the whole application with SDL_JoystickEventState(SDL_ENABLE) - - // clear states - for B := 0 to 15 do - JoyUnit.Button[B].State := 1; - - // mapping - JoyUnit.Button[1].Enabled := true; - JoyUnit.Button[1].Type_ := SDL_KEYDOWN; - JoyUnit.Button[1].Sym := SDLK_RETURN; - JoyUnit.Button[2].Enabled := true; - JoyUnit.Button[2].Type_ := SDL_KEYDOWN; - JoyUnit.Button[2].Sym := SDLK_ESCAPE; - - JoyUnit.Button[12].Enabled := true; - JoyUnit.Button[12].Type_ := SDL_KEYDOWN; - JoyUnit.Button[12].Sym := SDLK_LEFT; - JoyUnit.Button[13].Enabled := true; - JoyUnit.Button[13].Type_ := SDL_KEYDOWN; - JoyUnit.Button[13].Sym := SDLK_DOWN; - JoyUnit.Button[14].Enabled := true; - JoyUnit.Button[14].Type_ := SDL_KEYDOWN; - JoyUnit.Button[14].Sym := SDLK_RIGHT; - JoyUnit.Button[15].Enabled := true; - JoyUnit.Button[15].Type_ := SDL_KEYDOWN; - JoyUnit.Button[15].Sym := SDLK_UP; - } - //New Sarutas method - SDL_JoystickEventState(SDL_IGNORE); - SDL_InitSubSystem(SDL_INIT_JOYSTICK); - if SDL_NumJoysticks < 1 then - begin - Log.LogError('No Joystick found'); - exit; - end; - - - SDL_Joy := SDL_JoystickOpen(0); - if SDL_Joy = nil then - begin - Log.LogError('Could not Init Joystick'); - exit; - end; - N := SDL_JoystickNumButtons(SDL_Joy); - //if N < 6 then Log.LogStatus('Joystick button count < 6', 'TJoy.Create'); - - for B := 0 to 5 do begin - JoyUnit.Button[B].Enabled := true; - JoyUnit.Button[B].State := 1; - JoyUnit.Button[B].Type_ := SDL_KEYDOWN; - end; - - JoyUnit.Button[0].Sym := SDLK_Return; - JoyUnit.Button[1].Sym := SDLK_Escape; - JoyUnit.Button[2].Sym := SDLK_M; - JoyUnit.Button[3].Sym := SDLK_R; - - JoyUnit.Button[4].Sym := SDLK_RETURN; - JoyUnit.Button[5].Sym := SDLK_ESCAPE; - - //Set HatState - for B := 0 to 3 do begin - JoyUnit.HatState[B].Enabled := true; - JoyUnit.HatState[B].State := False; - JoyUnit.HatState[B].Type_ := SDL_KEYDOWN; - end; - - JoyUnit.HatState[0].Sym := SDLK_UP; - JoyUnit.HatState[1].Sym := SDLK_RIGHT; - JoyUnit.HatState[2].Sym := SDLK_DOWN; - JoyUnit.HatState[3].Sym := SDLK_LEFT; -end; - -procedure TJoy.Update; -var - B: integer; - State: UInt8; - Tick: Cardinal; - Axes: Smallint; -begin - SDL_JoystickUpdate; - - //Manage Buttons - for B := 0 to 15 do begin - if (JoyUnit.Button[B].Enabled) and (JoyUnit.Button[B].State <> SDL_JoystickGetButton(SDL_Joy, B)) and (JoyUnit.Button[B].State = 0) then begin - JoyEvent.type_ := JoyUnit.Button[B].Type_; - JoyEvent.key.keysym.sym := JoyUnit.Button[B].Sym; - SDL_PushEvent(@JoyEvent); - end; - end; - - - for B := 0 to 15 do begin - JoyUnit.Button[B].State := SDL_JoystickGetButton(SDL_Joy, B); - end; - - //Get Tick - Tick := SDL_GetTicks(); - - //Get CoolieHat - if (SDL_JoystickNumHats(SDL_Joy)>=1) then - State := SDL_JoystickGetHat(SDL_Joy, 0) - else - State := 0; - - //Get Axis - if (SDL_JoystickNumAxes(SDL_Joy)>=2) then - begin - //Down - Up (X- Axis) - Axes := SDL_JoystickGetAxis(SDL_Joy, 1); - If Axes >= 15000 then - State := State or SDL_HAT_Down - Else If Axes <= -15000 then - State := State or SDL_HAT_UP; - - //Left - Right (Y- Axis) - Axes := SDL_JoystickGetAxis(SDL_Joy, 0); - If Axes >= 15000 then - State := State or SDL_HAT_Right - Else If Axes <= -15000 then - State := State or SDL_HAT_Left; - end; - - //Manage Hat and joystick Events - if (SDL_JoystickNumHats(SDL_Joy)>=1) OR (SDL_JoystickNumAxes(SDL_Joy)>=2) then - begin - - //Up Button - If (JoyUnit.HatState[0].Enabled) and ((SDL_HAT_UP AND State) = SDL_HAT_UP) then - begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs - if (JoyUnit.HatState[0].State = False) OR (JoyUnit.HatState[0].Lasttick < Tick) then - begin - //Set Tick and State - if JoyUnit.HatState[0].State then - JoyUnit.HatState[0].Lasttick := Tick + 200 - else - JoyUnit.HatState[0].Lasttick := Tick + 500; - - JoyUnit.HatState[0].State := True; - - JoyEvent.type_ := JoyUnit.HatState[0].Type_; - JoyEvent.key.keysym.sym := JoyUnit.HatState[0].Sym; - SDL_PushEvent(@JoyEvent); - end; - end - else - JoyUnit.HatState[0].State := False; - - //Right Button - If (JoyUnit.HatState[1].Enabled) and ((SDL_HAT_RIGHT AND State) = SDL_HAT_RIGHT) then - begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs - if (JoyUnit.HatState[1].State = False) OR (JoyUnit.HatState[1].Lasttick < Tick) then - begin - //Set Tick and State - if JoyUnit.HatState[1].State then - JoyUnit.HatState[1].Lasttick := Tick + 200 - else - JoyUnit.HatState[1].Lasttick := Tick + 500; - - JoyUnit.HatState[1].State := True; - - JoyEvent.type_ := JoyUnit.HatState[1].Type_; - JoyEvent.key.keysym.sym := JoyUnit.HatState[1].Sym; - SDL_PushEvent(@JoyEvent); - end; - end - else - JoyUnit.HatState[1].State := False; - - //Down button - If (JoyUnit.HatState[2].Enabled) and ((SDL_HAT_DOWN AND State) = SDL_HAT_DOWN) then - begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs - if (JoyUnit.HatState[2].State = False) OR (JoyUnit.HatState[2].Lasttick < Tick) then - begin - //Set Tick and State - if JoyUnit.HatState[2].State then - JoyUnit.HatState[2].Lasttick := Tick + 200 - else - JoyUnit.HatState[2].Lasttick := Tick + 500; - - JoyUnit.HatState[2].State := True; - - JoyEvent.type_ := JoyUnit.HatState[2].Type_; - JoyEvent.key.keysym.sym := JoyUnit.HatState[2].Sym; - SDL_PushEvent(@JoyEvent); - end; - end - else - JoyUnit.HatState[2].State := False; - - //Left Button - If (JoyUnit.HatState[3].Enabled) and ((SDL_HAT_LEFT AND State) = SDL_HAT_LEFT) then - begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs - if (JoyUnit.HatState[3].State = False) OR (JoyUnit.HatState[3].Lasttick < Tick) then - begin - //Set Tick and State - if JoyUnit.HatState[3].State then - JoyUnit.HatState[3].Lasttick := Tick + 200 - else - JoyUnit.HatState[3].Lasttick := Tick + 500; - - JoyUnit.HatState[3].State := True; - - JoyEvent.type_ := JoyUnit.HatState[3].Type_; - JoyEvent.key.keysym.sym := JoyUnit.HatState[3].Sym; - SDL_PushEvent(@JoyEvent); - end; - end - else - JoyUnit.HatState[3].State := False; - end; - -end; - -end. diff --git a/src/Classes/ULCD.pas b/src/Classes/ULCD.pas deleted file mode 100644 index 82f7ba2f..00000000 --- a/src/Classes/ULCD.pas +++ /dev/null @@ -1,304 +0,0 @@ -unit ULCD; - -interface - -{$I switches.inc} - -type - TLCD = class - private - Enabled: boolean; - Text: array[1..6] of string; - StartPos: integer; - LineBR: integer; - Position: integer; - procedure WriteCommand(B: byte); - procedure WriteData(B: byte); - procedure WriteString(S: string); - public - HalfInterface: boolean; - constructor Create; - procedure Enable; - procedure Clear; - procedure WriteText(Line: integer; S: string); - procedure MoveCursor(Line, Pos: integer); - procedure ShowCursor; - procedure HideCursor; - - // for 2x16 - procedure AddTextBR(S: string); - procedure MoveCursorBR(Pos: integer); - procedure ScrollUpBR; - procedure AddTextArray(Line:integer; S: string); - end; - -var - LCD: TLCD; - -const - Data = $378; // domyœlny adres portu - Status = Data + 1; - Control = Data + 2; - -implementation - -uses - SysUtils, - {$IFDEF UseSerialPort} - zlportio, - {$ENDIF} - SDL, - UTime; - -procedure TLCD.WriteCommand(B: Byte); -// Wysylanie komend sterujacych -begin -{$IFDEF UseSerialPort} - if not HalfInterface then - begin - zlioportwrite(Control, 0, $02); - zlioportwrite(Data, 0, B); - zlioportwrite(Control, 0, $03); - end - else - begin - zlioportwrite(Control, 0, $02); - zlioportwrite(Data, 0, B and $F0); - zlioportwrite(Control, 0, $03); - - SDL_Delay( 100 ); - - zlioportwrite(Control, 0, $02); - zlioportwrite(Data, 0, (B * 16) and $F0); - zlioportwrite(Control, 0, $03); - end; - - if (B=1) or (B=2) then - Sleep(2) - else - SDL_Delay( 100 ); -{$ENDIF} -end; - -procedure TLCD.WriteData(B: Byte); -// Wysylanie danych -begin -{$IFDEF UseSerialPort} - if not HalfInterface then - begin - zlioportwrite(Control, 0, $06); - zlioportwrite(Data, 0, B); - zlioportwrite(Control, 0, $07); - end - else - begin - zlioportwrite(Control, 0, $06); - zlioportwrite(Data, 0, B and $F0); - zlioportwrite(Control, 0, $07); - - SDL_Delay( 100 ); - - zlioportwrite(Control, 0, $06); - zlioportwrite(Data, 0, (B * 16) and $F0); - zlioportwrite(Control, 0, $07); - end; - - SDL_Delay( 100 ); - Inc(Position); -{$ENDIF} -end; - -procedure TLCD.WriteString(S: string); -// Wysylanie slow -var - I: integer; -begin - for I := 1 to Length(S) do - WriteData(Ord(S[I])); -end; - -constructor TLCD.Create; -begin - inherited; -end; - -procedure TLCD.Enable; -{var - A: byte; - B: byte;} -begin - Enabled := true; - if not HalfInterface then - WriteCommand($38) - else begin - WriteCommand($33); - WriteCommand($32); - WriteCommand($28); - end; - -// WriteCommand($06); -// WriteCommand($0C); -// sleep(10); -end; - -procedure TLCD.Clear; -begin - if Enabled then begin - WriteCommand(1); - WriteCommand(2); - Text[1] := ''; - Text[2] := ''; - Text[3] := ''; - Text[4] := ''; - Text[5] := ''; - Text[6] := ''; - StartPos := 1; - LineBR := 1; - end; -end; - -procedure TLCD.WriteText(Line: integer; S: string); -begin - if Enabled then begin - if Line <= 2 then begin - MoveCursor(Line, 1); - WriteString(S); - end; - - Text[Line] := ''; - AddTextArray(Line, S); - end; -end; - -procedure TLCD.MoveCursor(Line, Pos: integer); -var - I: integer; -begin - if Enabled then begin - Pos := Pos + (Line-1) * 40; - - if Position > Pos then begin - WriteCommand(2); - for I := 1 to Pos-1 do - WriteCommand(20); - end; - - if Position < Pos then - for I := 1 to Pos - Position do - WriteCommand(20); - - Position := Pos; - end; -end; - -procedure TLCD.ShowCursor; -begin - if Enabled then begin - WriteCommand(14); - end; -end; - -procedure TLCD.HideCursor; -begin - if Enabled then begin - WriteCommand(12); - end; -end; - -procedure TLCD.AddTextBR(S: string); -var - Word: string; -// W: integer; - P: integer; - L: integer; -begin - if Enabled then begin - if LineBR <= 6 then begin - L := LineBR; - P := Pos(' ', S); - - if L <= 2 then - MoveCursor(L, 1); - - while (L <= 6) and (P > 0) do begin - Word := Copy(S, 1, P); - if (Length(Text[L]) + Length(Word)-1) > 16 then begin - L := L + 1; - if L <= 2 then - MoveCursor(L, 1); - end; - - if L <= 6 then begin - if L <= 2 then - WriteString(Word); - AddTextArray(L, Word); - end; - - Delete(S, 1, P); - P := Pos(' ', S) - end; - - LineBR := L + 1; - end; - end; -end; - -procedure TLCD.MoveCursorBR(Pos: integer); -{var - I: integer; - L: integer;} -begin - if Enabled then begin - Pos := Pos - (StartPos-1); - if Pos <= Length(Text[1]) then - MoveCursor(1, Pos); - - if Pos > Length(Text[1]) then begin - // bez zawijania -// Pos := Pos - Length(Text[1]); -// MoveCursor(2, Pos); - - // z zawijaniem - Pos := Pos - Length(Text[1]); - ScrollUpBR; - MoveCursor(1, Pos); - end; - end; -end; - -procedure TLCD.ScrollUpBR; -var - T: array[1..5] of string; - SP: integer; - LBR: integer; -begin - if Enabled then begin - T[1] := Text[2]; - T[2] := Text[3]; - T[3] := Text[4]; - T[4] := Text[5]; - T[5] := Text[6]; - SP := StartPos + Length(Text[1]); - LBR := LineBR; - - Clear; - - StartPos := SP; - WriteText(1, T[1]); - WriteText(2, T[2]); - WriteText(3, T[3]); - WriteText(4, T[4]); - WriteText(5, T[5]); - LineBR := LBR-1; - end; -end; - -procedure TLCD.AddTextArray(Line: integer; S: string); -begin - if Enabled then begin - Text[Line] := Text[Line] + S; - end; -end; - -end. - diff --git a/src/Classes/ULanguage.pas b/src/Classes/ULanguage.pas deleted file mode 100644 index d534b4e1..00000000 --- a/src/Classes/ULanguage.pas +++ /dev/null @@ -1,240 +0,0 @@ -unit ULanguage; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -type - TLanguageEntry = record - ID: string; - Text: string; - end; - - TLanguageList = record - Name: string; - {FileName: string; } - end; - - TLanguage = class - public - Entry: array of TLanguageEntry; //Entrys of Chosen Language - SEntry: array of TLanguageEntry; //Entrys of Standard Language - CEntry: array of TLanguageEntry; //Constant Entrys e.g. Version - Implode_Glue1, Implode_Glue2: String; - public - List: array of TLanguageList; - - constructor Create; - procedure LoadList; - function Translate(Text: String): String; - procedure ChangeLanguage(Language: String); - procedure AddConst(ID, Text: String); - procedure ChangeConst(ID, Text: String); - function Implode(Pieces: Array of String): String; - end; - -var - Language: TLanguage; - -implementation - -uses UMain, - // UFiles, - UIni, - IniFiles, - Classes, - SysUtils, - {$IFDEF win32} - windows, - {$ENDIF} - ULog; - -//---------- -//Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues -//---------- -constructor TLanguage.Create; -var - I, J: Integer; -begin - inherited; - - LoadList; - - //Set Implode Glues for Backward Compatibility - Implode_Glue1 := ', '; - Implode_Glue2 := ' and '; - - if (Length(List) = 0) then //No Language Files Loaded -> Abort Loading - Log.CriticalError('Could not load any Language File'); - - //Standard Language (If a Language File is Incomplete) - //Then use English Language - for I := 0 to high(List) do //Search for English Language - begin - //English Language Found -> Load - if Uppercase(List[I].Name) = 'ENGLISH' then - begin - ChangeLanguage('English'); - - SetLength(SEntry, Length(Entry)); - for J := low(Entry) to high(Entry) do - SEntry[J] := Entry[J]; - - SetLength(Entry, 0); - - Break; - end; - - if (I = high(List)) then - Log.LogError('English Languagefile missing! No standard Translation loaded'); - end; - //Standard Language END - -end; - -//---------- -//LoadList - Parse the Language Dir searching Translations -//---------- -procedure TLanguage.LoadList; -var - SR: TSearchRec; // for parsing directory -begin - SetLength(List, 0); - SetLength(ILanguage, 0); - - if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then begin - repeat - SetLength(List, Length(List)+1); - SetLength(ILanguage, Length(ILanguage)+1); - SR.Name := ChangeFileExt(SR.Name, ''); - - List[High(List)].Name := SR.Name; - ILanguage[High(ILanguage)] := SR.Name; - - until FindNext(SR) <> 0; - SysUtils.FindClose(SR); - end; // if FindFirst -end; - -//---------- -//ChangeLanguage - Load the specified LanguageFile -//---------- -procedure TLanguage.ChangeLanguage(Language: String); -var - IniFile: TIniFile; - E: integer; // entry - S: TStringList; -begin - SetLength(Entry, 0); - IniFile := TIniFile.Create(LanguagesPath + Language + '.ini'); - S := TStringList.Create; - - IniFile.ReadSectionValues('Text', S); - SetLength(Entry, S.Count); - for E := 0 to high(Entry) do - begin - if S.Names[E] = 'IMPLODE_GLUE1' then - Implode_Glue1 := S.ValueFromIndex[E]+ ' ' - else if S.Names[E] = 'IMPLODE_GLUE2' then - Implode_Glue2 := ' ' + S.ValueFromIndex[E] + ' '; - - Entry[E].ID := S.Names[E]; - Entry[E].Text := S.ValueFromIndex[E]; - end; - - S.Free; - IniFile.Free; -end; - -//---------- -//Translate - Translate the Text -//---------- -Function TLanguage.Translate(Text: String): String; -var - E: integer; // entry -begin - Result := Text; - Text := Uppercase(Result); - - //Const Mod - for E := 0 to high(CEntry) do - if Text = CEntry[E].ID then - begin - Result := CEntry[E].Text; - exit; - end; - //Const Mod End - - for E := 0 to high(Entry) do - if Text = Entry[E].ID then - begin - Result := Entry[E].Text; - exit; - end; - - //Standard Language (If a Language File is Incomplete) - //Then use Standard Language - for E := low(SEntry) to high(SEntry) do - if Text = SEntry[E].ID then - begin - Result := SEntry[E].Text; - Break; - end; - //Standard Language END -end; - -//---------- -//AddConst - Add a Constant ID that will be Translated but not Loaded from the LanguageFile -//---------- -procedure TLanguage.AddConst (ID, Text: String); -begin - SetLength (CEntry, Length(CEntry) + 1); - CEntry[high(CEntry)].ID := ID; - CEntry[high(CEntry)].Text := Text; -end; - -//---------- -//ChangeConst - Change a Constant Value by ID -//---------- -procedure TLanguage.ChangeConst(ID, Text: String); -var - I: Integer; -begin - for I := 0 to high(CEntry) do - begin - if CEntry[I].ID = ID then - begin - CEntry[I].Text := Text; - Break; - end; - end; -end; - -//---------- -//Implode - Connect an Array of Strings with ' and ' or ', ' to one String -//---------- -function TLanguage.Implode(Pieces: Array of String): String; -var - I: Integer; -begin - Result := ''; - //Go through Pieces - for I := low(Pieces) to high(Pieces) do - begin - //Add Value - Result := Result + Pieces[I]; - - //Add Glue - if (I < high(Pieces) - 1) then - Result := Result + Implode_Glue1 - else if (I < high(Pieces)) then - Result := Result + Implode_Glue2; - end; -end; - -end. diff --git a/src/Classes/ULight.pas b/src/Classes/ULight.pas deleted file mode 100644 index a0a399ab..00000000 --- a/src/Classes/ULight.pas +++ /dev/null @@ -1,145 +0,0 @@ -unit ULight; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -type - TLight = class - private - Enabled: boolean; - Light: array[0..7] of boolean; - LightTime: array[0..7] of real; // time to stop, need to call update to change state - LastTime: real; - public - constructor Create; - procedure Enable; - procedure SetState(State: integer); - procedure AutoSetState; - procedure TurnOn; - procedure TurnOff; - procedure LightOne(Number: integer; Time: real); - procedure Refresh; - end; - -var - Light: TLight; - -const - Data = $378; // default port address - Status = Data + 1; - Control = Data + 2; - -implementation - -uses - SysUtils, - {$IFDEF UseSerialPort} - zlportio, - {$ENDIF} - UTime; - -{$IFDEF FPC} - - function GetTime: TDateTime; - var - SystemTime: TSystemTime; - begin - GetLocalTime(SystemTime); - with SystemTime do - begin - {$IFDEF UNIX} - Result := EncodeTime(Hour, Minute, Second, MilliSecond); - {$ELSE} - Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds); - {$ENDIF} - end; - end; - -{$ENDIF} - - -constructor TLight.Create; -begin - inherited; - Enabled := false; -end; - -procedure TLight.Enable; -begin - Enabled := true; - LastTime := GetTime; -end; - -procedure TLight.SetState(State: integer); -begin - {$IFDEF UseSerialPort} - if Enabled then - PortWriteB($378, State); - {$ENDIF} -end; - -procedure TLight.AutoSetState; -var - State: integer; -begin - if Enabled then begin - State := 0; - if Light[0] then State := State + 2; - if Light[1] then State := State + 1; - // etc - SetState(State); - end; -end; - -procedure TLight.TurnOn; -begin - if Enabled then - SetState(3); -end; - -procedure TLight.TurnOff; -begin - if Enabled then - SetState(0); -end; - -procedure TLight.LightOne(Number: integer; Time: real); -begin - if Enabled then begin - if Light[Number] = false then begin - Light[Number] := true; - AutoSetState; - end; - - LightTime[Number] := GetTime + Time/1000; // [s] - end; -end; - -procedure TLight.Refresh; -var - Time: real; - L: integer; -begin - if Enabled then begin - Time := GetTime; - for L := 0 to 7 do begin - if Light[L] = true then begin - if LightTime[L] > Time then begin - end else begin - Light[L] := false; - end; - end; - end; - LastTime := Time; - AutoSetState; - end; -end; - -end. - - diff --git a/src/Classes/ULog.pas b/src/Classes/ULog.pas deleted file mode 100644 index a9a2f3c4..00000000 --- a/src/Classes/ULog.pas +++ /dev/null @@ -1,417 +0,0 @@ -unit ULog; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes; - -(* - * LOG_LEVEL_[TYPE] defines the "minimum" index for logs of type TYPE. Each - * level greater than this BUT less or equal than LOG_LEVEL_[TYPE]_MAX is of this type. - * This means a level "LOG_LEVEL_ERROR >= Level <= LOG_LEVEL_ERROR_MAX" e.g. - * "Level := LOG_LEVEL_ERROR+2" is considered an error level. - * This is nice for debugging if you have more or less important debug messages. - * For example you can assign LOG_LEVEL_DEBUG+10 for the more important ones and - * LOG_LEVEL_DEBUG+20 for less important ones and so on. By changing the log-level - * you can hide the less important ones. - *) -const - LOG_LEVEL_DEBUG_MAX = MaxInt; - LOG_LEVEL_DEBUG = 50; - LOG_LEVEL_INFO_MAX = LOG_LEVEL_DEBUG-1; - LOG_LEVEL_INFO = 40; - LOG_LEVEL_STATUS_MAX = LOG_LEVEL_INFO-1; - LOG_LEVEL_STATUS = 30; - LOG_LEVEL_WARN_MAX = LOG_LEVEL_STATUS-1; - LOG_LEVEL_WARN = 20; - LOG_LEVEL_ERROR_MAX = LOG_LEVEL_WARN-1; - LOG_LEVEL_ERROR = 10; - LOG_LEVEL_CRITICAL_MAX = LOG_LEVEL_ERROR-1; - LOG_LEVEL_CRITICAL = 0; - LOG_LEVEL_NONE = -1; - - // define level that Log(File)Level is initialized with - LOG_LEVEL_DEFAULT = LOG_LEVEL_WARN; - LOG_FILE_LEVEL_DEFAULT = LOG_LEVEL_ERROR; - -type - TLog = class - private - LogFile: TextFile; - LogFileOpened: boolean; - BenchmarkFile: TextFile; - BenchmarkFileOpened: boolean; - - LogLevel: integer; - // level of messages written to the log-file - LogFileLevel: integer; - - procedure LogToFile(const Text: string); - public - BenchmarkTimeStart: array[0..31] of real; - BenchmarkTimeLength: array[0..31] of real;//TDateTime; - - Title: String; //Application Title - - // Write log message to log-file - FileOutputEnabled: Boolean; - - constructor Create; - - // destuctor - destructor Destroy; override; - - // benchmark - procedure BenchmarkStart(Number: integer); - procedure BenchmarkEnd(Number: integer); - procedure LogBenchmark(const Text: string; Number: integer); - - procedure SetLogLevel(Level: integer); - function GetLogLevel(): integer; - - procedure LogMsg(const Text: string; Level: integer); overload; - procedure LogMsg(const Msg, Context: string; Level: integer); overload; {$IFDEF HasInline}inline;{$ENDIF} - procedure LogDebug(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} - procedure LogInfo(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} - procedure LogStatus(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} - procedure LogWarn(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} - procedure LogError(const Text: string); overload; {$IFDEF HasInline}inline;{$ENDIF} - procedure LogError(const Msg, Context: string); overload; {$IFDEF HasInline}inline;{$ENDIF} - //Critical Error (Halt + MessageBox) - procedure LogCritical(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} - procedure CriticalError(const Text: string); {$IFDEF HasInline}inline;{$ENDIF} - - // voice - procedure LogVoice(SoundNr: integer); - // buffer - procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : string); - end; - -procedure DebugWriteln(const aString: String); - -var - Log: TLog; - -implementation - -uses - SysUtils, - DateUtils, - URecord, - UMain, - UTime, - UCommon, - UCommandLine; - -(* - * Write to console if in debug mode (Thread-safe). - * If debug-mode is disabled nothing is done. - *) -procedure DebugWriteln(const aString: string); -begin - {$IFNDEF DEBUG} - if Params.Debug then - begin - {$ENDIF} - ConsoleWriteLn(aString); - {$IFNDEF DEBUG} - end; - {$ENDIF} -end; - - -constructor TLog.Create; -begin - inherited; - LogLevel := LOG_LEVEL_DEFAULT; - LogFileLevel := LOG_FILE_LEVEL_DEFAULT; - FileOutputEnabled := true; -end; - -destructor TLog.Destroy; -begin - if BenchmarkFileOpened then - CloseFile(BenchmarkFile); - //if AnalyzeFileOpened then - // CloseFile(AnalyzeFile); - if LogFileOpened then - CloseFile(LogFile); - inherited; -end; - -procedure TLog.BenchmarkStart(Number: integer); -begin - BenchmarkTimeStart[Number] := USTime.GetTime; //Time; -end; - -procedure TLog.BenchmarkEnd(Number: integer); -begin - BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number]; -end; - -procedure TLog.LogBenchmark(const Text: string; Number: integer); -var - Minutes: integer; - Seconds: integer; - Miliseconds: integer; - - MinutesS: string; - SecondsS: string; - MilisecondsS: string; - - ValueText: string; -begin - if (FileOutputEnabled and Params.Benchmark) then - begin - if not BenchmarkFileOpened then - begin - BenchmarkFileOpened := true; - AssignFile(BenchmarkFile, LogPath + 'Benchmark.log'); - {$I-} - Rewrite(BenchmarkFile); - if IOResult = 0 then - BenchmarkFileOpened := true; - {$I+} - - //If File is opened write Date to Benchmark File - If (BenchmarkFileOpened) then - begin - WriteLn(BenchmarkFile, Title + ' Benchmark File'); - WriteLn(BenchmarkFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); - WriteLn(BenchmarkFile, '-------------------'); - - Flush(BenchmarkFile); - end; - end; - - if BenchmarkFileOpened then - begin - Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000); - Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60; - Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60); - //ValueText := FloatToStr(BenchmarkTimeLength[Number]); - - { - ValueText := FloatToStr(SecondOf(BenchmarkTimeLength[Number]) + - MilliSecondOf(BenchmarkTimeLength[Number])/1000); - if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then - ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText; - WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds'); - } - - if (Minutes = 0) and (Seconds = 0) then begin - MilisecondsS := IntToStr(Miliseconds); - ValueText := MilisecondsS + ' miliseconds'; - end; - - if (Minutes = 0) and (Seconds >= 1) then begin - MilisecondsS := IntToStr(Miliseconds); - while Length(MilisecondsS) < 3 do - MilisecondsS := '0' + MilisecondsS; - - SecondsS := IntToStr(Seconds); - - ValueText := SecondsS + ',' + MilisecondsS + ' seconds'; - end; - - if Minutes >= 1 then begin - MilisecondsS := IntToStr(Miliseconds); - while Length(MilisecondsS) < 3 do - MilisecondsS := '0' + MilisecondsS; - - SecondsS := IntToStr(Seconds); - while Length(SecondsS) < 2 do - SecondsS := '0' + SecondsS; - - MinutesS := IntToStr(Minutes); - - ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes'; - end; - - WriteLn(BenchmarkFile, Text + ': ' + ValueText); - Flush(BenchmarkFile); - end; - end; -end; - -procedure TLog.LogToFile(const Text: string); -begin - if (FileOutputEnabled and not LogFileOpened) then - begin - AssignFile(LogFile, LogPath + 'Error.log'); - {$I-} - Rewrite(LogFile); - if IOResult = 0 then - LogFileOpened := true; - {$I+} - - //If File is opened write Date to Error File - if (LogFileOpened) then - begin - WriteLn(LogFile, Title + ' Error Log'); - WriteLn(LogFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); - WriteLn(LogFile, '-------------------'); - - Flush(LogFile); - end; - end; - - if LogFileOpened then - begin - try - WriteLn(LogFile, Text); - Flush(LogFile); - except - LogFileOpened := false; - end; - end; -end; - -procedure TLog.SetLogLevel(Level: integer); -begin - LogLevel := Level; -end; - -function TLog.GetLogLevel(): integer; -begin - Result := LogLevel; -end; - -procedure TLog.LogMsg(const Text: string; Level: integer); -var - LogMsg: string; -begin - // TODO: what if (LogFileLevel < LogLevel)? Log to file without printing to - // console or do not log at all? At the moment nothing is logged. - if (Level <= LogLevel) then - begin - if (Level <= LOG_LEVEL_CRITICAL_MAX) then - LogMsg := 'CRITICAL: ' + Text - else if (Level <= LOG_LEVEL_ERROR_MAX) then - LogMsg := 'ERROR: ' + Text - else if (Level <= LOG_LEVEL_WARN_MAX) then - LogMsg := 'WARN: ' + Text - else if (Level <= LOG_LEVEL_STATUS_MAX) then - LogMsg := 'STATUS: ' + Text - else if (Level <= LOG_LEVEL_INFO_MAX) then - LogMsg := 'INFO: ' + Text - else - LogMsg := 'DEBUG: ' + Text; - - // output log-message - if (Level <= LogLevel) then - begin - DebugWriteLn(LogMsg); - end; - - // write message to log-file - if (Level <= LogFileLevel) then - begin - LogToFile(LogMsg); - end; - end; - - // exit application on criticial errors (cannot be turned off) - if (Level <= LOG_LEVEL_CRITICAL_MAX) then - begin - // Show information (window) - ShowMessage(Text, mtError); - Halt; - end; -end; - -procedure TLog.LogMsg(const Msg, Context: string; Level: integer); -begin - LogMsg(Msg + ' ['+Context+']', Level); -end; - -procedure TLog.LogDebug(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_DEBUG); -end; - -procedure TLog.LogInfo(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_INFO); -end; - -procedure TLog.LogStatus(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_STATUS); -end; - -procedure TLog.LogWarn(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_WARN); -end; - -procedure TLog.LogError(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_ERROR); -end; - -procedure TLog.LogError(const Text: string); -begin - LogMsg(Text, LOG_LEVEL_ERROR); -end; - -procedure TLog.CriticalError(const Text: string); -begin - LogMsg(Text, LOG_LEVEL_CRITICAL); -end; - -procedure TLog.LogCritical(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_CRITICAL); -end; - -procedure TLog.LogVoice(SoundNr: integer); -var - FS: TFileStream; - FileName: string; - Num: integer; -begin - for Num := 1 to 9999 do begin - FileName := IntToStr(Num); - while Length(FileName) < 4 do - FileName := '0' + FileName; - FileName := LogPath + 'Voice' + FileName + '.raw'; - if not FileExists(FileName) then - break - end; - - FS := TFileStream.Create(FileName, fmCreate); - - AudioInputProcessor.Sound[SoundNr].LogBuffer.Seek(0, soBeginning); - FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].LogBuffer, AudioInputProcessor.Sound[SoundNr].LogBuffer.Size); - - FS.Free; -end; - -procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: string); -var - f : TFileStream; -begin - f := nil; - - try - f := TFileStream.Create( filename, fmCreate); - f.Write( buf^, bufLength); - f.Free; - except - on e : Exception do begin - Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message); - f.Free; - end; - end; -end; - -end. - - diff --git a/src/Classes/ULyrics.pas b/src/Classes/ULyrics.pas deleted file mode 100644 index 305cb91f..00000000 --- a/src/Classes/ULyrics.pas +++ /dev/null @@ -1,884 +0,0 @@ -unit ULyrics; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - gl, - glext, - UTexture, - UThemes, - UMusic; - -type - // stores two textures for enabled/disabled states - TPlayerIconTex = array [0..1] of TTexture; - - PLyricWord = ^TLyricWord; - TLyricWord = record - X: Real; // left corner - Width: Real; // width - Start: Cardinal; // start of the word in quarters (beats) - Length: Cardinal; // length of the word in quarters - Text: String; // text - Freestyle: Boolean; // is freestyle? - end; - ALyricWord = array of TLyricWord; - - TLyricLine = class - public - Text: String; // text - Tex: glUInt; // texture of the text - Width: Real; // width - Size: Byte; // fontsize - Words: ALyricWord; // words in this line - CurWord: Integer; // current active word idx (only valid if line is active) - Start: Integer; // start of this line in quarters (Note: negative start values are possible due to gap) - StartNote: Integer; // start of the first note of this line in quarters - Length: Integer; // length in quarters (from start of first to the end of the last note) - HasFreestyle: Boolean; // one or more word are freestyle? - CountFreestyle: Integer; // how often there is a change from freestyle to non freestyle in this line - Players: Byte; // players that should sing that line (bitset, Player1: 1, Player2: 2, Player3: 4) - LastLine: Boolean; // is this the last line of the song? - - constructor Create(); - destructor Destroy(); override; - procedure Reset(); - end; - - TLyricEngine = class - private - LastDrawBeat: Real; - UpperLine: TLyricLine; // first line displayed (top) - LowerLine: TLyricLine; // second lind displayed (bottom) - QueueLine: TLyricLine; // third line (will be displayed when lower line is finished) - - IndicatorTex: TTexture; // texture for lyric indikator - BallTex: TTexture; // texture of the ball for the lyric effect - - QueueFull: Boolean; // set to true if the queue is full and a line will be replaced with the next AddLine - LCounter: Word; // line counter - - // duet mode - textures for player icons - // FIXME: do not use a fixed player count, use MAX_PLAYERS instead - PlayerIconTex: array[0..5] of TPlayerIconTex; - - //Some helper Procedures for Lyric Drawing - procedure DrawLyrics (Beat: Real); - procedure DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real); - procedure DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real); - procedure DrawBall(XBall, YBall, Alpha:Real); - - public - // positions, line specific settings - UpperLineX: Real; //X Start Pos of UpperLine - UpperLineW: Real; //Width of UpperLine with Icon(s) and Text - UpperLineY: Real; //Y Start Pos of UpperLine - UpperLineSize: Byte; //Max Size of Lyrics Text in UpperLine - - LowerLineX: Real; //X Start Pos of LowerLine - LowerLineW: Real; //Width of LowerLine with Icon(s) and Text - LowerLineY: Real; //Y Start Pos of LowerLine - LowerLineSize: Byte; //Max Size of Lyrics Text in LowerLine - - // display propertys - LineColor_en: TRGBA; //Color of Words in an Enabled Line - LineColor_dis: TRGBA; //Color of Words in a Disabled Line - LineColor_act: TRGBA; //Color of teh active Word - FontStyle: Byte; //Font for the Lyric Text - FontReSize: Boolean; //ReSize Lyrics if they don't fit Screen - - { // currently not used - FadeInEffect: Byte; //Effect for Line Fading in: 0: No Effect; 1: Fade Effect; 2: Move Upwards from Bottom to Pos - FadeOutEffect: Byte; //Effect for Line Fading out: 0: No Effect; 1: Fade Effect; 2: Move Upwards - } - - UseLinearFilter: Boolean; //Should Linear Tex Filter be used - - // song specific settings - BPM: Real; - Resolution: Integer; - - // properties to easily read options of this class - property IsQueueFull: Boolean read QueueFull; // line in queue? - property LineCounter: Word read LCounter; // lines that were progressed so far (after last clear) - - procedure AddLine(Line: PLine); // adds a line to the queue, if there is space - procedure Draw (Beat: Real); // draw the current (active at beat) lyrics - - // clears all cached song specific information - procedure Clear(cBPM: Real = 0; cResolution: Integer = 0); - - function GetUpperLine(): TLyricLine; - function GetLowerLine(): TLyricLine; - - function GetUpperLineIndex(): Integer; - - constructor Create; overload; - constructor Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS: Real); overload; - procedure LoadTextures; - destructor Destroy; override; - end; - -implementation - -uses SysUtils, - USkins, - TextGL, - UGraphic, - UDisplay, - ULog, - math, - UIni; - -//----------- -//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else -//----------- -procedure glColorRGB(Color: TRGB); overload; -begin - glColor3f(Color.R, Color.G, Color.B); -end; - -procedure glColorRGB(Color: TRGB; Alpha: Real); overload; -begin - glColor4f(Color.R, Color.G, Color.B, Alpha); -end; - -procedure glColorRGB(Color: TRGBA); overload; -begin - glColor4f(Color.R, Color.G, Color.B, Color.A); -end; - -procedure glColorRGB(Color: TRGBA; Alpha: Real); overload; -begin - glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha)); -end; - -{ TLyricLine } - -constructor TLyricLine.Create(); -begin - inherited; - Reset(); -end; - -destructor TLyricLine.Destroy(); -begin - SetLength(Words, 0); - inherited; -end; - -procedure TLyricLine.Reset(); -begin - Start := 0; - StartNote := 0; - Length := 0; - LastLine := False; - - Text := ''; - Width := 0; - - // duet mode: players of that line (default: all) - Players := $FF; - - SetLength(Words, 0); - CurWord := -1; - - HasFreestyle := False; - CountFreestyle := 0; -end; - - -{ TLyricEngine } - -//--------------- -// Create - Constructor, just get Memory -//--------------- -constructor TLyricEngine.Create; -begin - inherited; - - BPM := 0; - Resolution := 0; - LCounter := 0; - QueueFull := False; - - UpperLine := TLyricLine.Create; - LowerLine := TLyricLine.Create; - QueueLine := TLyricLine.Create; - - UseLinearFilter := True; - LastDrawBeat := 0; -end; - -constructor TLyricEngine.Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); -begin - Create; - - UpperLineX := ULX; - UpperLineW := ULW; - UpperLineY := ULY; - UpperLineSize := Trunc(ULS); - - LowerLineX := LLX; - LowerLineW := LLW; - LowerLineY := LLY; - LowerLineSize := Trunc(LLS); - - LoadTextures; -end; - - -//--------------- -// Destroy - Frees Memory -//--------------- -destructor TLyricEngine.Destroy; -begin - UpperLine.Free; - LowerLine.Free; - QueueLine.Free; - inherited; -end; - -//--------------- -// Clear - Clears all cached Song specific Information -//--------------- -procedure TLyricEngine.Clear(cBPM: Real; cResolution: Integer); -begin - BPM := cBPM; - Resolution := cResolution; - LCounter := 0; - QueueFull := False; - - LastDrawBeat:=0; -end; - - -//--------------- -// LoadTextures - Load Player Textures and Create Lyric Textures -//--------------- -procedure TLyricEngine.LoadTextures; -var - I: Integer; - - function CreateLineTex: glUint; - begin - // generate and bind Texture - glGenTextures(1, @Result); - glBindTexture(GL_TEXTURE_2D, Result); - - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - if UseLinearFilter then - begin - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - end; - end; - -begin - - // lyric indicator (bar that indicates when the line start) - IndicatorTex := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); - - // ball for current word hover in ball effect - BallTex := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, 0); - - // duet mode: load player icon - for I := 0 to 5 do - begin - PlayerIconTex[I][0] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0); - PlayerIconTex[I][1] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0); - end; - - // create line textures - UpperLine.Tex := CreateLineTex; - LowerLine.Tex := CreateLineTex; - QueueLine.Tex := CreateLineTex; -end; - - -//--------------- -// AddLine - Adds LyricLine to queue -// The LyricEngine stores three lines in its queue: -// UpperLine: the upper line displayed in the lyrics -// LowerLine: the lower line displayed in the lyrics -// QueueLine: an offscreen line that precedes LowerLine -// If the queue is full the next call to AddLine will replace UpperLine with -// LowerLine, LowerLine with QueueLine and QueueLine with the Line parameter. -//--------------- -procedure TLyricEngine.AddLine(Line: PLine); -var - LyricLine: TLyricLine; - PosX: Real; - I: Integer; - CurWord: PLyricWord; - RenderPass: Integer; - - function CalcWidth(LyricLine: TLyricLine): Real; - begin - Result := glTextWidth(PChar(LyricLine.Text)); - - Result := Result + (LyricLine.CountFreestyle * 10); - - // if the line ends with a freestyle not, then leave the place to finish to draw the text italic - if (LyricLine.Words[High(LyricLine.Words)].Freestyle) then - Result := Result + 12; - end; - -begin - // only add lines, if there is space - if not IsQueueFull then - begin - // set LyricLine to line to write to - if (LineCounter = 0) then - LyricLine := UpperLine - else if (LineCounter = 1) then - LyricLine := LowerLine - else - begin - // now the queue is full - LyricLine := QueueLine; - QueueFull := True; - end; - end - else - begin // rotate lines (round-robin-like) - LyricLine := UpperLine; - UpperLine := LowerLine; - LowerLine := QueueLine; - QueueLine := LyricLine; - end; - - // reset line state - LyricLine.Reset(); - - // check if sentence has notes - if (Line <> nil) and (Length(Line.Note) > 0) then - begin - // copy values from SongLine to LyricLine - LyricLine.Start := Line.Start; - LyricLine.StartNote := Line.Note[0].Start; - LyricLine.Length := Line.Note[High(Line.Note)].Start + - Line.Note[High(Line.Note)].Length - - Line.Note[0].Start; - LyricLine.LastLine := Line.LastLine; - - // copy words - SetLength(LyricLine.Words, Length(Line.Note)); - for I := 0 to High(Line.Note) do - begin - LyricLine.Words[I].Start := Line.Note[I].Start; - LyricLine.Words[I].Length := Line.Note[I].Length; - LyricLine.Words[I].Text := Line.Note[I].Text; - LyricLine.Words[I].Freestyle := Line.Note[I].NoteType = ntFreestyle; - - LyricLine.HasFreestyle := LyricLine.HasFreestyle or LyricLine.Words[I].Freestyle; - LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text; - - if (I > 0) and - LyricLine.Words[I-1].Freestyle and - not LyricLine.Words[I].Freestyle then - begin - Inc(LyricLine.CountFreestyle); - end; - end; - - // set font params - SetFontStyle(FontStyle); - SetFontPos(0, 0); - LyricLine.Size := UpperLineSize; - SetFontSize(LyricLine.Size); - SetFontItalic(False); - SetFontReflection(False, 0); - glColor4f(1, 1, 1, 1); - - // change fontsize to fit the screen - LyricLine.Width := CalcWidth(LyricLine); - while (LyricLine.Width > UpperLineW) do - begin - Dec(LyricLine.Size); - - if (LyricLine.Size <=1) then - Break; - - SetFontSize(LyricLine.Size); - LyricLine.Width := CalcWidth(LyricLine); - end; - - // Offscreen rendering of LyricTexture: - // First we will create a white transparent background to draw on. - // If the text was simply drawn to the screen with blending, the translucent - // parts of the text would be merged with the current color of the background. - // This would result in a texture that partly contains the screen we are - // drawing on. This will be visible in the fonts outline when the LyricTexture - // is drawn to the screen later. - // So we have to draw the text in TWO passes. - // At the first pass we copy the characters to the back-buffer in such a way - // that preceding characters are not repainted by following chars (otherwise - // some characters would be blended twice in the 2nd pass). - // To achieve this we disable blending and enable the depth-test. The z-buffer - // is used as a mask or replacement for the missing stencil-buffer. A z-value - // of 1 means the pixel was not assigned yet, whereas 0 stands for a pixel - // that was already drawn on. In addition we set the depth-func in such a way - // that assigned pixels (0) will not be drawn a second time. - // At the second pass we draw the text with blending and without depth-test. - // This will blend overlapping characters but not the background as it was - // repainted in the first pass. - - glPushAttrib(GL_VIEWPORT_BIT or GL_DEPTH_BUFFER_BIT); - glViewPort(0, 0, 800, 600); - glClearColor(0, 0, 0, 0); - glDepthRange(0, 1); - glClearDepth(1); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - - SetFontZ(0); - - // assure blending is off and the correct depth-func is enabled - glDisable(GL_BLEND); - glDepthFunc(GL_LESS); - - // we need two passes to draw the font onto the screen. - for RenderPass := 0 to 1 do - begin - if (RenderPass = 0) then - begin - // first pass: simply copy each character to the screen without overlapping. - SetFontBlend(false); - glEnable(GL_DEPTH_TEST); - end - else - begin - // second pass: now we will blend overlapping characters. - SetFontBlend(true); - glDisable(GL_DEPTH_TEST); - end; - - PosX := 0; - - // set word positions and line size and draw the line to the back-buffer - for I := 0 to High(LyricLine.Words) do - begin - CurWord := @LyricLine.Words[I]; - - SetFontItalic(CurWord.Freestyle); - - CurWord.X := PosX; - - // Draw Lyrics - SetFontPos(PosX, 0); - glPrint(PChar(CurWord.Text)); - - CurWord.Width := glTextWidth(PChar(CurWord.Text)); - if CurWord.Freestyle then - begin - if (I < High(LyricLine.Words)) and not LyricLine.Words[I+1].Freestyle then - CurWord.Width := CurWord.Width + 10 - else if (I = High(LyricLine.Words)) then - CurWord.Width := CurWord.Width + 12; - end; - PosX := PosX + CurWord.Width; - end; - end; - - // copy back-buffer to texture - glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); - // FIXME: this does not work this way - glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 600-64, 1024, 64, 0); - if (glGetError() <> GL_NO_ERROR) then - Log.LogError('Creation of Lyrics-texture failed', 'TLyricEngine.AddLine'); - - // restore OpenGL state - glPopAttrib(); - - // clear buffer (use white to avoid flimmering if no cover/video is available) - glClearColor(1, 1, 1, 1); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - end; // if (Line <> nil) and (Length(Line.Note) > 0) - - // increase the counter - Inc(LCounter); -end; - - -//--------------- -// Draw - Procedure Draws Lyrics; Beat is curent Beat in Quarters -// Draw just manage the Lyrics, drawing is done by a call of DrawLyrics -//--------------- -procedure TLyricEngine.Draw(Beat: Real); -begin - DrawLyrics(Beat); - LastDrawBeat := Beat; -end; - -//--------------- -// DrawLyrics(private) - Helper for Draw; main Drawing procedure -//--------------- -procedure TLyricEngine.DrawLyrics(Beat: Real); -begin - DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, Upperline, Beat); - DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, Lowerline, Beat); -end; - -//--------------- -// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon -//--------------- -procedure TLyricEngine.DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real); -var - IEnabled: Byte; -begin - if Enabled then - IEnabled := 0 - else - IEnabled := 1; - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, PlayerIconTex[Player][IEnabled].TexNum); - - glColor4f(1, 1, 1, Alpha); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, 1); glVertex2f(X, Y + Size); - glTexCoord2f(1, 1); glVertex2f(X + Size, Y + Size); - glTexCoord2f(1, 0); glVertex2f(X + Size, Y); - glEnd; - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - -//--------------- -// DrawBall(private) - Helper for Draw; Draws the Ball over the LyricLine if needed -//--------------- -procedure TLyricEngine.DrawBall(XBall, YBall, Alpha: Real); -begin - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, BallTex.TexNum); - - glColor4f(1, 1, 1, Alpha); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(XBall - 10, YBall); - glTexCoord2f(0, 1); glVertex2f(XBall - 10, YBall + 20); - glTexCoord2f(1, 1); glVertex2f(XBall + 10, YBall + 20); - glTexCoord2f(1, 0); glVertex2f(XBall + 10, YBall); - glEnd; - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - -//--------------- -// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine -//--------------- -procedure TLyricEngine.DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real); -var - CurWordStart, CurWordEnd: Real; // screen coordinates of current word and the rest of the sentence - FreestyleDiff: Integer; // difference between top and bottom coordiantes for freestyle lyrics - Progress: Real; // progress of singing the current word - LyricX: Real; // left - LyricX2: Real; // right - LyricY: Real; // top - LyricsHeight: Real; // height the lyrics are displayed - Alpha: Real; // alphalevel to fade out at end - CurWord, LastWord: PLyricWord; // current word - - {// duet mode - IconSize: Real; // size of player icons - IconAlpha: Real; // alpha level of player icons - } -begin - // do not draw empty lines - // Note: lines with no words in it do not have a valid texture - if (Length(Line.Words) = 0) or - (Line.Width <= 0) then - begin - Exit; - end; - - // this is actually a bit more than the real font size - // it helps adjusting the "zoom-center" - LyricsHeight := 30.5 * (Line.Size/10); - - { - // duet mode - IconSize := (2 * Size); - IconAlpha := Frac(Beat/(Resolution*4)); - - DrawPlayerIcon (0, True, X, Y + (42 - IconSize) / 2 , IconSize, IconAlpha); - DrawPlayerIcon (1, True, X + IconSize + 1, Y + (42 - IconSize) / 2, IconSize, IconAlpha); - DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y + (42 - IconSize) / 2, IconSize, IconAlpha); - } - - LyricX := X + W/2 - Line.Width/2; - LyricX2 := LyricX + Line.Width; - - // maybe center smaller lines - //LyricY := Y; - LyricY := Y + ((Size / Line.Size - 1) * LyricsHeight) / 2; - - Alpha := 1; - - // check if this line is active (at least its first note must be active) - if (Beat >= Line.StartNote) then - begin - // if this line just got active, CurWord is -1, - // this means we should try to make the first word active - if (Line.CurWord = -1) then - Line.CurWord := 0; - - // check if the current active word is still active. - // Otherwise proceed to the next word if there is one in this line. - // Note: the max. value of Line.CurWord is High(Line.Words) - if (Line.CurWord < High(Line.Words)) and - (Beat >= Line.Words[Line.CurWord + 1].Start) then - begin - Inc(Line.CurWord); - end; - - FreestyleDiff := 0; - - // determine current and last word in this line. - // If the end of the line is reached use the last word as current word. - LastWord := @Line.Words[High(Line.Words)]; - CurWord := @Line.Words[Line.CurWord]; - - // calc the progress of the lyrics effect - Progress := (Beat - CurWord.Start) / CurWord.Length; - if Progress >= 1 then - Progress := 1; - if Progress <= 0 then - Progress := 0; - - // last word of this line finished, but this line did not hide -> fade out - if Line.LastLine and - (Beat > LastWord.Start + LastWord.Length) then - begin - Alpha := 1 - (Beat - (LastWord.Start + LastWord.Length)) / 15; - if (Alpha < 0) then - Alpha := 0; - end; - - // determine the start-/end positions of the fragment of the current word - CurWordStart := CurWord.X; - CurWordEnd := CurWord.X + CurWord.Width; - - // Slide Effect - // simply paint the active texture to the current position - if Ini.LyricsEffect = 2 then - begin - CurWordStart := CurWordStart + CurWord.Width * Progress; - CurWordEnd := CurWordStart; - end; - - if CurWord.Freestyle then - begin - if (Line.CurWord < High(Line.Words)) and - (not Line.Words[Line.CurWord + 1].Freestyle) then - begin - FreestyleDiff := 2; - end - else - begin - FreestyleDiff := 12; - CurWordStart := CurWordStart - 1; - CurWordEnd := CurWordEnd - 2; - end; - end; - - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, Line.Tex); - - // draw sentence up to current word - // type 0: simple lyric effect - // type 3: ball lyric effect - // type 4: shift lyric effect - if (Ini.LyricsEffect in [0, 3, 4]) then - // ball lyric effect - only highlight current word and not that ones before in this line - glColorRGB(LineColor_en, Alpha) - else - glColorRGB(LineColor_act, Alpha); - - glBegin(GL_QUADS); - glTexCoord2f(0, 1); - glVertex2f(LyricX, LyricY); - - glTexCoord2f(0, 1-LyricsHeight/64); - glVertex2f(LyricX, LyricY + LyricsHeight); - - glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64); - glVertex2f(LyricX + CurWordStart, LyricY + LyricsHeight); - - glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); - glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY); - glEnd; - - // draw rest of sentence - glColorRGB(LineColor_en, Alpha); - glBegin(GL_QUADS); - glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); - glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY); - - glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64); - glVertex2f(LyricX + CurWordEnd, LyricY + LyricsHeight); - - glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64); - glVertex2f(LyricX2, LyricY + LyricsHeight); - - glTexCoord2f(Line.Width/1024, 1); - glVertex2f(LyricX2, LyricY); - glEnd; - - // draw active word: - // type 0: simple lyric effect - // type 3: ball lyric effect - // type 4: shift lyric effect - // only change the color of the current word - if (Ini.LyricsEffect in [0, 3, 4]) then - begin - if (Ini.LyricsEffect = 4) then - LyricY := LyricY - 8 * (1-Progress); - - glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); - glBegin(GL_QUADS); - glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); - glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY); - - glTexCoord2f(CurWordStart/1024, 0); - glVertex2f(LyricX + CurWordStart, LyricY + 64); - - glTexCoord2f(CurWordEnd/1024, 0); - glVertex2f(LyricX + CurWordEnd, LyricY + 64); - - glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); - glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY); - glEnd; - - if (Ini.LyricsEffect = 4) then - LyricY := LyricY + 8 * (1-Progress); - end - - // draw active word: - // type 1: zoom lyric effect - // change color and zoom current word - else if Ini.LyricsEffect = 1 then - begin - glPushMatrix; - - glTranslatef(LyricX + CurWordStart + (CurWordEnd-CurWordStart)/2, - LyricY + LyricsHeight/2, 0); - - // set current zoom factor - glScalef(1.0 + (1-Progress) * 0.5, 1.0 + (1-Progress) * 0.5, 1.0); - - glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); - glBegin(GL_QUADS); - glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); - glVertex2f(-(CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2); - - glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64); - glVertex2f(-(CurWordEnd-CurWordStart)/2, LyricsHeight/2); - - glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64); - glVertex2f((CurWordEnd-CurWordStart)/2, LyricsHeight/2); - - glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); - glVertex2f((CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2); - glEnd; - - glPopMatrix; - end; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - // type 3: ball lyric effect - if Ini.LyricsEffect = 3 then - begin - DrawBall(LyricX + CurWordStart + (CurWordEnd-CurWordStart) * Progress, - LyricY - 15 - 15*sin(Progress * Pi), Alpha); - end; - end - else - begin - // this section is called if the whole line can be drawn at once and no - // word has to be emphasized. - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Line.Tex); - - // enable the upper, disable the lower line - if (Line = UpperLine) then - glColorRGB(LineColor_en) - else - glColorRGB(LineColor_dis); - - glBegin(GL_QUADS); - glTexCoord2f(0, 1); - glVertex2f(LyricX, LyricY); - - glTexCoord2f(0, 1-LyricsHeight/64); - glVertex2f(LyricX, LyricY + LyricsHeight); - - glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64); - glVertex2f(LyricX2, LyricY + LyricsHeight); - - glTexCoord2f(Line.Width/1024, 1); - glVertex2f(LyricX2, LyricY); - glEnd; - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; -end; - -//--------------- -// GetUpperLine() - Returns a reference to the upper line -//--------------- -function TLyricEngine.GetUpperLine(): TLyricLine; -begin - Result := UpperLine; -end; - -//--------------- -// GetLowerLine() - Returns a reference to the lower line -//--------------- -function TLyricEngine.GetLowerLine(): TLyricLine; -begin - Result := LowerLine; -end; - -//--------------- -// GetUpperLineIndex() - Returns the index of the upper line -//--------------- -function TLyricEngine.GetUpperLineIndex(): Integer; -const - QUEUE_SIZE = 3; -begin - // no line in queue - if (LineCounter <= 0) then - Result := -1 - // no line has been removed from queue yet - else if (LineCounter <= QUEUE_SIZE) then - Result := 0 - // lines have been removed from queue already - else - Result := LineCounter - QUEUE_SIZE; -end; - -end. - diff --git a/src/Classes/UMain.pas b/src/Classes/UMain.pas deleted file mode 100644 index da9df6d3..00000000 --- a/src/Classes/UMain.pas +++ /dev/null @@ -1,1107 +0,0 @@ -unit UMain; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - Classes, - SDL, - UMusic, - URecord, - UTime, - UDisplay, - UIni, - ULog, - ULyrics, - UScreenSing, - USong, - gl; - -type - PPLayerNote = ^TPlayerNote; - TPlayerNote = record - Start: integer; - Length: integer; - Detect: real; // accurate place, detected in the note - Tone: real; - Perfect: boolean; // true if the note matches the original one, lit the star - Hit: boolean; // true if the note Hits the Line - end; - - PPLayer = ^TPlayer; - TPlayer = record - Name: string; - - // Index in Teaminfo record - TeamID: Byte; - PlayerID: Byte; - - // Scores - Score: real; - ScoreLine: real; - ScoreGolden: real; - - ScoreInt: integer; - ScoreLineInt: integer; - ScoreGoldenInt: integer; - ScoreTotalInt: integer; - - // LineBonus - ScoreLast: Real;//Last Line Score - - // PerfectLineTwinkle (effect) - LastSentencePerfect: Boolean; - - HighNote: integer; // index of last note (= High(Note)?) - LengthNote: integer; // number of notes (= Length(Note)?). - Note: array of TPlayerNote; - end; - - -var - // Absolute Paths - GamePath: string; - SoundPath: string; - SongPaths: TStringList; - LogPath: string; - ThemePath: string; - SkinsPath: string; - ScreenshotsPath: string; - CoverPaths: TStringList; - LanguagesPath: string; - PluginPath: string; - VisualsPath: string; - ResourcesPath: string; - PlayListPath: string; - - Done: Boolean; - Event: TSDL_event; - // FIXME: ConversionFileName should not be global - ConversionFileName: string; - Restart: boolean; - - // player and music info - Player: array of TPlayer; - PlayersPlay: integer; - - CurrentSong : TSong; - -const - MAX_SONG_SCORE = 10000; // max. achievable points per song - MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song - -function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; -procedure InitializePaths; -procedure AddSongPath(const Path: string); - -Procedure Main; -procedure MainLoop; -procedure CheckEvents; -procedure Sing(Screen: TScreenSing); -procedure NewSentence(Screen: TScreenSing); -procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click -procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection -procedure NewNote(Screen: TScreenSing); // detect note -function GetMidBeat(Time: real): real; -function GetTimeFromBeat(Beat: integer): real; -procedure ClearScores(PlayerNum: integer); - -implementation - -uses - Math, - StrUtils, - USongs, - UJoystick, - UCommandLine, - ULanguage, - //SDL_ttf, - USkins, - UCovers, - UCatCovers, - UDataBase, - UPlaylist, - UDLLManager, - UParty, - UConfig, - UCore, - UCommon, - UGraphic, - UGraphicClasses, - UPluginDefs, - UPlatform, - UThemes; - - - - -procedure Main; -var - WndTitle: string; -begin - try - WndTitle := USDXVersionStr; - - Platform.Init; - - if Platform.TerminateIfAlreadyRunning(WndTitle) then - Exit; - - // fix floating-point exceptions (FPE) - DisableFloatingPointExceptions(); - // fix the locale for string-to-float parsing in C-libs - SetDefaultNumericLocale(); - - // setup separators for parsing - // Note: ThousandSeparator must be set because of a bug in TIniFile.ReadFloat - ThousandSeparator := ','; - DecimalSeparator := '.'; - - //------------------------------ - //StartUp - Create Classes and Load Files - //------------------------------ - - // Initialize SDL - // Without SDL_INIT_TIMER SDL_GetTicks() might return strange values - SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER); - SDL_EnableUnicode(1); - - USTime := TTime.Create; - VideoBGTimer := TRelativeTimer.Create; - - // Commandline Parameter Parser - Params := TCMDParams.Create; - - // Log + Benchmark - Log := TLog.Create; - Log.Title := WndTitle; - Log.FileOutputEnabled := not Params.NoLog; - Log.BenchmarkStart(0); - - // Language - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Paths', 'Initialization'); - InitializePaths; - Log.LogStatus('Load Language', 'Initialization'); - Language := TLanguage.Create; - - // Add Const Values: - Language.AddConst('US_VERSION', USDXVersionStr); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Language', 1); - - { - // SDL_ttf (Not used yet, maybe in version 1.5) - Log.BenchmarkStart(1); - Log.LogStatus('Initialize SDL_ttf', 'Initialization'); - TTF_Init(); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing SDL_ttf', 1); - } - - // Skin - Log.BenchmarkStart(1); - Log.LogStatus('Loading Skin List', 'Initialization'); - Skin := TSkin.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Skin List', 1); - - // Ini + Paths - Log.BenchmarkStart(1); - Log.LogStatus('Load Ini', 'Initialization'); - Ini := TIni.Create; - Ini.Load; - - //it's possible that this is the first run, create a .ini file if neccessary - Log.LogStatus('Write Ini', 'Initialization'); - Ini.Save; - - // Load Languagefile - if (Params.Language <> -1) then - Language.ChangeLanguage(ILanguage[Params.Language]) - else - Language.ChangeLanguage(ILanguage[Ini.Language]); - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Ini', 1); - - // Sound - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Sound', 'Initialization'); - InitializeSound(); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing Sound', 1); - - // Lyrics-engine with media reference timer - LyricsState := TLyricsState.Create(); - - // Theme - Log.BenchmarkStart(1); - Log.LogStatus('Load Themes', 'Initialization'); - Theme := TTheme.Create(ThemePath + ITheme[Ini.Theme] + '.ini', Ini.Color); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Themes', 1); - - // Covers Cache - Log.BenchmarkStart(1); - Log.LogStatus('Creating Covers Cache', 'Initialization'); - Covers := TCoverDatabase.Create; - Log.LogBenchmark('Loading Covers Cache Array', 1); - Log.BenchmarkStart(1); - - // Category Covers - Log.BenchmarkStart(1); - Log.LogStatus('Creating Category Covers Array', 'Initialization'); - CatCovers:= TCatCovers.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Category Covers Array', 1); - - // Songs - //Log.BenchmarkStart(1); - Log.LogStatus('Creating Song Array', 'Initialization'); - Songs := TSongs.Create; - //Songs.LoadSongList; - - Log.LogStatus('Creating 2nd Song Array', 'Initialization'); - CatSongs := TCatSongs.Create; - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Songs', 1); - - // PluginManager - Log.BenchmarkStart(1); - Log.LogStatus('PluginManager', 'Initialization'); - DLLMan := TDLLMan.Create; // Load PluginList - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PluginManager', 1); - - {// Party Mode Manager - Log.BenchmarkStart(1); - Log.LogStatus('PartySession Manager', 'Initialization'); - PartySession := TPartySession.Create; //Load PartySession - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PartySession Manager', 1); } - - // Graphics - Log.BenchmarkStart(1); - Log.LogStatus('Initialize 3D', 'Initialization'); - Initialize3D(WndTitle); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing 3D', 1); - - // Score Saving System - Log.BenchmarkStart(1); - Log.LogStatus('DataBase System', 'Initialization'); - DataBase := TDataBaseSystem.Create; - - if (Params.ScoreFile = '') then - DataBase.Init (Platform.GetGameUserPath + 'Ultrastar.db') - else - DataBase.Init (Params.ScoreFile); - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading DataBase System', 1); - - // Playlist Manager - Log.BenchmarkStart(1); - Log.LogStatus('Playlist Manager', 'Initialization'); - PlaylistMan := TPlaylistManager.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Playlist Manager', 1); - - // GoldenStarsTwinkleMod - Log.BenchmarkStart(1); - Log.LogStatus('Effect Manager', 'Initialization'); - GoldenRec := TEffectManager.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Particle System', 1); - - // Joypad - if (Ini.Joypad = 1) OR (Params.Joypad) then - begin - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Joystick', 'Initialization'); - Joy := TJoy.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing Joystick', 1); - end; - - Log.BenchmarkEnd(0); - Log.LogBenchmark('Loading Time', 0); - - Log.LogStatus('Creating Core', 'Initialization'); - {Core := TCore.Create( - USDXShortVersionStr, - MakeVersion(USDX_VERSION_MAJOR, - USDX_VERSION_MINOR, - USDX_VERSION_RELEASE, - chr(0)) - ); } - - Log.LogStatus('Running Core', 'Initialization'); - //Core.Run; - - //------------------------------ - //Start- Mainloop - //------------------------------ - Log.LogStatus('Main Loop', 'Initialization'); - MainLoop; - - finally - //------------------------------ - //Finish Application - //------------------------------ - - // TODO: - // call an uninitialize routine for every initialize step - // or at least use the corresponding Free-Methods - - FinalizeMedia(); - - //TTF_Quit(); - SDL_Quit(); - - if assigned(Log) then - begin - Log.LogStatus('Main Loop', 'Finished'); - Log.Free; - end; - end; -end; - -procedure MainLoop; -var - Delay: integer; -const - MAX_FPS = 100; -begin - Delay := 0; - SDL_EnableKeyRepeat(125, 125); - - CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. - while not Done do - begin - // joypad - if (Ini.Joypad = 1) or (Params.Joypad) then - Joy.Update; - - // keyboard events - CheckEvents; - - // display - done := not Display.Draw; - SwapBuffers; - - // delay - CountMidTime; - - Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid); - - if Delay >= 1 then - SDL_Delay(Delay); // dynamic, maximum is 100 fps - - CountSkipTime; - - // reinitialization of graphics - if Restart then - begin - Reinitialize3D; - Restart := false; - end; - - end; -End; - -procedure CheckEvents; -begin - if Assigned(Display.NextScreen) then - Exit; - - while SDL_PollEvent( @event ) = 1 do - begin - case Event.type_ of - SDL_QUITEV: - begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := True; - end; - { - SDL_MOUSEBUTTONDOWN: - with Event.button Do - begin - if State = SDL_BUTTON_LEFT Then - begin - // - end; - end; - } - SDL_VIDEORESIZE: - begin - ScreenW := Event.resize.w; - ScreenH := Event.resize.h; - // Note: do NOT call SDL_SetVideoMode on Windows and MacOSX here. - // This would create a new OpenGL render-context and all texture data - // would be invalidated. - // On Linux the mode MUST be resetted, otherwise graphics will be corrupted. - {$IFDEF LINUX} - if boolean( Ini.FullScreen ) then - SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN) - else - SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); - {$ENDIF} - end; - SDL_KEYDOWN: - begin - // remap the "keypad enter" key to the "standard enter" key - if (Event.key.keysym.sym = SDLK_KP_ENTER) then - Event.key.keysym.sym := SDLK_RETURN; - - if (Event.key.keysym.sym = SDLK_F11) or - ((Event.key.keysym.sym = SDLK_RETURN) and - ((Event.key.keysym.modifier and KMOD_ALT) <> 0)) then // toggle full screen - begin - Ini.FullScreen := integer( not boolean( Ini.FullScreen ) ); - - // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to - // reload all texture data (-> whitescreen bug). - // Only Linux is able to handle screen-switching this way. - {$IFDEF LINUX} - if boolean( Ini.FullScreen ) then - begin - SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); - SDL_ShowCursor(0); - end - else - begin - SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); - SDL_ShowCursor(1); - end; - - glViewPort(0, 0, ScreenW, ScreenH); - {$ENDIF} - end - // if print is pressed -> make screenshot and save to screenshot path - else if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then - Display.SaveScreenShot - // if there is a visible popup then let it handle input instead of underlying screen - // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) - else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True) - else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True) - else - begin - // check if screen wants to exit - done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True); - - // if screen wants to exit - if done then - begin - // if question option is enabled then show exit popup - if (Ini.AskbeforeDel = 1) then - begin - Display.CurrentScreen^.CheckFadeTo(nil,'MSG_QUIT_USDX'); - end - else // if ask-for-exit is disabled then simply exit - begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := True; - end; - end; - - end; - end; - SDL_JOYAXISMOTION: - begin - // not implemented - end; - SDL_JOYBUTTONDOWN: - begin - // not implemented - end; - end; // case - end; // while -end; - -function GetTimeForBeats(BPM, Beats: real): real; -begin - Result := 60 / BPM * Beats; -end; - -function GetBeats(BPM, msTime: real): real; -begin - Result := BPM * msTime / 60; -end; - -procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); -var - NewTime: real; -begin - if High(CurrentSong.BPM) = BPMNum then - begin - // last BPM - CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); - Time := 0; - end - else - begin - // not last BPM - // count how much time is it for start of the new BPM and store it in NewTime - NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); - - // compare it to remaining time - if (Time - NewTime) > 0 then - begin - // there is still remaining time - CurBeat := CurrentSong.BPM[BPMNum].StartBeat; - Time := Time - NewTime; - end - else - begin - // there is no remaining time - CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); - Time := 0; - end; // if - end; // if -end; - -function GetMidBeat(Time: real): real; -var - CurBeat: real; - CurBPM: integer; -begin - // static BPM - if Length(CurrentSong.BPM) = 1 then - begin - Result := Time * CurrentSong.BPM[0].BPM / 60; - end - // variable BPM - else if Length(CurrentSong.BPM) > 1 then - begin - CurBeat := 0; - CurBPM := 0; - while (Time > 0) do - begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - - Result := CurBeat; - end - // invalid BPM - else - begin - Result := 0; - end; -end; - -function GetTimeFromBeat(Beat: integer): real; -var - CurBPM: integer; -begin - // static BPM - if Length(CurrentSong.BPM) = 1 then - begin - Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; - end - // variable BPM - else if Length(CurrentSong.BPM) > 1 then - begin - Result := CurrentSong.GAP / 1000; - CurBPM := 0; - while (CurBPM <= High(CurrentSong.BPM)) and - (Beat > CurrentSong.BPM[CurBPM].StartBeat) do - begin - if (CurBPM < High(CurrentSong.BPM)) and - (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then - begin - // full range - Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * - (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); - end; - - if (CurBPM = High(CurrentSong.BPM)) or - (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then - begin - // in the middle - Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * - (Beat - CurrentSong.BPM[CurBPM].StartBeat); - end; - Inc(CurBPM); - end; - - { - while (Time > 0) do - begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - } - end - // invalid BPM - else - begin - Result := 0; - end; -end; - -procedure Sing(Screen: TScreenSing); -var - Count: integer; - CountGr: integer; - CP: integer; - Done: real; - N: integer; - CurLine: PLine; - CurNote: PLineFragment; -begin - LyricsState.UpdateBeats(); - - // sentences routines - for CountGr := 0 to 0 do //High(Lines) - begin; - CP := CountGr; - // old parts - LyricsState.OldLine := Lines[CP].Current; - - // choose current parts - for Count := 0 to Lines[CP].High do - begin - if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then - Lines[CP].Current := Count; - end; - - // clean player note if there is a new line - // (optimization on halfbeat time) - if Lines[CP].Current <> LyricsState.OldLine then - NewSentence(Screen); - - end; // for CountGr - - // make some operations on clicks - if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then - NewBeatClick(Screen); - - // make some operations when detecting new voice pitch - if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then - NewBeatDetect(Screen); - - CurLine := @Lines[0].Line[Lines[0].Current]; - - // remove moving text - Done := 1; - for N := 0 to CurLine.HighNote do - begin - CurNote := @CurLine.Note[N]; - if (CurNote.Start <= LyricsState.MidBeat) and - (CurNote.Start + CurNote.Length >= LyricsState.MidBeat) then - begin - Done := (LyricsState.MidBeat - CurNote.Start) / CurNote.Length; - end; - end; -end; - -procedure NewSentence(Screen: TScreenSing); -var - i: Integer; -begin - // clean note of player - for i := 0 to High(Player) do - begin - Player[i].LengthNote := 0; - Player[i].HighNote := -1; - SetLength(Player[i].Note, 0); - end; - - // on sentence change... - Screen.onSentenceChange(Lines[0].Current); -end; - -procedure NewBeatClick; -var - Count: integer; -begin - // beat click - if ((Ini.BeatClick = 1) and - ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then - begin - AudioPlayback.PlaySound(SoundLib.Click); - end; - - for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do - begin - if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then - begin - // click assist - if Ini.ClickAssist = 1 then - AudioPlayback.PlaySound(SoundLib.Click); - - // drum machine - (* - TempBeat := LyricsState.CurrentBeat;// + 2; - if (TempBeat mod 8 = 0) then Music.PlayDrum; - if (TempBeat mod 8 = 4) then Music.PlayClap; - //if (TempBeat mod 4 = 2) then Music.PlayHihat; - if (TempBeat mod 4 <> 0) then Music.PlayHihat; - *) - end; - end; -end; - -procedure NewBeatDetect(Screen: TScreenSing); -begin - NewNote(Screen); -end; - -procedure NewNote(Screen: TScreenSing); -var - LineFragmentIndex: integer; - CurrentLineFragment: PLineFragment; - PlayerIndex: integer; - CurrentSound: TCaptureBuffer; - CurrentPlayer: PPlayer; - LastPlayerNote: PPLayerNote; - Line: PLine; - SentenceIndex: integer; - SentenceMin: integer; - SentenceMax: integer; - SentenceDetected: integer; // sentence of detected note - NoteAvailable: boolean; - NewNote: boolean; - Range: integer; - NoteHit: boolean; - MaxSongPoints: integer; // max. points for the song (without line bonus) - MaxLinePoints: Real; // max. points for the current line -begin - // TODO: add duet mode support - // use Lines[LineSetIndex] with LineSetIndex depending on the current player - - // count min and max sentence range for checking (detection is delayed to the notes we see on the screen) - SentenceMin := Lines[0].Current-1; - if (SentenceMin < 0) then - SentenceMin := 0; - SentenceMax := Lines[0].Current; - - // check for an active note at the current time defined in the lyrics - NoteAvailable := false; - SentenceDetected := SentenceMin; - for SentenceIndex := SentenceMin to SentenceMax do - begin - Line := @Lines[0].Line[SentenceIndex]; - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - // check if line is active - if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and - (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and - (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes - (CurrentLineFragment.Length > 0) then // and make sure the note lengths is at least 1 - begin - SentenceDetected := SentenceIndex; - NoteAvailable := true; - Break; - end; - end; - // TODO: break here, if NoteAvailable is true? We would then use the first instead - // of the last note matching the current beat if notes overlap. But notes - // should not overlap at all. - //if (NoteAvailable) then - // Break; - end; - - // analyze player signals - for PlayerIndex := 0 to PlayersPlay-1 do - begin - CurrentPlayer := @Player[PlayerIndex]; - CurrentSound := AudioInputProcessor.Sound[PlayerIndex]; - LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; - - // analyze buffer - CurrentSound.AnalyzeBuffer; - - // add some noise - // TODO: do we need this? - //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1; - - // add note if possible - if (CurrentSound.ToneValid and NoteAvailable) then - begin - Line := @Lines[0].Line[SentenceDetected]; - - // process until last note - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and - (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then - begin - // compare notes (from song-file and from player) - - // move players tone to proper octave - while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do - CurrentSound.Tone := CurrentSound.Tone - 12; - - while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do - CurrentSound.Tone := CurrentSound.Tone + 12; - - // half size notes patch - NoteHit := false; - - //if Ini.Difficulty = 0 then Range := 2; - //if Ini.Difficulty = 1 then Range := 1; - //if Ini.Difficulty = 2 then Range := 0; - Range := 2 - Ini.Difficulty; - - // check if the player hit the correct tone within the tolerated range - if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then - begin - // adjust the players tone to the correct one - // TODO: do we need to do this? - CurrentSound.Tone := CurrentLineFragment.Tone; - - // half size notes patch - NoteHit := true; - - if (Ini.LineBonus > 0) then - MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS - else - MaxSongPoints := MAX_SONG_SCORE; - - // Note: ScoreValue is the sum of all note values of the song - MaxLinePoints := MaxSongPoints / Lines[0].ScoreValue; - - // FIXME: is this correct? Why do we add the points for a whole line - // if just one note is correct? - case CurrentLineFragment.NoteType of - ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints; - ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints; - end; - - CurrentPlayer.ScoreInt := Floor(CurrentPlayer.Score / 10) * 10; - CurrentPlayer.ScoreGoldenInt := Floor(CurrentPlayer.ScoreGolden / 10) * 10; - - CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt + - CurrentPlayer.ScoreGoldenInt + - CurrentPlayer.ScoreLineInt; - end; - - end; // operation - end; // for - - // check if we have to add a new note or extend the note's length - if (SentenceDetected = SentenceMax) then - begin - // we will add a new note - NewNote := true; - // if last has the same tone - if ((CurrentPlayer.LengthNote > 0) and - (LastPlayerNote.Tone = CurrentSound.Tone) and - ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then - begin - NewNote := false; - end; - - // if is not as new note to control - for LineFragmentIndex := 0 to Line.HighNote do - begin - if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then - NewNote := true; - end; - - // add new note - if NewNote then - begin - // new note - Inc(CurrentPlayer.LengthNote); - Inc(CurrentPlayer.HighNote); - SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote); - - // update player's last note - LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; - with LastPlayerNote^ do - begin - Start := LyricsState.CurrentBeatD; - Length := 1; - Tone := CurrentSound.Tone; // Tone || ToneAbs - Detect := LyricsState.MidBeat; - Hit := NoteHit; // half note patch - end; - end - else - begin - // extend note length - Inc(LastPlayerNote.Length); - end; - - // check for perfect note and then lit the star (on Draw) - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - if (CurrentLineFragment.Start = LastPlayerNote.Start) and - (CurrentLineFragment.Length = LastPlayerNote.Length) and - (CurrentLineFragment.Tone = LastPlayerNote.Tone) then - begin - LastPlayerNote.Perfect := true; - end; - end; - end; // if SentenceDetected = SentenceMax - - end; // if Detected - end; // for PlayerIndex - - //Log.LogStatus('EndBeat', 'NewBeat'); - - // on sentence end -> for LineBonus and display of SingBar (rating pop-up) - if (SentenceDetected >= Low(Lines[0].Line)) and - (SentenceDetected <= High(Lines[0].Line)) then - begin - Line := @Lines[0].Line[SentenceDetected]; - CurrentLineFragment := @Line.Note[Line.HighNote]; - if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then - begin - if assigned(Screen) then - Screen.OnSentenceEnd(SentenceDetected); - end; - end; - -end; - -procedure ClearScores(PlayerNum: integer); -begin - with Player[PlayerNum] do - begin - Score := 0; - ScoreInt := 0; - ScoreLine := 0; - ScoreLineInt := 0; - ScoreGolden := 0; - ScoreGoldenInt := 0; - ScoreTotalInt := 0; - end; -end; - -procedure AddSpecialPath(var PathList: TStringList; const Path: string); -var - I: integer; - PathAbs, OldPathAbs: string; -begin - if (PathList = nil) then - PathList := TStringList.Create; - - if (Path = '') or not DirectoryExists(Path) then - Exit; - - PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path)); - - // check if path or a part of the path was already added - for I := 0 to PathList.Count-1 do - begin - OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[I])); - // check if the new directory is a sub-directory of a previously added one. - // This is also true, if both paths point to the same directories. - if (AnsiStartsText(OldPathAbs, PathAbs)) then - begin - // ignore the new path - Exit; - end; - - // check if a previously added directory is a sub-directory of the new one. - if (AnsiStartsText(PathAbs, OldPathAbs)) then - begin - // replace the old with the new one. - PathList[I] := PathAbs; - Exit; - end; - end; - - PathList.Add(PathAbs); -end; - -procedure AddSongPath(const Path: string); -begin - AddSpecialPath(SongPaths, Path); -end; - -procedure AddCoverPath(const Path: string); -begin - AddSpecialPath(CoverPaths, Path); -end; - -(** - * Initialize a path variable - * After setting paths, make sure that paths exist - *) -function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; -begin - Result := false; - - if (RequestedPath = '') then - Exit; - - // Make sure the directory exists - if (not ForceDirectories(RequestedPath)) then - begin - PathResult := ''; - Exit; - end; - - PathResult := IncludeTrailingPathDelimiter(RequestedPath); - - if (NeedsWritePermission) and - (FileIsReadOnly(RequestedPath)) then - begin - Exit; - end; - - Result := true; -end; - -(** - * Function sets all absolute paths e.g. song path and makes sure the directorys exist - *) -procedure InitializePaths; -begin - // Log directory (must be writable) - if (not FindPath(LogPath, Platform.GetLogPath, true)) then - begin - Log.FileOutputEnabled := false; - Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths'); - end; - - FindPath(SoundPath, Platform.GetGameSharedPath + 'Sounds', false); - FindPath(ThemePath, Platform.GetGameSharedPath + 'Themes', false); - FindPath(SkinsPath, Platform.GetGameSharedPath + 'Themes', false); - FindPath(LanguagesPath, Platform.GetGameSharedPath + 'Languages', false); - FindPath(PluginPath, Platform.GetGameSharedPath + 'Plugins', false); - FindPath(VisualsPath, Platform.GetGameSharedPath + 'Visuals', false); - FindPath(ResourcesPath, Platform.GetGameSharedPath + 'Resources', false); - - // Playlists are not shared as we need one directory to write too - FindPath(PlaylistPath, Platform.GetGameUserPath + 'Playlists', true); - - // Screenshot directory (must be writable) - if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'Screenshots', true)) then - begin - Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths'); - end; - - // Add song paths - AddSongPath(Params.SongPath); - AddSongPath(Platform.GetGameSharedPath + 'Songs'); - AddSongPath(Platform.GetGameUserPath + 'Songs'); - - // Add category cover paths - AddCoverPath(Platform.GetGameSharedPath + 'Covers'); - AddCoverPath(Platform.GetGameUserPath + 'Covers'); -end; - -end. diff --git a/src/Classes/UMediaCore_FFmpeg.pas b/src/Classes/UMediaCore_FFmpeg.pas deleted file mode 100644 index cdd320ac..00000000 --- a/src/Classes/UMediaCore_FFmpeg.pas +++ /dev/null @@ -1,405 +0,0 @@ -unit UMediaCore_FFmpeg; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UMusic, - avcodec, - avformat, - avutil, - ULog, - sdl; - -type - PPacketQueue = ^TPacketQueue; - TPacketQueue = class - private - FirstListEntry: PAVPacketList; - LastListEntry: PAVPacketList; - PacketCount: integer; - Mutex: PSDL_Mutex; - Condition: PSDL_Cond; - Size: integer; - AbortRequest: boolean; - public - constructor Create(); - destructor Destroy(); override; - - function Put(Packet : PAVPacket): integer; - function PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer; - procedure FreeStatusInfo(var Packet: TAVPacket); - function GetStatusInfo(var Packet: TAVPacket): Pointer; - function Get(var Packet: TAVPacket; Blocking: boolean): integer; - function GetSize(): integer; - procedure Flush(); - procedure Abort(); - function IsAborted(): boolean; - end; - -const - STATUS_PACKET: PChar = 'STATUS_PACKET'; -const - PKT_STATUS_FLAG_EOF = 1; // signal end-of-file - PKT_STATUS_FLAG_FLUSH = 2; // request the decoder to flush its avcodec decode buffers - PKT_STATUS_FLAG_ERROR = 3; // signal an error state - PKT_STATUS_FLAG_EMPTY = 4; // request the decoder to output empty data (silence or black frames) - -type - TMediaCore_FFmpeg = class - private - AVCodecLock: PSDL_Mutex; - public - constructor Create(); - destructor Destroy(); override; - class function GetInstance(): TMediaCore_FFmpeg; - - function GetErrorString(ErrorNum: integer): string; - function FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer ): boolean; - function FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer; - function ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean; - procedure LockAVCodec(); - procedure UnlockAVCodec(); - end; - -implementation - -uses - SysUtils; - -var - Instance: TMediaCore_FFmpeg; - -constructor TMediaCore_FFmpeg.Create(); -begin - inherited; - AVCodecLock := SDL_CreateMutex(); -end; - -destructor TMediaCore_FFmpeg.Destroy(); -begin - SDL_DestroyMutex(AVCodecLock); - inherited; -end; - -class function TMediaCore_FFmpeg.GetInstance(): TMediaCore_FFmpeg; -begin - if (not Assigned(Instance)) then - Instance := TMediaCore_FFmpeg.Create(); - Result := Instance; -end; - -procedure TMediaCore_FFmpeg.LockAVCodec(); -begin - SDL_mutexP(AVCodecLock); -end; - -procedure TMediaCore_FFmpeg.UnlockAVCodec(); -begin - SDL_mutexV(AVCodecLock); -end; - -function TMediaCore_FFmpeg.GetErrorString(ErrorNum: integer): string; -begin - case ErrorNum of - AVERROR_IO: Result := 'AVERROR_IO'; - AVERROR_NUMEXPECTED: Result := 'AVERROR_NUMEXPECTED'; - AVERROR_INVALIDDATA: Result := 'AVERROR_INVALIDDATA'; - AVERROR_NOMEM: Result := 'AVERROR_NOMEM'; - AVERROR_NOFMT: Result := 'AVERROR_NOFMT'; - AVERROR_NOTSUPP: Result := 'AVERROR_NOTSUPP'; - AVERROR_NOENT: Result := 'AVERROR_NOENT'; - AVERROR_PATCHWELCOME: Result := 'AVERROR_PATCHWELCOME'; - else Result := 'AVERROR_#'+inttostr(ErrorNum); - end; -end; - -{ - @param(FormatCtx is a PAVFormatContext returned from av_open_input_file ) - @param(FirstVideoStream is an OUT value of type integer, this is the index of the video stream) - @param(FirstAudioStream is an OUT value of type integer, this is the index of the audio stream) - @returns(@true on success, @false otherwise) -} -function TMediaCore_FFmpeg.FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer): boolean; -var - i: integer; - Stream: PAVStream; -begin - // find the first video stream - FirstAudioStream := -1; - FirstVideoStream := -1; - - for i := 0 to FormatCtx.nb_streams-1 do - begin - Stream := FormatCtx.streams[i]; - - if (Stream.codec.codec_type = CODEC_TYPE_VIDEO) and - (FirstVideoStream < 0) then - begin - FirstVideoStream := i; - end; - - if (Stream.codec.codec_type = CODEC_TYPE_AUDIO) and - (FirstAudioStream < 0) then - begin - FirstAudioStream := i; - end; - end; - - // return true if either an audio- or video-stream was found - Result := (FirstAudioStream > -1) or - (FirstVideoStream > -1) ; -end; - -function TMediaCore_FFmpeg.FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer; -var - i: integer; - StreamIndex: integer; - Stream: PAVStream; -begin - // find the first audio stream - StreamIndex := -1; - - for i := 0 to FormatCtx^.nb_streams-1 do - begin - Stream := FormatCtx^.streams[i]; - - if (Stream.codec^.codec_type = CODEC_TYPE_AUDIO) then - begin - StreamIndex := i; - Break; - end; - end; - - Result := StreamIndex; -end; - -function TMediaCore_FFmpeg.ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean; -begin - case FFmpegFormat of - SAMPLE_FMT_U8: Format := asfU8; - SAMPLE_FMT_S16: Format := asfS16; - SAMPLE_FMT_S24: Format := asfS24; - SAMPLE_FMT_S32: Format := asfS32; - SAMPLE_FMT_FLT: Format := asfFloat; - else begin - Result := false; - Exit; - end; - end; - Result := true; -end; - -{ TPacketQueue } - -constructor TPacketQueue.Create(); -begin - inherited; - - FirstListEntry := nil; - LastListEntry := nil; - PacketCount := 0; - Size := 0; - - Mutex := SDL_CreateMutex(); - Condition := SDL_CreateCond(); -end; - -destructor TPacketQueue.Destroy(); -begin - Flush(); - SDL_DestroyMutex(Mutex); - SDL_DestroyCond(Condition); - inherited; -end; - -procedure TPacketQueue.Abort(); -begin - SDL_LockMutex(Mutex); - - AbortRequest := true; - - SDL_CondBroadcast(Condition); - SDL_UnlockMutex(Mutex); -end; - -function TPacketQueue.IsAborted(): boolean; -begin - SDL_LockMutex(Mutex); - Result := AbortRequest; - SDL_UnlockMutex(Mutex); -end; - -function TPacketQueue.Put(Packet : PAVPacket): integer; -var - CurrentListEntry : PAVPacketList; -begin - Result := -1; - - if (Packet = nil) then - Exit; - - if (PChar(Packet^.data) <> STATUS_PACKET) then - begin - if (av_dup_packet(Packet) < 0) then - Exit; - end; - - CurrentListEntry := av_malloc(SizeOf(TAVPacketList)); - if (CurrentListEntry = nil) then - Exit; - - CurrentListEntry^.pkt := Packet^; - CurrentListEntry^.next := nil; - - SDL_LockMutex(Mutex); - try - if (LastListEntry = nil) then - FirstListEntry := CurrentListEntry - else - LastListEntry^.next := CurrentListEntry; - - LastListEntry := CurrentListEntry; - Inc(PacketCount); - - Size := Size + CurrentListEntry^.pkt.size; - SDL_CondSignal(Condition); - finally - SDL_UnlockMutex(Mutex); - end; - - Result := 0; -end; - -(** - * Adds a status packet (EOF, Flush, etc.) to the end of the queue. - * StatusInfo can be used to pass additional information to the decoder. - * Only assign nil or a valid pointer to data allocated with Getmem() to - * StatusInfo because the pointer will be disposed with Freemem() on a call - * to Flush(). If the packet is removed from the queue it is the decoder's - * responsibility to free the StatusInfo data with FreeStatusInfo(). - *) -function TPacketQueue.PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer; -var - TempPacket: PAVPacket; -begin - // create temp. package - TempPacket := av_malloc(SizeOf(TAVPacket)); - if (TempPacket = nil) then - begin - Result := -1; - Exit; - end; - // init package - av_init_packet(TempPacket^); - TempPacket^.data := Pointer(STATUS_PACKET); - TempPacket^.flags := StatusFlag; - TempPacket^.priv := StatusInfo; - // put a copy of the package into the queue - Result := Put(TempPacket); - // data has been copied -> delete temp. package - av_free(TempPacket); -end; - -procedure TPacketQueue.FreeStatusInfo(var Packet: TAVPacket); -begin - if (Packet.priv <> nil) then - FreeMem(Packet.priv); -end; - -function TPacketQueue.GetStatusInfo(var Packet: TAVPacket): Pointer; -begin - Result := Packet.priv; -end; - -function TPacketQueue.Get(var Packet: TAVPacket; Blocking: boolean): integer; -var - CurrentListEntry: PAVPacketList; -const - WAIT_TIMEOUT = 10; // timeout in ms -begin - Result := -1; - - SDL_LockMutex(Mutex); - try - while (true) do - begin - if (AbortRequest) then - Exit; - - CurrentListEntry := FirstListEntry; - if (CurrentListEntry <> nil) then - begin - FirstListEntry := CurrentListEntry^.next; - if (FirstListEntry = nil) then - LastListEntry := nil; - Dec(PacketCount); - - Size := Size - CurrentListEntry^.pkt.size; - Packet := CurrentListEntry^.pkt; - av_free(CurrentListEntry); - - Result := 1; - Break; - end - else if (not Blocking) then - begin - Result := 0; - Break; - end - else - begin - // block until a new package arrives, - // but do not wait till infinity to avoid deadlocks - if (SDL_CondWaitTimeout(Condition, Mutex, WAIT_TIMEOUT) = SDL_MUTEX_TIMEDOUT) then - begin - Result := 0; - Break; - end; - end; - end; - finally - SDL_UnlockMutex(Mutex); - end; -end; - -function TPacketQueue.GetSize(): integer; -begin - SDL_LockMutex(Mutex); - Result := Size; - SDL_UnlockMutex(Mutex); -end; - -procedure TPacketQueue.Flush(); -var - CurrentListEntry, TempListEntry: PAVPacketList; -begin - SDL_LockMutex(Mutex); - - CurrentListEntry := FirstListEntry; - while(CurrentListEntry <> nil) do - begin - TempListEntry := CurrentListEntry^.next; - // free status data - if (PChar(CurrentListEntry^.pkt.data) = STATUS_PACKET) then - FreeStatusInfo(CurrentListEntry^.pkt); - // free packet data - av_free_packet(@CurrentListEntry^.pkt); - // Note: param must be a pointer to a pointer! - av_freep(@CurrentListEntry); - CurrentListEntry := TempListEntry; - end; - LastListEntry := nil; - FirstListEntry := nil; - PacketCount := 0; - Size := 0; - - SDL_UnlockMutex(Mutex); -end; - -end. diff --git a/src/Classes/UMediaCore_SDL.pas b/src/Classes/UMediaCore_SDL.pas deleted file mode 100644 index 252f72a0..00000000 --- a/src/Classes/UMediaCore_SDL.pas +++ /dev/null @@ -1,38 +0,0 @@ -unit UMediaCore_SDL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UMusic, - sdl; - -function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean; - -implementation - -function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean; -begin - case Format of - asfU8: SDLFormat := AUDIO_U8; - asfS8: SDLFormat := AUDIO_S8; - asfU16LSB: SDLFormat := AUDIO_U16LSB; - asfS16LSB: SDLFormat := AUDIO_S16LSB; - asfU16MSB: SDLFormat := AUDIO_U16MSB; - asfS16MSB: SDLFormat := AUDIO_S16MSB; - asfU16: SDLFormat := AUDIO_U16; - asfS16: SDLFormat := AUDIO_S16; - else begin - Result := false; - Exit; - end; - end; - Result := true; -end; - -end. diff --git a/src/Classes/UMedia_dummy.pas b/src/Classes/UMedia_dummy.pas deleted file mode 100644 index 438b89ab..00000000 --- a/src/Classes/UMedia_dummy.pas +++ /dev/null @@ -1,243 +0,0 @@ -unit UMedia_dummy; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -implementation - -uses - SysUtils, - math, - UMusic; - -type - TMedia_dummy = class( TInterfacedObject, IVideoPlayback, IVideoVisualization, IAudioPlayback, IAudioInput ) - private - DummyOutputDeviceList: TAudioOutputDeviceList; - public - constructor Create(); - function GetName: string; - - function Init(): boolean; - function Finalize(): boolean; - - function Open(const aFileName : string): boolean; // true if succeed - procedure Close; - - procedure Play; - procedure Pause; - procedure Stop; - - procedure SetPosition(Time: real); - function GetPosition: real; - - procedure SetSyncSource(SyncSource: TSyncSource); - - procedure GetFrame(Time: Extended); - procedure DrawGL(Screen: integer); - - // IAudioInput - function InitializeRecord: boolean; - function FinalizeRecord: boolean; - procedure CaptureStart; - procedure CaptureStop; - procedure GetFFTData(var data: TFFTData); - function GetPCMData(var data: TPCMData): Cardinal; - - // IAudioPlayback - function InitializePlayback: boolean; - function FinalizePlayback: boolean; - - function GetOutputDeviceList(): TAudioOutputDeviceList; - procedure FadeIn(Time: real; TargetVolume: single); - procedure SetAppVolume(Volume: single); - procedure SetVolume(Volume: single); - procedure SetLoop(Enabled: boolean); - procedure Rewind; - - function Finished: boolean; - function Length: real; - - function OpenSound(const Filename: string): TAudioPlaybackStream; - procedure CloseSound(var PlaybackStream: TAudioPlaybackStream); - procedure PlaySound(stream: TAudioPlaybackStream); - procedure StopSound(stream: TAudioPlaybackStream); - - function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; - procedure CloseVoiceStream(var VoiceStream: TAudioVoiceStream); - end; - -function TMedia_dummy.GetName: string; -begin - Result := 'dummy'; -end; - -procedure TMedia_dummy.GetFrame(Time: Extended); -begin -end; - -procedure TMedia_dummy.DrawGL(Screen: integer); -begin -end; - -constructor TMedia_dummy.Create(); -begin - inherited; -end; - -function TMedia_dummy.Init(): boolean; -begin - Result := true; -end; - -function TMedia_dummy.Finalize(): boolean; -begin - Result := true; -end; - -function TMedia_dummy.Open(const aFileName : string): boolean; // true if succeed -begin - Result := false; -end; - -procedure TMedia_dummy.Close; -begin -end; - -procedure TMedia_dummy.Play; -begin -end; - -procedure TMedia_dummy.Pause; -begin -end; - -procedure TMedia_dummy.Stop; -begin -end; - -procedure TMedia_dummy.SetPosition(Time: real); -begin -end; - -function TMedia_dummy.GetPosition: real; -begin - Result := 0; -end; - -procedure TMedia_dummy.SetSyncSource(SyncSource: TSyncSource); -begin -end; - -// IAudioInput -function TMedia_dummy.InitializeRecord: boolean; -begin - Result := true; -end; - -function TMedia_dummy.FinalizeRecord: boolean; -begin - Result := true; -end; - -procedure TMedia_dummy.CaptureStart; -begin -end; - -procedure TMedia_dummy.CaptureStop; -begin -end; - -procedure TMedia_dummy.GetFFTData(var data: TFFTData); -begin -end; - -function TMedia_dummy.GetPCMData(var data: TPCMData): Cardinal; -begin - Result := 0; -end; - -// IAudioPlayback -function TMedia_dummy.InitializePlayback: boolean; -begin - SetLength(DummyOutputDeviceList, 1); - DummyOutputDeviceList[0] := TAudioOutputDevice.Create(); - DummyOutputDeviceList[0].Name := '[Dummy Device]'; - Result := true; -end; - -function TMedia_dummy.FinalizePlayback: boolean; -begin - Result := true; -end; - -function TMedia_dummy.GetOutputDeviceList(): TAudioOutputDeviceList; -begin - Result := DummyOutputDeviceList; -end; - -procedure TMedia_dummy.SetAppVolume(Volume: single); -begin -end; - -procedure TMedia_dummy.SetVolume(Volume: single); -begin -end; - -procedure TMedia_dummy.SetLoop(Enabled: boolean); -begin -end; - -procedure TMedia_dummy.FadeIn(Time: real; TargetVolume: single); -begin -end; - -procedure TMedia_dummy.Rewind; -begin -end; - -function TMedia_dummy.Finished: boolean; -begin - Result := false; -end; - -function TMedia_dummy.Length: real; -begin - Result := 60; -end; - -function TMedia_dummy.OpenSound(const Filename: string): TAudioPlaybackStream; -begin - Result := nil; -end; - -procedure TMedia_dummy.CloseSound(var PlaybackStream: TAudioPlaybackStream); -begin -end; - -procedure TMedia_dummy.PlaySound(stream: TAudioPlaybackStream); -begin -end; - -procedure TMedia_dummy.StopSound(stream: TAudioPlaybackStream); -begin -end; - -function TMedia_dummy.CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; -begin - Result := nil; -end; - -procedure TMedia_dummy.CloseVoiceStream(var VoiceStream: TAudioVoiceStream); -begin -end; - -initialization - MediaManager.Add(TMedia_dummy.Create); - -end. diff --git a/src/Classes/UModules.pas b/src/Classes/UModules.pas deleted file mode 100644 index 554a24c4..00000000 --- a/src/Classes/UModules.pas +++ /dev/null @@ -1,26 +0,0 @@ -unit UModules; - -interface - -{$I switches.inc} - -{********************* - UModules - Unit Contains all used Modules in its uses clausel - and a const with an array of all Modules to load -*********************} - -uses - UCoreModule, - UPluginLoader; - -const - CORE_MODULES_TO_LOAD: Array[0..2] of cCoreModule = ( - TPluginLoader, //First because it has to look if there are Module replacements (Feature o/t Future) - TCoreModule, //Remove this later, just a dummy - TtehPlugins //Represents the Plugins. Last because they may use CoreModules Services etc. - ); - -implementation - -end. \ No newline at end of file diff --git a/src/Classes/UMusic.pas b/src/Classes/UMusic.pas deleted file mode 100644 index 6476f629..00000000 --- a/src/Classes/UMusic.pas +++ /dev/null @@ -1,1233 +0,0 @@ -unit UMusic; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UTime, - Classes; - -type - TNoteType = (ntFreestyle, ntNormal, ntGolden); - - (** - * TLineFragment represents a fragment of a lyrics line. - * This is a text-fragment (e.g. a syllable) assigned to a note pitch, - * represented by a bar in the sing-screen. - *) - PLineFragment = ^TLineFragment; - TLineFragment = record - Color: integer; - Start: integer; // beat the fragment starts at - Length: integer; // length in beats - Tone: integer; // full range tone - Text: string; // text assigned to this fragment (a syllable, word, etc.) - NoteType: TNoteType; // note-type: golden-note/freestyle etc. - end; - - (** - * TLine represents one lyrics line and consists of multiple - * notes. - *) - PLine = ^TLine; - TLine = record - Start: integer; // the start beat of this line (<> start beat of the first note of this line) - Lyric: string; - LyricWidth: real; // @deprecated: width of the line in pixels. - // Do not use this as the width is not correct. - // Use TLyricsEngine.GetUpperLine().Width instead. - End_: integer; - BaseNote: integer; - HighNote: integer; // index of last note in line (= High(Note)?) - TotalNotes: integer; // value of all notes in the line - LastLine: boolean; - Note: array of TLineFragment; - end; - - (** - * TLines stores sets of lyric lines and information on them. - * Normally just one set is defined but in duet mode it might for example - * contain two sets. - *) - TLines = record - Current: integer; // for drawing of current line - High: integer; // (= High(Line)?) - Number: integer; - Resolution: integer; - NotesGAP: integer; - ScoreValue: integer; - Line: array of TLine; - end; - - (** - * TLyricsState contains all information concerning the - * state of the lyrics, e.g. the current beat or duration of the lyrics. - *) - TLyricsState = class - private - Timer: TRelativeTimer; // keeps track of the current time - public - OldBeat: integer; // previous discovered beat - CurrentBeat: integer; // current beat (rounded) - MidBeat: real; // current beat (float) - - // now we use this for super synchronization! - // only used when analyzing voice - // TODO: change ...D to ...Detect(ed) - OldBeatD: integer; // previous discovered beat - CurrentBeatD: integer; // current discovered beat (rounded) - MidBeatD: real; // current discovered beat (float) - - // we use this for audible clicks - // TODO: Change ...C to ...Click - OldBeatC: integer; // previous discovered beat - CurrentBeatC: integer; - MidBeatC: real; // like CurrentBeatC - - OldLine: integer; // previous displayed sentence - - StartTime: real; // time till start of lyrics (= Gap) - TotalTime: real; // total song time - - constructor Create(); - procedure Pause(); - procedure Resume(); - - procedure Reset(); - procedure UpdateBeats(); - - (** - * current song time (in seconds) used as base-timer for lyrics etc. - *) - function GetCurrentTime(): real; - procedure SetCurrentTime(Time: real); - end; - - -const - FFTSize = 512; // size of FFT data (output: FFTSize/2 values) -type - TFFTData = array[0..(FFTSize div 2)-1] of Single; - -type - PPCMStereoSample = ^TPCMStereoSample; - TPCMStereoSample = array[0..1] of SmallInt; - TPCMData = array[0..511] of TPCMStereoSample; - -type - TStreamStatus = (ssStopped, ssPlaying, ssPaused); -const - StreamStatusStr: array[TStreamStatus] of string = - ('Stopped', 'Playing', 'Paused'); - -type - TAudioSampleFormat = ( - asfU8, asfS8, // unsigned/signed 8 bits - asfU16LSB, asfS16LSB, // unsigned/signed 16 bits (endianness: LSB) - asfU16MSB, asfS16MSB, // unsigned/signed 16 bits (endianness: MSB) - asfU16, asfS16, // unsigned/signed 16 bits (endianness: System) - asfS24, // signed 24 bits (endianness: System) - asfS32, // signed 32 bits (endianness: System) - asfFloat // float - ); - -const - // Size of one sample (one channel only) in bytes - AudioSampleSize: array[TAudioSampleFormat] of integer = ( - 1, 1, // asfU8, asfS8 - 2, 2, // asfU16LSB, asfS16LSB - 2, 2, // asfU16MSB, asfS16MSB - 2, 2, // asfU16, asfS16 - 3, // asfS24 - 4, // asfS32 - 4 // asfFloat - ); - -const - CHANNELMAP_LEFT = 1; - CHANNELMAP_RIGHT = 2; - CHANNELMAP_FRONT = CHANNELMAP_LEFT or CHANNELMAP_RIGHT; - -type - TAudioFormatInfo = class - private - fSampleRate : double; - fChannels : byte; - fFormat : TAudioSampleFormat; - fFrameSize : integer; - - procedure SetChannels(Channels: byte); - procedure SetFormat(Format: TAudioSampleFormat); - procedure UpdateFrameSize(); - function GetBytesPerSec(): double; - public - constructor Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat); - function Copy(): TAudioFormatInfo; - - (** - * Returns the inverse ratio of the size of data in this format to its - * size in a given target format. - * Example: SrcSize*SrcInfo.GetRatio(TgtInfo) = TgtSize - *) - function GetRatio(TargetInfo: TAudioFormatInfo): double; - - property SampleRate: double read fSampleRate write fSampleRate; - property Channels: byte read fChannels write SetChannels; - property Format: TAudioSampleFormat read fFormat write SetFormat; - property FrameSize: integer read fFrameSize; - property BytesPerSec: double read GetBytesPerSec; - end; - -type - TSoundEffect = class - public - EngineData: Pointer; // can be used for engine-specific data - procedure Callback(Buffer: PChar; BufSize: integer); virtual; abstract; - end; - - TVoiceRemoval = class(TSoundEffect) - public - procedure Callback(Buffer: PChar; BufSize: integer); override; - end; - -type - TSyncSource = class - function GetClock(): real; virtual; abstract; - end; - - TAudioProcessingStream = class; - TOnCloseHandler = procedure(Stream: TAudioProcessingStream); - - TAudioProcessingStream = class - protected - OnCloseHandlers: array of TOnCloseHandler; - - function GetLength(): real; virtual; abstract; - function GetPosition(): real; virtual; abstract; - procedure SetPosition(Time: real); virtual; abstract; - function GetLoop(): boolean; virtual; abstract; - procedure SetLoop(Enabled: boolean); virtual; abstract; - - procedure PerformOnClose(); - public - function GetAudioFormatInfo(): TAudioFormatInfo; virtual; abstract; - procedure Close(); virtual; abstract; - - (** - * Adds a new OnClose action handler. - * The handlers are performed in the order they were added. - * If not stated explicitely, member-variables might have been invalidated - * already. So do not use any member (variable/method/...) if you are not - * sure it is valid. - *) - procedure AddOnCloseHandler(Handler: TOnCloseHandler); - - property Length: real read GetLength; - property Position: real read GetPosition write SetPosition; - property Loop: boolean read GetLoop write SetLoop; - end; - - TAudioSourceStream = class(TAudioProcessingStream) - protected - function IsEOF(): boolean; virtual; abstract; - function IsError(): boolean; virtual; abstract; - public - function ReadData(Buffer: PChar; BufferSize: integer): integer; virtual; abstract; - - property EOF: boolean read IsEOF; - property Error: boolean read IsError; - end; - - (* - * State-Chart for playback-stream state transitions - * []: Transition, (): State - * - * /---[Play/FadeIn]--->-\ /-------[Pause]----->-\ - * -[Create]->(Stop) (Play) (Pause) - * \\-<-[Stop/EOF*/Error]-/ \-<---[Play/FadeIn]--// - * \-<------------[Stop/EOF*/Error]--------------/ - * - * *: if not looped, otherwise stream is repeated - * Note: SetPosition() does not change the state. - *) - - TAudioPlaybackStream = class(TAudioProcessingStream) - protected - SyncSource: TSyncSource; - AvgSyncDiff: double; - SourceStream: TAudioSourceStream; - - function GetLatency(): double; virtual; abstract; - function GetStatus(): TStreamStatus; virtual; abstract; - function GetVolume(): single; virtual; abstract; - procedure SetVolume(Volume: single); virtual; abstract; - function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; - procedure FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer); - public - (** - * Opens a SourceStream for playback. - * Note that the caller (not the TAudioPlaybackStream) is responsible to - * free the SourceStream after the Playback-Stream is closed. - * You may use an OnClose-handler to achieve this. GetSourceStream() - * guarantees to deliver this method's SourceStream parameter to - * the OnClose-handler. Freeing SourceStream at OnClose is allowed. - *) - function Open(SourceStream: TAudioSourceStream): boolean; virtual; abstract; - - procedure Play(); virtual; abstract; - procedure Pause(); virtual; abstract; - procedure Stop(); virtual; abstract; - procedure FadeIn(Time: real; TargetVolume: single); virtual; abstract; - - procedure GetFFTData(var data: TFFTData); virtual; abstract; - function GetPCMData(var data: TPCMData): Cardinal; virtual; abstract; - - procedure AddSoundEffect(Effect: TSoundEffect); virtual; abstract; - procedure RemoveSoundEffect(Effect: TSoundEffect); virtual; abstract; - - procedure SetSyncSource(SyncSource: TSyncSource); - function GetSourceStream(): TAudioSourceStream; - - property Status: TStreamStatus read GetStatus; - property Volume: single read GetVolume write SetVolume; - end; - - TAudioDecodeStream = class(TAudioSourceStream) - end; - - TAudioVoiceStream = class(TAudioSourceStream) - protected - FormatInfo: TAudioFormatInfo; - ChannelMap: integer; - public - destructor Destroy; override; - - function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual; - procedure Close(); override; - - procedure WriteData(Buffer: PChar; BufferSize: integer); virtual; abstract; - function GetAudioFormatInfo(): TAudioFormatInfo; override; - - function GetLength(): real; override; - function GetPosition(): real; override; - procedure SetPosition(Time: real); override; - function GetLoop(): boolean; override; - procedure SetLoop(Enabled: boolean); override; - end; - -type - // soundcard output-devices information - TAudioOutputDevice = class - public - Name: string; // soundcard name - end; - TAudioOutputDeviceList = array of TAudioOutputDevice; - -type - IGenericPlayback = Interface - ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] - function GetName: String; - - function Open(const Filename: string): boolean; // true if succeed - procedure Close; - - procedure Play; - procedure Pause; - procedure Stop; - - procedure SetPosition(Time: real); - function GetPosition: real; - - property Position: real read GetPosition write SetPosition; - end; - - IVideoPlayback = Interface( IGenericPlayback ) - ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] - function Init(): boolean; - function Finalize: boolean; - - procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC - procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC - - end; - - IVideoVisualization = Interface( IVideoPlayback ) - ['{5AC17D60-B34D-478D-B632-EB00D4078017}'] - end; - - IAudioPlayback = Interface( IGenericPlayback ) - ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}'] - function InitializePlayback: boolean; - function FinalizePlayback: boolean; - - function GetOutputDeviceList(): TAudioOutputDeviceList; - - procedure SetAppVolume(Volume: single); - procedure SetVolume(Volume: single); - procedure SetLoop(Enabled: boolean); - - procedure FadeIn(Time: real; TargetVolume: single); - procedure SetSyncSource(SyncSource: TSyncSource); - - procedure Rewind; - function Finished: boolean; - function Length: real; - - // Sounds - // TODO: - // add a TMediaDummyPlaybackStream implementation that will - // be used by the TSoundLib whenever OpenSound() fails, so checking for - // nil-pointers is not neccessary anymore. - // PlaySound/StopSound will be removed then, OpenSound will be renamed to - // CreateSound. - function OpenSound(const Filename: String): TAudioPlaybackStream; - procedure PlaySound(Stream: TAudioPlaybackStream); - procedure StopSound(Stream: TAudioPlaybackStream); - - // Equalizer - procedure GetFFTData(var Data: TFFTData); - - // Interface for Visualizer - function GetPCMData(var Data: TPCMData): Cardinal; - - function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; - end; - - IGenericDecoder = Interface - ['{557B0E9A-604D-47E4-B826-13769F3E10B7}'] - function GetName(): String; - function InitializeDecoder(): boolean; - function FinalizeDecoder(): boolean; - //function IsSupported(const Filename: string): boolean; - end; - - (* - IVideoDecoder = Interface( IGenericDecoder ) - ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}'] - function Open(const Filename: string): TVideoDecodeStream; - end; - *) - - IAudioDecoder = Interface( IGenericDecoder ) - ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}'] - function Open(const Filename: string): TAudioDecodeStream; - end; - - IAudioInput = Interface - ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}'] - function GetName: String; - function InitializeRecord: boolean; - function FinalizeRecord(): boolean; - - procedure CaptureStart; - procedure CaptureStop; - end; - -type - TAudioConverter = class - protected - fSrcFormatInfo: TAudioFormatInfo; - fDstFormatInfo: TAudioFormatInfo; - public - function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; virtual; - destructor Destroy(); override; - - (** - * Converts the InputBuffer and stores the result in OutputBuffer. - * If the result is not -1, InputSize will be set to the actual number of - * input-buffer bytes used. - * Returns the number of bytes written to the output-buffer or -1 if an error occured. - *) - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; virtual; abstract; - - (** - * Destination/Source size ratio - *) - function GetRatio(): double; virtual; abstract; - - function GetOutputBufferSize(InputSize: integer): integer; virtual; abstract; - property SrcFormatInfo: TAudioFormatInfo read fSrcFormatInfo; - property DstFormatInfo: TAudioFormatInfo read fDstFormatInfo; - end; - -(* TODO -const - SOUNDID_START = 0; - SOUNDID_BACK = 1; - SOUNDID_SWOOSH = 2; - SOUNDID_CHANGE = 3; - SOUNDID_OPTION = 4; - SOUNDID_CLICK = 5; - LAST_SOUNDID = SOUNDID_CLICK; - - BaseSoundFilenames: array[0..LAST_SOUNDID] of string = ( - '%SOUNDPATH%/Common start.mp3', // Start - '%SOUNDPATH%/Common back.mp3', // Back - '%SOUNDPATH%/menu swoosh.mp3', // Swoosh - '%SOUNDPATH%/select music change music 50.mp3', // Change - '%SOUNDPATH%/option change col.mp3', // Option - '%SOUNDPATH%/rimshot022b.mp3' // Click - { - '%SOUNDPATH%/bassdrumhard076b.mp3', // Drum (unused) - '%SOUNDPATH%/hihatclosed068b.mp3', // Hihat (unused) - '%SOUNDPATH%/claps050b.mp3', // Clap (unused) - '%SOUNDPATH%/Shuffle.mp3' // Shuffle (unused) - } - ); -*) - -type - TSoundLibrary = class - private - // TODO - //Sounds: array of TAudioPlaybackStream; - public - // TODO: move sounds to the private section - // and provide IDs instead. - Start: TAudioPlaybackStream; - Back: TAudioPlaybackStream; - Swoosh: TAudioPlaybackStream; - Change: TAudioPlaybackStream; - Option: TAudioPlaybackStream; - Click: TAudioPlaybackStream; - BGMusic: TAudioPlaybackStream; - - constructor Create(); - destructor Destroy(); override; - - procedure LoadSounds(); - procedure UnloadSounds(); - - procedure StartBgMusic(); - procedure PauseBgMusic(); - // TODO - //function AddSound(Filename: string): integer; - //procedure RemoveSound(ID: integer); - //function GetSound(ID: integer): TAudioPlaybackStream; - //property Sound[ID: integer]: TAudioPlaybackStream read GetSound; default; - end; - -var - // TODO: JB --- THESE SHOULD NOT BE GLOBAL - Lines: array of TLines; - LyricsState: TLyricsState; - SoundLib: TSoundLibrary; - - -procedure InitializeSound; -procedure InitializeVideo; -procedure FinalizeMedia; - -function Visualization(): IVideoPlayback; -function VideoPlayback(): IVideoPlayback; -function AudioPlayback(): IAudioPlayback; -function AudioInput(): IAudioInput; -function AudioDecoders(): TInterfaceList; - -function MediaManager: TInterfaceList; - -procedure DumpMediaInterfaces(); - -implementation - -uses - sysutils, - math, - UIni, - UMain, - UCommandLine, - URecord, - ULog; - -var - DefaultVideoPlayback : IVideoPlayback; - DefaultVisualization : IVideoPlayback; - DefaultAudioPlayback : IAudioPlayback; - DefaultAudioInput : IAudioInput; - AudioDecoderList : TInterfaceList; - MediaInterfaceList : TInterfaceList; - - -constructor TAudioFormatInfo.Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat); -begin - inherited Create(); - fChannels := Channels; - fSampleRate := SampleRate; - fFormat := Format; - UpdateFrameSize(); -end; - -procedure TAudioFormatInfo.SetChannels(Channels: byte); -begin - fChannels := Channels; - UpdateFrameSize(); -end; - -procedure TAudioFormatInfo.SetFormat(Format: TAudioSampleFormat); -begin - fFormat := Format; - UpdateFrameSize(); -end; - -function TAudioFormatInfo.GetBytesPerSec(): double; -begin - Result := FrameSize * SampleRate; -end; - -procedure TAudioFormatInfo.UpdateFrameSize(); -begin - fFrameSize := AudioSampleSize[fFormat] * fChannels; -end; - -function TAudioFormatInfo.Copy(): TAudioFormatInfo; -begin - Result := TAudioFormatInfo.Create(Self.Channels, Self.SampleRate, Self.Format); -end; - -function TAudioFormatInfo.GetRatio(TargetInfo: TAudioFormatInfo): double; -begin - Result := (TargetInfo.FrameSize / Self.FrameSize) * - (TargetInfo.SampleRate / Self.SampleRate) -end; - - -function MediaManager: TInterfaceList; -begin - if (not assigned(MediaInterfaceList)) then - MediaInterfaceList := TInterfaceList.Create(); - Result := MediaInterfaceList; -end; - -function VideoPlayback(): IVideoPlayback; -begin - Result := DefaultVideoPlayback; -end; - -function Visualization(): IVideoPlayback; -begin - Result := DefaultVisualization; -end; - -function AudioPlayback(): IAudioPlayback; -begin - Result := DefaultAudioPlayback; -end; - -function AudioInput(): IAudioInput; -begin - Result := DefaultAudioInput; -end; - -function AudioDecoders(): TInterfaceList; -begin - Result := AudioDecoderList; -end; - -procedure FilterInterfaceList(const IID: TGUID; InList, OutList: TInterfaceList); -var - i: integer; - obj: IInterface; -begin - if (not assigned(OutList)) then - Exit; - - OutList.Clear; - for i := 0 to InList.Count-1 do - begin - if assigned(InList[i]) then - begin - // add object to list if it implements the interface searched for - if (InList[i].QueryInterface(IID, obj) = 0) then - OutList.Add(obj); - end; - end; -end; - -procedure InitializeSound; -var - i: integer; - InterfaceList: TInterfaceList; - CurrentAudioDecoder: IAudioDecoder; - CurrentAudioPlayback: IAudioPlayback; - CurrentAudioInput: IAudioInput; -begin - // create a temporary list for interface enumeration - InterfaceList := TInterfaceList.Create(); - - // initialize all audio-decoders first - FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - begin - CurrentAudioDecoder := IAudioDecoder(InterfaceList[i]); - if (not CurrentAudioDecoder.InitializeDecoder()) then - begin - Log.LogError('Initialize failed, Removing - '+ CurrentAudioDecoder.GetName); - MediaManager.Remove(CurrentAudioDecoder); - end; - end; - - // create and setup decoder-list (see AudioDecoders()) - AudioDecoderList := TInterfaceList.Create; - FilterInterfaceList(IAudioDecoder, MediaManager, AudioDecoders); - - // find and initialize playback interface - DefaultAudioPlayback := nil; - FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - begin - CurrentAudioPlayback := IAudioPlayback(InterfaceList[i]); - if (CurrentAudioPlayback.InitializePlayback()) then - begin - DefaultAudioPlayback := CurrentAudioPlayback; - break; - end; - Log.LogError('Initialize failed, Removing - '+ CurrentAudioPlayback.GetName); - MediaManager.Remove(CurrentAudioPlayback); - end; - - // find and initialize input interface - DefaultAudioInput := nil; - FilterInterfaceList(IAudioInput, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - begin - CurrentAudioInput := IAudioInput(InterfaceList[i]); - if (CurrentAudioInput.InitializeRecord()) then - begin - DefaultAudioInput := CurrentAudioInput; - break; - end; - Log.LogError('Initialize failed, Removing - '+ CurrentAudioInput.GetName); - MediaManager.Remove(CurrentAudioInput); - end; - - InterfaceList.Free; - - // Update input-device list with registered devices - AudioInputProcessor.UpdateInputDeviceConfig(); - - // Load in-game sounds - SoundLib := TSoundLibrary.Create; -end; - -procedure InitializeVideo(); -var - i: integer; - InterfaceList: TInterfaceList; - VideoInterface: IVideoPlayback; - VisualInterface: IVideoVisualization; -begin - InterfaceList := TInterfaceList.Create; - - // initialize and set video-playback singleton - DefaultVideoPlayback := nil; - FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - begin - VideoInterface := IVideoPlayback(InterfaceList[i]); - if (VideoInterface.Init()) then - begin - DefaultVideoPlayback := VideoInterface; - break; - end; - Log.LogError('Initialize failed, Removing - '+ VideoInterface.GetName); - MediaManager.Remove(VideoInterface); - end; - - // initialize and set visualization singleton - DefaultVisualization := nil; - FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - begin - VisualInterface := IVideoVisualization(InterfaceList[i]); - if (VisualInterface.Init()) then - begin - DefaultVisualization := VisualInterface; - break; - end; - Log.LogError('Initialize failed, Removing - '+ VisualInterface.GetName); - MediaManager.Remove(VisualInterface); - end; - - InterfaceList.Free; - - // now that we have all interfaces, we can dump them - // TODO: move this to another place - if FindCmdLineSwitch( cMediaInterfaces ) then - begin - DumpMediaInterfaces(); - halt; - end; -end; - -procedure UnloadMediaModules; -var - i: integer; - InterfaceList: TInterfaceList; -begin - FreeAndNil(AudioDecoderList); - DefaultAudioPlayback := nil; - DefaultAudioInput := nil; - DefaultVideoPlayback := nil; - DefaultVisualization := nil; - - // create temporary interface list - InterfaceList := TInterfaceList.Create(); - - // finalize audio playback interfaces (should be done before the decoders) - FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - IAudioPlayback(InterfaceList[i]).FinalizePlayback(); - - // finalize audio input interfaces - FilterInterfaceList(IAudioInput, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - IAudioInput(InterfaceList[i]).FinalizeRecord(); - - // finalize audio decoder interfaces - FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - IAudioDecoder(InterfaceList[i]).FinalizeDecoder(); - - // finalize video interfaces - FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - IVideoPlayback(InterfaceList[i]).Finalize(); - - // finalize audio decoder interfaces - FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - IVideoVisualization(InterfaceList[i]).Finalize(); - - InterfaceList.Free; - - // finally free interfaces (by removing all references to them) - FreeAndNil(MediaInterfaceList); -end; - -procedure FinalizeMedia; -begin - // stop, close and free sounds - SoundLib.Free; - - // stop and close music stream - if (AudioPlayback <> nil) then - AudioPlayback.Close; - - // stop any active captures - if (AudioInput <> nil) then - AudioInput.CaptureStop; - - if (VideoPlayback <> nil) then - VideoPlayback.Close; - - if (Visualization <> nil) then - Visualization.Close; - - UnloadMediaModules(); -end; - -procedure DumpMediaInterfaces(); -begin - writeln( '' ); - writeln( '--------------------------------------------------------------' ); - writeln( ' In-use Media Interfaces ' ); - writeln( '--------------------------------------------------------------' ); - writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); - writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); - writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName ); - writeln( 'Registered Visualization Interface : ' + Visualization.GetName ); - writeln( '--------------------------------------------------------------' ); - writeln( '' ); -end; - - -{ TSoundLibrary } - -constructor TSoundLibrary.Create(); -begin - inherited; - LoadSounds(); -end; - -destructor TSoundLibrary.Destroy(); -begin - UnloadSounds(); - inherited; -end; - -procedure TSoundLibrary.LoadSounds(); -begin - UnloadSounds(); - - Start := AudioPlayback.OpenSound(SoundPath + 'Common start.mp3'); - Back := AudioPlayback.OpenSound(SoundPath + 'Common back.mp3'); - Swoosh := AudioPlayback.OpenSound(SoundPath + 'menu swoosh.mp3'); - Change := AudioPlayback.OpenSound(SoundPath + 'select music change music 50.mp3'); - Option := AudioPlayback.OpenSound(SoundPath + 'option change col.mp3'); - Click := AudioPlayback.OpenSound(SoundPath + 'rimshot022b.mp3'); - - BGMusic := AudioPlayback.OpenSound(SoundPath + 'Bebeto_-_Loop010.mp3'); - - if (BGMusic <> nil) then - BGMusic.Loop := True; -end; - -procedure TSoundLibrary.UnloadSounds(); -begin - FreeAndNil(Start); - FreeAndNil(Back); - FreeAndNil(Swoosh); - FreeAndNil(Change); - FreeAndNil(Option); - FreeAndNil(Click); - FreeAndNil(BGMusic); -end; - -(* TODO -function TSoundLibrary.GetSound(ID: integer): TAudioPlaybackStream; -begin - if ((ID >= 0) and (ID < Length(Sounds))) then - Result := Sounds[ID] - else - Result := nil; -end; -*) - -procedure TSoundLibrary.StartBgMusic(); -begin - if (TBackgroundMusicOption(Ini.BackgroundMusicOption) = bmoOn) and - (Soundlib.BGMusic <> nil) and not (Soundlib.BGMusic.Status = ssPlaying) then - begin - AudioPlayback.PlaySound(Soundlib.BGMusic); - end; -end; - -procedure TSoundLibrary.PauseBgMusic(); -begin - If (Soundlib.BGMusic <> nil) then - begin - Soundlib.BGMusic.Pause; - end; -end; - -{ TVoiceRemoval } - -procedure TVoiceRemoval.Callback(Buffer: PChar; BufSize: integer); -var - FrameIndex, FrameSize: integer; - Value: integer; - Sample: PPCMStereoSample; -begin - FrameSize := 2 * SizeOf(SmallInt); - for FrameIndex := 0 to (BufSize div FrameSize)-1 do - begin - Sample := PPCMStereoSample(Buffer); - // channel difference - Value := Sample[0] - Sample[1]; - // clip - if (Value > High(SmallInt)) then - Value := High(SmallInt) - else if (Value < Low(SmallInt)) then - Value := Low(SmallInt); - // assign result - Sample[0] := Value; - Sample[1] := Value; - // increase to next frame - Inc(Buffer, FrameSize); - end; -end; - - -{ TVoiceRemoval } - -constructor TLyricsState.Create(); -begin - // create a triggered timer, so we can Pause() it, set the time - // and Resume() it afterwards for better synching. - Timer := TRelativeTimer.Create(true); - - // reset state - Reset(); -end; - -procedure TLyricsState.Pause(); -begin - Timer.Pause(); -end; - -procedure TLyricsState.Resume(); -begin - Timer.Resume(); -end; - -procedure TLyricsState.SetCurrentTime(Time: real); -begin - // do not start the timer (if not started already), - // after setting the current time - Timer.SetTime(Time, false); -end; - -function TLyricsState.GetCurrentTime(): real; -begin - Result := Timer.GetTime(); -end; - -(** - * Resets the timer and state of the lyrics. - * The timer will be stopped afterwards so you have to call Resume() - * to start the lyrics timer. - *) -procedure TLyricsState.Reset(); -begin - Pause(); - SetCurrentTime(0); - - StartTime := 0; - TotalTime := 0; - - OldBeat := -1; - MidBeat := -1; - CurrentBeat := -1; - - OldBeatC := -1; - MidBeatC := -1; - CurrentBeatC := -1; - - OldBeatD := -1; - MidBeatD := -1; - CurrentBeatD := -1; -end; - -(** - * Updates the beat information (CurrentBeat/MidBeat/...) according to the - * current lyric time. - *) -procedure TLyricsState.UpdateBeats(); -var - CurLyricsTime: real; -begin - CurLyricsTime := GetCurrentTime(); - - OldBeat := CurrentBeat; - MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000); - CurrentBeat := Floor(MidBeat); - - OldBeatC := CurrentBeatC; - MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000); - CurrentBeatC := Floor(MidBeatC); - - OldBeatD := CurrentBeatD; - // MidBeatD = MidBeat with additional GAP - MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000); - CurrentBeatD := Floor(MidBeatD); -end; - - -{ TAudioConverter } - -function TAudioConverter.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; -begin - fSrcFormatInfo := SrcFormatInfo.Copy(); - fDstFormatInfo := DstFormatInfo.Copy(); - Result := true; -end; - -destructor TAudioConverter.Destroy(); -begin - FreeAndNil(fSrcFormatInfo); - FreeAndNil(fDstFormatInfo); -end; - - -{ TAudioProcessingStream } - -procedure TAudioProcessingStream.AddOnCloseHandler(Handler: TOnCloseHandler); -begin - if (@Handler <> nil) then - begin - SetLength(OnCloseHandlers, System.Length(OnCloseHandlers)+1); - OnCloseHandlers[High(OnCloseHandlers)] := @Handler; - end; -end; - -procedure TAudioProcessingStream.PerformOnClose(); -var i: integer; -begin - for i := 0 to High(OnCloseHandlers) do - begin - OnCloseHandlers[i](Self); - end; -end; - - -{ TAudioPlaybackStream } - -function TAudioPlaybackStream.GetSourceStream(): TAudioSourceStream; -begin - Result := SourceStream; -end; - -procedure TAudioPlaybackStream.SetSyncSource(SyncSource: TSyncSource); -begin - Self.SyncSource := SyncSource; - AvgSyncDiff := -1; -end; - -(* - * Results an adjusted size of the input buffer size to keep the stream in sync - * with the SyncSource. If no SyncSource was assigned to this stream, the - * input buffer size will be returned, so this method will have no effect. - * - * These are the possible cases: - * - Result > BufferSize: stream is behind the sync-source (stream is too slow), - * (Result-BufferSize) bytes of the buffer must be skipped. - * - Result = BufferSize: stream is in sync, - * there is nothing to do. - * - Result < BufferSize: stream is ahead of the sync-source (stream is too fast), - * (BufferSize-Result) bytes of the buffer must be padded. - *) -function TAudioPlaybackStream.Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; -var - TimeDiff: double; - TimeCorrectionFactor: double; -const - AVG_HISTORY_FACTOR = 0.9; - SYNC_THRESHOLD = 0.045; - MAX_SYNC_DIFF_TIME = 0.002; -begin - Result := BufferSize; - - if (not assigned(SyncSource)) then - Exit; - - if (BufferSize <= 0) then - Exit; - - // difference between sync-source and stream position - // (negative if the music-stream's position is ahead of the master clock) - TimeDiff := SyncSource.GetClock() - (Position - GetLatency()); - - // calculate average time difference (some sort of weighted mean). - // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff. - // This means that older diffs are weighted more with a higher history factor - // than with a lower. Do not use a too low history factor. FFmpeg produces - // very instable timestamps (pts) for ogg due to some bugs. They may differ - // +-50ms from the real stream position. Without filtering those glitches we - // would synch without any need, resulting in ugly plopping sounds. - if (AvgSyncDiff = -1) then - AvgSyncDiff := TimeDiff - else - AvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) + - AvgSyncDiff * AVG_HISTORY_FACTOR; - - // check if sync needed - if (Abs(AvgSyncDiff) >= SYNC_THRESHOLD) then - begin - // TODO: use SetPosition if diff is too large (>5s) - if (TimeDiff < 1) then - TimeCorrectionFactor := Sign(TimeDiff)*TimeDiff*TimeDiff - else - TimeCorrectionFactor := TimeDiff; - - // calculate adapted buffer size - // reduce size of data to fetch if music is ahead, increase otherwise - Result := BufferSize + Round(TimeCorrectionFactor * FormatInfo.SampleRate) * FormatInfo.FrameSize; - if (Result < 0) then - Result := 0; - - // reset average - AvgSyncDiff := -1; - end; - - (* - DebugWriteln('Diff: ' + floattostrf(TimeDiff, ffFixed, 15, 3) + - '| SyS: ' + floattostrf(SyncSource.GetClock(), ffFixed, 15, 3) + - '| Pos: ' + floattostrf(Position, ffFixed, 15, 3) + - '| Avg: ' + floattostrf(AvgSyncDiff, ffFixed, 15, 3)); - *) -end; - -(* - * Fills a buffer with copies of the given frame or with 0 if frame. - *) -procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer); -var - i: integer; - FrameCopyCount: integer; -begin - // the buffer must at least contain place for one copy of the frame. - if ((Buffer = nil) or (BufferSize <= 0) or (BufferSize < FrameSize)) then - Exit; - - // no valid frame -> fill with 0 - if ((Frame = nil) or (FrameSize <= 0)) then - begin - FillChar(Buffer[0], BufferSize, 0); - Exit; - end; - - // number of frames to copy - FrameCopyCount := BufferSize div FrameSize; - // insert as many copies of frame into the buffer as possible - for i := 0 to FrameCopyCount-1 do - Move(Frame[0], Buffer[i*FrameSize], FrameSize); -end; - -{ TAudioVoiceStream } - -function TAudioVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; -begin - Self.ChannelMap := ChannelMap; - Self.FormatInfo := FormatInfo.Copy(); - // a voice stream is always mono, reassure the the format is correct - Self.FormatInfo.Channels := 1; - Result := true; -end; - -destructor TAudioVoiceStream.Destroy; -begin - Close(); - inherited; -end; - -procedure TAudioVoiceStream.Close(); -begin - PerformOnClose(); - FreeAndNil(FormatInfo); -end; - -function TAudioVoiceStream.GetAudioFormatInfo(): TAudioFormatInfo; -begin - Result := FormatInfo; -end; - -function TAudioVoiceStream.GetLength(): real; -begin - Result := -1; -end; - -function TAudioVoiceStream.GetPosition(): real; -begin - Result := -1; -end; - -procedure TAudioVoiceStream.SetPosition(Time: real); -begin -end; - -function TAudioVoiceStream.GetLoop(): boolean; -begin - Result := false; -end; - -procedure TAudioVoiceStream.SetLoop(Enabled: boolean); -begin -end; - - -end. diff --git a/src/Classes/UParty.pas b/src/Classes/UParty.pas deleted file mode 100644 index 01a182b1..00000000 --- a/src/Classes/UParty.pas +++ /dev/null @@ -1,630 +0,0 @@ -unit UParty; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -{$I switches.inc} - -uses UPartyDefs, UCoreModule, UPluginDefs; - -type - ARounds = Array [0..252] of Integer; //0..252 needed for - PARounds = ^ARounds; - - TRoundInfo = record - Modi: Cardinal; - Winner: Byte; - end; - - TeamOrderEntry = record - Teamnum: Byte; - Score: Byte; - end; - - TeamOrderArray = Array[0..5] of Byte; - - TUS_ModiInfoEx = record - Info: TUS_ModiInfo; - Owner: Integer; - TimesPlayed: Byte; //Helper for setting Round Plugins - end; - - TPartySession = class (TCoreModule) - private - bPartyMode: Boolean; //Is this Party or Singleplayer - CurRound: Byte; - - Modis: Array of TUS_ModiInfoEx; - Teams: TTeamInfo; - - function IsWinner(Player, Winner: Byte): boolean; - procedure GenScores; - function GetRandomPlugin(TeamMode: Boolean): Cardinal; - function GetRandomPlayer(Team: Byte): Byte; - public - //Teams: TTeamInfo; - Rounds: array of TRoundInfo; - - //TCoreModule methods to inherit - Constructor Create; override; - Procedure Info(const pInfo: PModuleInfo); override; - Function Load: Boolean; override; - Function Init: Boolean; override; - Procedure DeInit; override; - Destructor Destroy; override; - - //Register Modi Service - Function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo - - //Start new Party - Function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new Party Mode. Returns Non Zero on Success - Function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen) - Function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before. - Function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played - - Function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading - Function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and does the RoundEnding - - Function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success - Function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success - - Function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... - Function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam - end; - -const - StandardModi = 0; //Modi ID that will be played in non party Mode - -implementation - -uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils; - -{********************* - TPluginLoader - Implentation -*********************} - -//------------- -// Function that gives some Infos about the Module to the Core -//------------- -Procedure TPartySession.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'TPartySession'; - pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Manages Party Modi and Party Game'; -end; - -//------------- -// Just the Constructor -//------------- -Constructor TPartySession.Create; -begin - inherited; - //UnSet PartyMode - bPartyMode := False; -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 TPartySession.Load: Boolean; -begin - //Add Register Party Modi Service - Result := True; - Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi); - Core.Services.AddService('Party/StartParty', nil, Self.StartParty); - Core.Services.AddService('Party/GetCurModi', nil, Self.GetCurModi); -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 TPartySession.Init: Boolean; -begin - //Just set Prvate Var to true. - Result := true; -end; - -//------------- -//Is Called if this Module has been Inited and there is a Exit. -//Deinit is in backwards Initing Order -//------------- -Procedure TPartySession.DeInit; -begin - //Force DeInit - -end; - -//------------- -//Is Called if this Module will be unloaded and has been created -//Should be used to Free Memory -//------------- -Destructor TPartySession.Destroy; -begin - //Just save some Memory if it wasn't done now.. - SetLength(Modis, 0); - inherited; -end; - -//------------- -// Registers a new Modi. wParam: Pointer to TUS_ModiInfo -// Service for Plugins -//------------- -Function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; -var - Len: Integer; - Info: PUS_ModiInfo; -begin - Info := PModiInfo; - //Copy Info if cbSize is correct - If (Info.cbSize = SizeOf(TUS_ModiInfo)) then - begin - Len := Length(Modis); - SetLength(Modis, Len + 1); - - Modis[Len].Info := Info^; - end - else - Core.ReportError(Integer(PChar('Plugins try to Register Modi with wrong Pointer, or wrong TUS_ModiInfo Record.')), PChar('TPartySession')); - - // FIXME: return a valid result - Result := 0; -end; - -//---------- -// Returns a Number of a Random Plugin -//---------- -Function TPartySession.GetRandomPlugin(TeamMode: Boolean): Cardinal; -var - LowestTP: Byte; - NumPwithLTP: Word; - I: Integer; - R: Word; -begin - Result := StandardModi; //If there are no matching Modis, Play StandardModi - LowestTP := high(Byte); - NumPwithLTP := 0; - - //Search for Plugins not often played yet - For I := 0 to high(Modis) do - begin - if (Modis[I].TimesPlayed < lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then - begin - lowestTP := Modis[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then - begin - Inc(NumPwithLTP); - end; - end; - - //Create Random No - R := Random(NumPwithLTP); - - //Search for Random Plugin - For I := 0 to high(Modis) do - begin - if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then - begin - //Plugin Found - if (R = 0) then - begin - Result := I; - Inc(Modis[I].TimesPlayed); - Break; - end; - - Dec(R); - end; - end; -end; - -//---------- -// Starts new Party Mode. Returns Non Zero on Success -//---------- -Function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; -var - I: Integer; - aiRounds: PARounds; - TeamMode: Boolean; -begin - Result := 0; - If (Teams.NumTeams >= 1) AND (NumRounds < High(Byte)-1) then - begin - bPartyMode := false; - aiRounds := PAofIRounds; - - Try - //Is this Teammode(More then one Player per Team) ? - TeamMode := True; - For I := 0 to Teams.NumTeams-1 do - TeamMode := TeamMode AND (Teams.Teaminfo[I].NumPlayers > 1); - - //Set Rounds - SetLength(Rounds, NumRounds); - - For I := 0 to High(Rounds) do - begin //Set Plugins - If (aiRounds[I] = -1) then - Rounds[I].Modi := GetRandomPlugin(TeamMode) - Else If (aiRounds[I] >= 0) AND (aiRounds[I] <= High(Modis)) AND (TeamMode OR ((Modis[aiRounds[I]].Info.LoadingSettings AND MLS_TeamOnly) = 0)) then - Rounds[I].Modi := aiRounds[I] - Else - Rounds[I].Modi := StandardModi; - - Rounds[I].Winner := High(Byte); //Set Winner to Not Played - end; - - CurRound := High(Byte); //Set CurRound to not defined - - //Return teh true and Set PartyMode - bPartyMode := True; - Result := 1; - - Except - Core.ReportError(Integer(PChar('Can''t start PartyMode.')), PChar('TPartySession')); - end; - end; -end; - -//---------- -// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen) -//---------- -Function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer; -begin - If (bPartyMode) AND (CurRound <= High(Rounds)) then - begin //If PartyMode is enabled: - //Return the Plugin of the Cur Round - Result := Integer(@Modis[Rounds[CurRound].Modi]); - end - else - begin //Return StandardModi - Result := Integer(@Modis[StandardModi]); - end; -end; - -//---------- -// Stops Party Mode. Returns 1 If Partymode was enabled before. And -1 if Change was not possible -//---------- -Function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer; -begin - Result := -1; - If (bPartyMode) then - begin - // to-do : Whitü: Check here if SingScreen is not Shown atm. - bPartyMode := False; - Result := 1; - end - else - Result := 0; -end; - -//---------- -//GetRandomPlayer - Gives back a Random Player to Play next Round -//---------- -function TPartySession.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; -end; - -//---------- -// NextRound - Increases CurRound by 1; Returns num of Round or -1 if last Round is already played -//---------- -Function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer; -var I: Integer; -begin - If ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then - begin //everythings OK! -> Start the Round, maaaaan - Inc(CurRound); - - //Set Players to play this Round - for I := 0 to Teams.NumTeams-1 do - Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); - - // FIXME: return a valid result - Result := 0; - end - else - Result := -1; -end; - -//---------- -//IsWinner - Returns True if the Players Bit is set in the Winner Byte -//---------- -function TPartySession.IsWinner(Player, Winner: Byte): boolean; -var - Bit: Byte; -begin - Bit := 1 shl Player; - - Result := ((Winner AND Bit) = Bit); -end; - -//---------- -//GenScores - Inc Scores for Cur. Round -//---------- -procedure TPartySession.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; - -//---------- -// CallModiInit - Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading -//---------- -Function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer; -begin - If (not bPartyMode) then - begin //Set Rounds if not in PartyMode - SetLength(Rounds, 1); - Rounds[0].Modi := StandardModi; - Rounds[0].Winner := High(Byte); - CurRound := 0; - end; - - Try - //Core. - Except - on E : Exception do - begin - Core.ReportError(Integer(PChar('Error starting Modi: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession')); - If (Rounds[CurRound].Modi = StandardModi) then - begin - Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), PChar('TPartySession')); - Halt; - end - Else //Select StandardModi - begin - Rounds[CurRound].Modi := StandardModi - end; - end; - End; - - // FIXME: return a valid result - Result := 0; -end; - -//---------- -// CallModiDeInit - Calls DeInitProc and does the RoundEnding -//---------- -Function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; -var - I: Integer; - MaxScore: Word; -begin - If (bPartyMode) then - begin - //Get Winner Byte! - if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get Winners from Plugin - Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID) - else - begin //Create winners by Score :/ - Rounds[CurRound].Winner := 0; - MaxScore := 0; - for I := 0 to Teams.NumTeams-1 do - begin - // to-do : recode Percentage stuff - //PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999; - if (Player[I].ScoreTotalInt > MaxScore) then - begin - MaxScore := Player[I].ScoreTotalInt; - Rounds[CurRound].Winner := 1 shl I; - end - else if (Player[I].ScoreTotalInt = MaxScore) AND (Player[I].ScoreTotalInt <> 0) then - begin - Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I); - end; - end; - - - //When nobody has Points -> Everybody loose - if (MaxScore = 0) then - Rounds[CurRound].Winner := 0; - - end; - - //Generate teh Scores - GenScores; - - //Inc Players TimesPlayed - If ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings AND MLS_IncTP) = MLS_IncTP) then - begin - For I := 0 to Teams.NumTeams-1 do - Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed); - end; - end - else if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then - Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID); - - // FIXME: return a valid result - Result := 0; -end; - -//---------- -// GetTeamInfo - Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success -//---------- -Function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; -var Info: ^TTeamInfo; -begin - Result := -1; - Info := pTeamInfo; - If (Info <> nil) then - begin - Try - // to - do : Check Delphi memory management in this case - //Not sure if i had to copy PChars to a new address or if delphi manages this o0 - Info^ := Teams; - Result := 0; - Except - Result := -2; - End; - end; -end; - -//---------- -// SetTeamInfo - Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success -//---------- -Function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; -var - TeamInfobackup: TTeamInfo; - Info: ^TTeamInfo; -begin - Result := -1; - Info := pTeamInfo; - If (Info <> nil) then - begin - Try - TeamInfoBackup := Teams; - // to - do : Check Delphi memory management in this case - //Not sure if i had to copy PChars to a new address or if delphi manages this o0 - Teams := Info^; - Result := 0; - Except - Teams := TeamInfoBackup; - Result := -2; - End; - end; -end; - -//---------- -// GetTeamOrder - Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... -//---------- -Function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; -var - I, J: Integer; - ATeams: array [0..5] of TeamOrderEntry; - TempTeam: TeamOrderEntry; -begin - // to-do : PartyMode: Write this in another way, so that teams with the same scire get the same Placing - //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 - Result := 0; - For I := 0 to Teams.NumTeams-1 do - Result := Result or (ATeams[I].TeamNum Shl I*3); -end; - -//---------- -// GetWinnerString - wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam -//---------- -Function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer; -var - Winners: Array of String; - I: Integer; - ResultStr: String; - S: ^String; -begin - ResultStr := Language.Translate('PARTY_NOBODY'); - - if (wParam <= High(Rounds)) then - begin - if (Rounds[wParam].Winner <> 0) then - begin - if (Rounds[wParam].Winner = 255) then - begin - ResultStr := Language.Translate('PARTY_NOTPLAYEDYET'); - end - else - begin - SetLength(Winners, 0); - for I := 0 to Teams.NumTeams-1 do - begin - if isWinner(I, Rounds[wParam].Winner) then - begin - SetLength(Winners, Length(Winners) + 1); - Winners[high(Winners)] := Teams.TeamInfo[I].Name; - end; - end; - ResultStr := Language.Implode(Winners); - end; - end; - end; - - //Now Return what we have got - If (lParam = nil) then - begin //ReturnString Length - Result := Length(ResultStr); - end - Else - begin //Return String - Try - S := lParam; - S^ := ResultStr; - Result := 0; - Except - Result := -1; - - End; - end; -end; - -end. diff --git a/src/Classes/UPlatform.pas b/src/Classes/UPlatform.pas deleted file mode 100644 index b71ac1b8..00000000 --- a/src/Classes/UPlatform.pas +++ /dev/null @@ -1,165 +0,0 @@ -unit UPlatform; - -// Comment by Eddie: -// This unit defines an interface for platform specific utility functions. -// The Interface is implemented in separate files for each platform: -// UPlatformWindows, UPlatformLinux and UPlatformMacOSX. - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses Classes; - -type - TDirectoryEntry = record - Name : WideString; - IsDirectory : boolean; - IsFile : boolean; - end; - - TDirectoryEntryArray = array of TDirectoryEntry; - - TPlatform = class - procedure Init; virtual; - function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; virtual; abstract; - function TerminateIfAlreadyRunning(var WndTitle : string): boolean; virtual; - function FindSongFile(Dir, Mask: WideString): WideString; virtual; - procedure Halt; virtual; - function GetLogPath : WideString; virtual; abstract; - function GetGameSharedPath : WideString; virtual; abstract; - function GetGameUserPath : WideString; virtual; abstract; - function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; virtual; - end; - - function Platform(): TPlatform; - -implementation - -uses - SysUtils, - {$IFDEF MSWINDOWS} - UPlatformWindows, - {$ENDIF} - {$IFDEF LINUX} - UPlatformLinux, - {$ENDIF} - {$IFDEF DARWIN} - UPlatformMacOSX, - {$ENDIF} - ULog; - - -// I have modified it to use the Platform_singleton in this location ( in the implementaiton ) -// so that this variable can NOT be overwritten from anywhere else in the application. -// the accessor function platform, emulates all previous calls to work the same way. -var - Platform_singleton : TPlatform; - -function Platform : TPlatform; -begin - Result := Platform_singleton; -end; - -(** - * Default Init() implementation - *) -procedure TPlatform.Init; -begin -end; - -(** - * Default Halt() implementation - *) -procedure TPlatform.Halt; -begin - // Note: Application.terminate is NOT the same - System.Halt; -end; - -(** - * Default TerminateIfAlreadyRunning() implementation - *) -function TPlatform.TerminateIfAlreadyRunning(var WndTitle : string): Boolean; -begin - Result := false; -end; - -(** - * Default FindSongFile() implementation - *) -function TPlatform.FindSongFile(Dir, Mask: WideString): WideString; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if SysUtils.FindFirst(Dir + Mask, faDirectory, SR) = 0 then - begin - Result := SR.Name; - end; - SysUtils.FindClose(SR); -end; - -function TPlatform.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; -const - COPY_BUFFER_SIZE = 4096; // a good tradeoff between speed and memory consumption -var - SourceFile, TargetFile: TFileStream; - FileCopyBuffer: array [0..COPY_BUFFER_SIZE-1] of byte; // temporary copy-buffer. - NumberOfBytes: integer; // number of bytes read from SourceFile -begin - Result := false; - SourceFile := nil; - TargetFile := nil; - - // if overwrite is disabled return if the target file already exists - if (FailIfExists and FileExists(Target)) then - Exit; - - try - try - // open source and target file (might throw an exception on error) - SourceFile := TFileStream.Create(Source, fmOpenRead); - TargetFile := TFileStream.Create(Target, fmCreate or fmOpenWrite); - - while true do - begin - // read a block from the source file and check for errors or EOF - NumberOfBytes := SourceFile.Read(FileCopyBuffer, SizeOf(FileCopyBuffer)); - if (NumberOfBytes <= 0) then - Break; - // write block to target file and check if everything was written - if (TargetFile.Write(FileCopyBuffer, NumberOfBytes) <> NumberOfBytes) then - Exit; - end; - except - Exit; - end; - finally - SourceFile.Free; - TargetFile.Free; - end; - - Result := true; -end; - - -initialization -{$IFDEF MSWINDOWS} - Platform_singleton := TPlatformWindows.Create; -{$ENDIF} -{$IFDEF LINUX} - Platform_singleton := TPlatformLinux.Create; -{$ENDIF} -{$IFDEF DARWIN} - Platform_singleton := TPlatformMacOSX.Create; -{$ENDIF} - -finalization - Platform_singleton.Free; - -end. diff --git a/src/Classes/UPlatformLinux.pas b/src/Classes/UPlatformLinux.pas deleted file mode 100644 index 27fb130e..00000000 --- a/src/Classes/UPlatformLinux.pas +++ /dev/null @@ -1,160 +0,0 @@ -unit UPlatformLinux; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - UPlatform, - UConfig; - -type - TPlatformLinux = class(TPlatform) - private - function GetHomeDir(): string; - public - function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override; - - function GetLogPath : WideString; override; - function GetGameSharedPath : WideString; override; - function GetGameUserPath : WideString; override; - end; - -implementation - -uses - UCommandLine, - BaseUnix, - {$IF FPC_VERSION_INT >= 2002002} - pwd, - {$IFEND} - SysUtils, - ULog; - -function TPlatformLinux.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; -var - i: Integer; - TheDir : pDir; - ADirent : pDirent; - Entry : Longint; - lAttrib : integer; -begin - i := 0; - Filter := LowerCase(Filter); - - TheDir := FpOpenDir( Dir ); - if Assigned(TheDir) then - begin - repeat - ADirent := FpReadDir(TheDir^); - - if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then - begin - lAttrib := FileGetAttr(Dir + ADirent^.d_name); - if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then - begin - SetLength( Result, i + 1); - Result[i].Name := ADirent^.d_name; - Result[i].IsDirectory := true; - Result[i].IsFile := false; - i := i + 1; - end - else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then - begin - SetLength( Result, i + 1); - Result[i].Name := ADirent^.d_name; - Result[i].IsDirectory := false; - Result[i].IsFile := true; - i := i + 1; - end; - end; - until (ADirent = nil); - - FpCloseDir(TheDir^); - end; -end; - -function TPlatformLinux.GetLogPath: WideString; -begin - if FindCmdLineSwitch( cUseLocalPaths ) then - begin - Result := ExtractFilePath(ParamStr(0)); - end - else - begin - {$IFDEF UseLocalDirs} - Result := ExtractFilePath(ParamStr(0)); - {$ELSE} - Result := GetGameUserPath() + 'logs' + PathDelim; - {$ENDIF} - end; - - // create non-existing directories - ForceDirectories(Result); -end; - -function TPlatformLinux.GetGameSharedPath: WideString; -begin - if FindCmdLineSwitch( cUseLocalPaths ) then - Result := ExtractFilePath(ParamStr(0)) - else - begin - {$IFDEF UseLocalDirs} - Result := ExtractFilePath(ParamStr(0)); - {$ELSE} - Result := SharedPath + PathDelim; - {$ENDIF} - end; -end; - -function TPlatformLinux.GetGameUserPath: WideString; -begin - if FindCmdLineSwitch( cUseLocalPaths ) then - Result := ExtractFilePath(ParamStr(0)) - else - begin - {$IFDEF UseLocalDirs} - Result := ExtractFilePath(ParamStr(0)); - {$ELSE} - Result := GetHomeDir() + '.'+PathSuffix + PathDelim; - {$ENDIF} - end; -end; - -(** - * Returns the user's home directory terminated by a path delimiter - *) -function TPlatformLinux.GetHomeDir(): string; -{$IF FPC_VERSION_INT >= 2002002} -var - PasswdEntry: PPasswd; -{$IFEND} -begin - Result := ''; - - {$IF FPC_VERSION_INT >= 2002002} - // try to retrieve the info from passwd - PasswdEntry := FpGetpwuid(FpGetuid()); - if (PasswdEntry <> nil) then - Result := PasswdEntry.pw_dir; - {$IFEND} - // fallback if passwd does not contain the path - if (Result = '') then - Result := GetEnvironmentVariable('HOME'); - // add trailing path delimiter (normally '/') - if (Result <> '') then - Result := IncludeTrailingPathDelimiter(Result); - - {$IF FPC_VERSION_INT >= 2002002} - // GetUserDir() is another function that returns a user path. - // It uses env-var HOME or a fallback to a temp-dir. - //Result := GetUserDir(); - {$IFEND} -end; - -end. diff --git a/src/Classes/UPlatformMacOSX.pas b/src/Classes/UPlatformMacOSX.pas deleted file mode 100644 index 849c354b..00000000 --- a/src/Classes/UPlatformMacOSX.pas +++ /dev/null @@ -1,294 +0,0 @@ -unit UPlatformMacOSX; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - ULog, - UPlatform; - -type - {** - * @abstract(Provides Mac OS X specific details.) - * @lastmod(August 1, 2008) - * The UPlatformMacOSX unit takes care of setting paths to resource folders. - * - * (Note for non-Maccies: "folder" is the Mac name for directory.) - * - * Note on the resource folders: - * 1. Installation of an application on the mac works as follows: Extract and copy an application - * and if you don't like or need the application anymore you move the folder - * to the trash - and you're done. - * 2. The use folders in the user's home directory is against Apple's guidelines - * and strange to an average user. - * 3. Even worse is using /usr/local/... since all lowercase folders in / are - * not visible to an average user in the Finder, at least not without some "tricks". - * - * The best way would be to store everything within the application bundle. However, this - * requires USDX to offer the handling of the resources. Until this is implemented, the - * second best solution is as follows: - * - * According to Aple guidelines handling of resources and folders should follow these lines: - * - * Acceptable places for files are folders named UltraStarDeluxe either in - * /Library/Application Support/ - * or - * ~/Library/Application Support/ - * - * So - * GetGameSharedPath could return - * /Library/Application Support/UltraStarDeluxe/Resources/. - * GetGameUserPath could return - * ~/Library/Application Support/UltraStarDeluxe/Resources/. - * - * Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources - * is used. So every user needs the complete set of files and folders. - * Future versions may also use shared resources in - * /Library/Application Support/UltraStarDeluxe/Resources. However, this is not - * treated yet in the code outside this unit. - * - * USDX checks, whether GetGameUserPath exists. If not, USDX creates it. - * The existence of needed files is then checked and if a file is missing - * it is copied to there from within the Resources folder in the Application - * bundle, which contains the default files. USDX should not delete files or - * folders in Application Support/UltraStarDeluxe automatically or without - * user confirmation. - *} - TPlatformMacOSX = class(TPlatform) - private - {** - * GetBundlePath returns the path to the application bundle UltraStarDeluxe.app. - *} - function GetBundlePath: WideString; - - {** - * GetApplicationSupportPath returns the path to - * $HOME/Library/Application Support/UltraStarDeluxe/Resources. - *} - function GetApplicationSupportPath: WideString; - - {** - * see the description of @link(Init). - *} - procedure CreateUserFolders(); - - public - {** - * Init simply calls @link(CreateUserFolders), which in turn scans the folder - * UltraStarDeluxe.app/Contents/Resources for all files and folders. - * $HOME/Library/Application Support/UltraStarDeluxe/Resources is then checked - * for their presence and missing ones are copied. - *} - procedure Init; override; - - {** - * DirectoryFindFiles returns all entries of a folder with names and booleans - * about their type, i.e. file or directory. - *} - function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; override; - - {** - * GetLogPath returns the path for log messages. Currently it is set to - * $HOME/Library/Application Support/UltraStarDeluxe/Resources/Log. - *} - function GetLogPath : WideString; override; - - {** - * GetGameSharedPath returns the path for shared resources. Currently it is set to - * /Library/Application Support/UltraStarDeluxe/Resources. - * However it is not used. - *} - function GetGameSharedPath : WideString; override; - - {** - * GetGameUserPath returns the path for user resources. Currently it is set to - * $HOME/Library/Application Support/UltraStarDeluxe/Resources. - * This is where a user can add songs, themes, .... - *} - function GetGameUserPath : WideString; override; - end; - -implementation - -uses - SysUtils, - BaseUnix; - -procedure TPlatformMacOSX.Init; -begin - CreateUserFolders(); -end; - -procedure TPlatformMacOSX.CreateUserFolders(); -var - RelativePath: string; - // BaseDir contains the path to the folder, where a search is performed. - // It is set to the entries in @link(DirectoryList) one after the other. - BaseDir: string; - // OldBaseDir contains the path to the folder, where the search started. - // It is used to return to it, when the search is completed in all folders. - OldBaseDir: string; - // This record contains the result of a file search with FindFirst or FindNext - SearchInfo: TSearchRec; - // These two lists contain all folder and file names found - // within the folder @link(BaseDir). - DirectoryList, FileList: TStringList; - // DirectoryIsFinished contains the index of the folder in @link(DirectoryList), - // which is the last one completely searched. Later folders are still to be - // searched for additional files and folders. - DirectoryIsFinished: longint; - Counter: longint; - - UserPathName: string; -const - // used to construct the @link(UserPathName) - PathName: string = '/Library/Application Support/UltraStarDeluxe/Resources'; -begin - // Get the current folder and save it in OldBaseDir for returning to it, when - // finished. - GetDir(0, OldBaseDir); - - // UltraStarDeluxe.app/Contents/Resources contains all the default files and - // folders. - BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents/Resources'; - ChDir(BaseDir); - - // Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources - // is used. - UserPathName := GetEnvironmentVariable('HOME') + PathName; - - DirectoryIsFinished := 0; - DirectoryList := TStringList.Create(); - FileList := TStringList.Create(); - DirectoryList.Add('.'); - - // create the folder and file lists - repeat - - RelativePath := DirectoryList[DirectoryIsFinished]; - ChDir(BaseDir + '/' + RelativePath); - if (FindFirst('*', faAnyFile, SearchInfo) = 0) then - begin - repeat - if DirectoryExists(SearchInfo.Name) then - begin - if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then - DirectoryList.Add(RelativePath + '/' + SearchInfo.Name); - end - else - Filelist.Add(RelativePath + '/' + SearchInfo.Name); - until (FindNext(SearchInfo) <> 0); - end; - FindClose(SearchInfo); - Inc(DirectoryIsFinished); - until (DirectoryIsFinished = DirectoryList.Count); - - // create missing folders - for Counter := 0 to DirectoryList.Count-1 do - begin - if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then - Log.LogError('Failed to create the folder "'+ UserPathName + '/' + DirectoryList[Counter] +'"', - 'TPlatformMacOSX.CreateUserFolders'); - end; - DirectoryList.Free(); - - // copy missing files - for Counter := 0 to Filelist.Count-1 do - begin - CopyFile(BaseDir + '/' + Filelist[Counter], - UserPathName + '/' + Filelist[Counter], true); - end; - FileList.Free(); - - // go back to the initial folder - ChDir(OldBaseDir); -end; - -function TPlatformMacOSX.GetBundlePath: WideString; -var - i, pos : integer; -begin - // Mac applications are packaged in folders. - // We have to cut the last two folders - // to get the application folder. - - Result := ExtractFilePath(ParamStr(0)); - for i := 1 to 2 do - begin - pos := Length(Result); - repeat - Delete(Result, pos, 1); - pos := Length(Result); - until (pos = 0) or (Result[pos] = '/'); - end; -end; - -function TPlatformMacOSX.GetApplicationSupportPath: WideString; -const - PathName : string = '/Library/Application Support/UltraStarDeluxe/Resources'; -begin - Result := GetEnvironmentVariable('HOME') + PathName + '/'; -end; - -function TPlatformMacOSX.GetLogPath: WideString; -begin - Result := GetApplicationSupportPath + 'Logs'; -end; - -function TPlatformMacOSX.GetGameSharedPath: WideString; -begin - Result := GetApplicationSupportPath; -end; - -function TPlatformMacOSX.GetGameUserPath: WideString; -begin - Result := GetApplicationSupportPath; -end; - -function TPlatformMacOSX.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; -var - i : integer; - TheDir : pdir; - ADirent : pDirent; - lAttrib : integer; -begin - i := 0; - Filter := LowerCase(Filter); - - TheDir := FPOpenDir(Dir); - if Assigned(TheDir) then - repeat - ADirent := FPReadDir(TheDir); - - if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then - begin - lAttrib := FileGetAttr(Dir + ADirent^.d_name); - if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then - begin - SetLength(Result, i + 1); - Result[i].Name := ADirent^.d_name; - Result[i].IsDirectory := true; - Result[i].IsFile := false; - i := i + 1; - end - else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then - begin - SetLength(Result, i + 1); - Result[i].Name := ADirent^.d_name; - Result[i].IsDirectory := false; - Result[i].IsFile := true; - i := i + 1; - end; - end; - until ADirent = nil; - - FPCloseDir(TheDir); -end; - -end. diff --git a/src/Classes/UPlatformWindows.pas b/src/Classes/UPlatformWindows.pas deleted file mode 100644 index ee132a7b..00000000 --- a/src/Classes/UPlatformWindows.pas +++ /dev/null @@ -1,236 +0,0 @@ -unit UPlatformWindows; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -// turn off messages for platform specific symbols -{$WARN SYMBOL_PLATFORM OFF} - -uses - Classes, - UPlatform; - -type - TPlatformWindows = class(TPlatform) - private - function GetSpecialPath(CSIDL: integer): WideString; - public - function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override; - function TerminateIfAlreadyRunning(var WndTitle: String): Boolean; override; - - function GetLogPath: WideString; override; - function GetGameSharedPath: WideString; override; - function GetGameUserPath: WideString; override; - - function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; override; - end; - -implementation - -uses - SysUtils, - ShlObj, - Windows, - UConfig; - -type - TSearchRecW = record - Time: Integer; - Size: Integer; - Attr: Integer; - Name: WideString; - ExcludeAttr: Integer; - FindHandle: THandle; - FindData: TWin32FindDataW; - end; - -function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; forward; -function FindNextW(var F: TSearchRecW): Integer; forward; -procedure FindCloseW(var F: TSearchRecW); forward; -function FindMatchingFileW(var F: TSearchRecW): Integer; forward; -function DirectoryExistsW(const Directory: widestring): Boolean; forward; - -function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; -const - faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; -begin - F.ExcludeAttr := not Attr and faSpecial; -{$IFDEF Delphi} - F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); -{$ELSE} - F.FindHandle := FindFirstFileW(PWideChar(Path), @F.FindData); -{$ENDIF} - if F.FindHandle <> INVALID_HANDLE_VALUE then - begin - Result := FindMatchingFileW(F); - if Result <> 0 then FindCloseW(F); - end else - Result := GetLastError; -end; - -function FindNextW(var F: TSearchRecW): Integer; -begin -{$IFDEF Delphi} - if FindNextFileW(F.FindHandle, F.FindData) then -{$ELSE} - if FindNextFileW(F.FindHandle, @F.FindData) then -{$ENDIF} - Result := FindMatchingFileW(F) - else - Result := GetLastError; -end; - -procedure FindCloseW(var F: TSearchRecW); -begin - if F.FindHandle <> INVALID_HANDLE_VALUE then - begin - Windows.FindClose(F.FindHandle); - F.FindHandle := INVALID_HANDLE_VALUE; - end; -end; - -function FindMatchingFileW(var F: TSearchRecW): Integer; -var - LocalFileTime: TFileTime; -begin - with F do - begin - while FindData.dwFileAttributes and ExcludeAttr <> 0 do -{$IFDEF Delphi} - if not FindNextFileW(FindHandle, FindData) then -{$ELSE} - if not FindNextFileW(FindHandle, @FindData) then -{$ENDIF} - begin - Result := GetLastError; - Exit; - end; - FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); - FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); - Size := FindData.nFileSizeLow; - Attr := FindData.dwFileAttributes; - Name := FindData.cFileName; - end; - Result := 0; -end; - -function DirectoryExistsW(const Directory: widestring): Boolean; -var - Code: Integer; -begin - Code := GetFileAttributesW(PWideChar(Directory)); - Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); -end; - -//------------------------------ -//Start more than One Time Prevention -//------------------------------ -function TPlatformWindows.TerminateIfAlreadyRunning(var WndTitle: String): Boolean; -var - hWnd: THandle; - I: Integer; -begin - Result := false; - hWnd:= FindWindow(nil, PChar(WndTitle)); - //Programm already started - if (hWnd <> 0) then - begin - I := Messagebox(0, PChar('Another Instance of Ultrastar is already running. Continue ?'), PChar(WndTitle), MB_ICONWARNING or MB_YESNO); - if (I = IDYes) then - begin - I := 1; - repeat - Inc(I); - hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I))); - until (hWnd = 0); - WndTitle := WndTitle + ' Instance ' + InttoStr(I); - end - else - Result := true; - end; -end; - -function TPlatformWindows.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; -var - i : Integer; - SR : TSearchRecW; - Attrib : Integer; -begin - i := 0; - Filter := LowerCase(Filter); - - if FindFirstW(Dir + '*', faAnyFile or faDirectory, SR) = 0 then - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - begin - Attrib := FileGetAttr(Dir + SR.name); - if ReturnAllSubDirs and ((Attrib and faDirectory) <> 0) then - begin - SetLength( Result, i + 1); - Result[i].Name := SR.name; - Result[i].IsDirectory := true; - Result[i].IsFile := false; - i := i + 1; - end - else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(SR.Name)) > 0) then - begin - SetLength( Result, i + 1); - Result[i].Name := SR.Name; - Result[i].IsDirectory := false; - Result[i].IsFile := true; - i := i + 1; - end; - end; - until FindNextW(SR) <> 0; - FindCloseW(SR); -end; - -(** - * Returns the path of a special folder. - * - * Some Folder IDs: - * CSIDL_APPDATA (e.g. C:\Documents and Settings\username\Application Data) - * CSIDL_LOCAL_APPDATA (e.g. C:\Documents and Settings\username\Local Settings\Application Data) - * CSIDL_PROFILE (e.g. C:\Documents and Settings\username) - * CSIDL_PERSONAL (e.g. C:\Documents and Settings\username\My Documents) - * CSIDL_MYMUSIC (e.g. C:\Documents and Settings\username\My Documents\My Music) - *) -function TPlatformWindows.GetSpecialPath(CSIDL: integer): WideString; -var - Buffer: array [0..MAX_PATH-1] of WideChar; -begin -{$IF Defined(Delphi) or (FPC_VERSION_INT >= 2002002)} // >= 2.2.2 - if (SHGetSpecialFolderPathW(0, @Buffer, CSIDL, false)) then - Result := Buffer - else -{$IFEND} - Result := ''; -end; - -function TPlatformWindows.GetLogPath: WideString; -begin - Result := ExtractFilePath(ParamStr(0)); -end; - -function TPlatformWindows.GetGameSharedPath: WideString; -begin - Result := ExtractFilePath(ParamStr(0)); -end; - -function TPlatformWindows.GetGameUserPath: WideString; -begin - //Result := GetSpecialPath(CSIDL_APPDATA) + PathDelim + 'UltraStarDX' + PathDelim; - Result := ExtractFilePath(ParamStr(0)); -end; - -function TPlatformWindows.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; -begin - Result := Windows.CopyFileW(PWideChar(Source), PWideChar(Target), FailIfExists); -end; - -end. diff --git a/src/Classes/UPlaylist.pas b/src/Classes/UPlaylist.pas deleted file mode 100644 index c867c356..00000000 --- a/src/Classes/UPlaylist.pas +++ /dev/null @@ -1,490 +0,0 @@ -unit UPlaylist; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses - USong; - -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: TSingMode; //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 - inherited; - LoadPlayLists; -end; - -//---------- -//LoadPlayLists - Load list of Playlists from PlayList Folder -//---------- -Procedure TPlayListManager.LoadPlayLists; -var - SR: TSearchRec; - Len: Integer; - PlayListBuffer: TPlayList; -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) - else - begin - // Sort the Playlists - Insertion Sort - PlayListBuffer := Playlists[Len]; - Dec(Len); - while (Len >= 0) AND (CompareText(Playlists[Len].Name, PlayListBuffer.Name) >= 0) do - begin - Playlists[Len+1] := Playlists[Len]; - Dec(Len); - end; - Playlists[Len+1] := PlayListBuffer; - end; - - 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 (Int(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 := smPlayListRandom; - - //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); - - // Sort the Playlists - Insertion Sort - while (Result > 0) AND (CompareText(Playlists[Result - 1].Name, Name) >= 0) do - begin - Dec(Result); - Playlists[Result+1] := Playlists[Result]; - end; - 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 Int(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 (Int(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 (Int(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 - Result := -1; - - if iPlaylist = -1 then - P := CurPlaylist - else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then - P := iPlaylist - else - exit; - - For I := 0 to high(Playlists[P].Items) do - begin - if (Playlists[P].Items[I].SongID = Int(SongID)) then - begin - Result := I; - Break; - end; - end; -end; - -end. diff --git a/src/Classes/UPluginInterface.pas b/src/Classes/UPluginInterface.pas deleted file mode 100644 index 77693d0f..00000000 --- a/src/Classes/UPluginInterface.pas +++ /dev/null @@ -1,156 +0,0 @@ -unit uPluginInterface; -{********************* - uPluginInterface - Unit fills a TPluginInterface Structur with Method Pointers - Unit Contains all Functions called directly by Plugins -*********************} - -interface - -{$I switches.inc} - -uses uPluginDefs; - -//--------------- -// Methods for Plugin -//--------------- - {******** Hook specific Methods ********} - {Function Creates a new Hookable Event and Returns the Handle - or 0 on Failure. (Name already exists)} - Function CreateHookableEvent (EventName: PChar): THandle; stdcall; - - {Function Destroys an Event and Unhooks all Hooks to this Event. - 0 on success, not 0 on Failure} - Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; - - {Function start calling the Hook Chain - 0 if Chain is called until the End, -1 if Event Handle is not valid - otherwise Return Value of the Hook that breaks the Chain} - Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; - - {Function Hooks an Event by Name. - Returns Hook Handle on Success, otherwise 0} - Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; - - {Function Removes the Hook from the Chain - Returns 0 on Success} - Function UnHookEvent (hHook: THandle): Integer; stdcall; - - {Function Returns Non Zero if a Event with the given Name Exists, - otherwise 0} - Function EventExists (EventName: PChar): Integer; stdcall; - - {******** Service specific Methods ********} - {Function Creates a new Service and Returns the Services Handle - or 0 on Failure. (Name already exists)} - Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; - - {Function Destroys a Service. - 0 on success, not 0 on Failure} - Function DestroyService (hService: THandle): integer; stdcall; - - {Function Calls a Services Proc - Returns Services Return Value or SERVICE_NOT_FOUND on Failure} - Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; - - {Function Returns Non Zero if a Service with the given Name Exists, - otherwise 0} - Function ServiceExists (ServiceName: PChar): Integer; stdcall; - -implementation -uses UCore; - -{******** Hook specific Methods ********} -//--------------- -// Function Creates a new Hookable Event and Returns the Handle -// or 0 on Failure. (Name already exists) -//--------------- -Function CreateHookableEvent (EventName: PChar): THandle; stdcall; -begin - Result := Core.Hooks.AddEvent(EventName); -end; - -//--------------- -// Function Destroys an Event and Unhooks all Hooks to this Event. -// 0 on success, not 0 on Failure -//--------------- -Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; -begin - Result := Core.Hooks.DelEvent(hEvent); -end; - -//--------------- -// Function start calling the Hook Chain -// 0 if Chain is called until the End, -1 if Event Handle is not valid -// otherwise Return Value of the Hook that breaks the Chain -//--------------- -Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; -begin - Result := Core.Hooks.CallEventChain(hEvent, wParam, lParam); -end; - -//--------------- -// Function Hooks an Event by Name. -// Returns Hook Handle on Success, otherwise 0 -//--------------- -Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; -begin - Result := Core.Hooks.AddSubscriber(EventName, HookProc); -end; - -//--------------- -// Function Removes the Hook from the Chain -// Returns 0 on Success -//--------------- -Function UnHookEvent (hHook: THandle): Integer; stdcall; -begin - Result := Core.Hooks.DelSubscriber(hHook); -end; - -//--------------- -// Function Returns Non Zero if a Event with the given Name Exists, -// otherwise 0 -//--------------- -Function EventExists (EventName: PChar): Integer; stdcall; -begin - Result := Core.Hooks.EventExists(EventName); -end; - - {******** Service specific Methods ********} -//--------------- -// Function Creates a new Service and Returns the Services Handle -// or 0 on Failure. (Name already exists) -//--------------- -Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; -begin - Result := Core.Services.AddService(ServiceName, ServiceProc); -end; - -//--------------- -// Function Destroys a Service. -// 0 on success, not 0 on Failure -//--------------- -Function DestroyService (hService: THandle): integer; stdcall; -begin - Result := Core.Services.DelService(hService); -end; - -//--------------- -// Function Calls a Services Proc -// Returns Services Return Value or SERVICE_NOT_FOUND on Failure -//--------------- -Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; -begin - Result := Core.Services.CallService(ServiceName, wParam, lParam); -end; - -//--------------- -// Function Returns Non Zero if a Service with the given Name Exists, -// otherwise 0 -//--------------- -Function ServiceExists (ServiceName: PChar): Integer; stdcall; -begin - Result := Core.Services.ServiceExists(ServiceName); -end; - -end. diff --git a/src/Classes/URecord.pas b/src/Classes/URecord.pas deleted file mode 100644 index 8a537dc9..00000000 --- a/src/Classes/URecord.pas +++ /dev/null @@ -1,766 +0,0 @@ -unit URecord; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses Classes, - Math, - SysUtils, - sdl, - UCommon, - UMusic, - UIni; - -const - BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz) - NumHalftones = 36; // C2-B4 (for Whitney and my high voice) - -type - TCaptureBuffer = class - private - VoiceStream: TAudioVoiceStream; // stream for voice passthrough - AnalysisBufferLock: PSDL_Mutex; - - function GetToneString: string; // converts a tone to its string represenatation; - - procedure BoostBuffer(Buffer: PChar; Size: Cardinal); - procedure ProcessNewBuffer(Buffer: PChar; BufferSize: integer); - - // we call it to analyze sound by checking Autocorrelation - procedure AnalyzeByAutocorrelation; - // use this to check one frequency by Autocorrelation - function AnalyzeAutocorrelationFreq(Freq: real): real; - public - AnalysisBuffer: array[0..4095] of smallint; // newest 4096 samples - AnalysisBufferSize: integer; // number of samples of BufferArray to analyze - - LogBuffer: TMemoryStream; // full buffer - - AudioFormat: TAudioFormatInfo; - - // pitch detection - // TODO: remove ToneValid, set Tone/ToneAbs=-1 if invalid instead - ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise) - Tone: integer; // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11 - ToneAbs: integer; // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1 - - // methods - constructor Create; - destructor Destroy; override; - - procedure Clear; - - // use to analyze sound from buffers to get new pitch - procedure AnalyzeBuffer; - procedure LockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} - procedure UnlockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} - - function MaxSampleVolume: Single; - property ToneString: string READ GetToneString; - end; - -const - DEFAULT_SOURCE_NAME = '[Default]'; - -type - TAudioInputSource = record - Name: string; - end; - - // soundcard input-devices information - TAudioInputDevice = class - public - CfgIndex: integer; // index of this device in Ini.InputDeviceConfig - Name: string; // soundcard name - Source: array of TAudioInputSource; // soundcard input-sources - SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected) - MicSource: integer; // source-index of mic (-1: none detected) - - AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo) - CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data - - destructor Destroy; override; - - procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); - - // TODO: add Open/Close functions so Start/Stop becomes faster - //function Open(): boolean; virtual; abstract; - //function Close(): boolean; virtual; abstract; - function Start(): boolean; virtual; abstract; - function Stop(): boolean; virtual; abstract; - - function GetVolume(): single; virtual; abstract; - procedure SetVolume(Volume: single); virtual; abstract; - end; - - TAudioInputProcessor = class - public - Sound: array of TCaptureBuffer; // sound-buffers for every player - DeviceList: array of TAudioInputDevice; - - constructor Create; - destructor Destroy; override; - - procedure UpdateInputDeviceConfig; - - // handle microphone input - procedure HandleMicrophoneData(Buffer: PChar; Size: Cardinal; - InputDevice: TAudioInputDevice); - end; - - TAudioInputBase = class( TInterfacedObject, IAudioInput ) - private - Started: boolean; - protected - function UnifyDeviceName(const name: string; deviceIndex: integer): string; - public - function GetName: String; virtual; abstract; - function InitializeRecord: boolean; virtual; abstract; - function FinalizeRecord: boolean; virtual; - - procedure CaptureStart; - procedure CaptureStop; - end; - - - TSmallIntArray = array [0..(MaxInt div SizeOf(SmallInt))-1] of SmallInt; - PSmallIntArray = ^TSmallIntArray; - - function AudioInputProcessor(): TAudioInputProcessor; - -implementation - -uses - ULog, - UMain; - -var - singleton_AudioInputProcessor : TAudioInputProcessor = nil; - - -{ Global } - -function AudioInputProcessor(): TAudioInputProcessor; -begin - if singleton_AudioInputProcessor = nil then - singleton_AudioInputProcessor := TAudioInputProcessor.create(); - - result := singleton_AudioInputProcessor; -end; - - -{ TAudioInputDevice } - -destructor TAudioInputDevice.Destroy; -begin - Stop(); - Source := nil; - CaptureChannel := nil; - FreeAndNil(AudioFormat); - inherited Destroy; -end; - -procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); -var - DeviceCfg: PInputDeviceConfig; - OldSound: TCaptureBuffer; -begin - // check bounds - if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then - Exit; - - // reset previously assigned (old) capture-buffer - OldSound := CaptureChannel[ChannelIndex]; - if (OldSound <> nil) then - begin - // close voice stream - FreeAndNil(OldSound.VoiceStream); - // free old audio-format info - FreeAndNil(OldSound.AudioFormat); - end; - - // set audio-format of new capture-buffer - if (Sound <> nil) then - begin - // copy the input-device audio-format ... - Sound.AudioFormat := AudioFormat.Copy; - // and adjust it because capture buffers are always mono - Sound.AudioFormat.Channels := 1; - DeviceCfg := @Ini.InputDeviceConfig[CfgIndex]; - - if (Ini.VoicePassthrough = 1) then - begin - // TODO: map odd players to the left and even players to the right speaker - Sound.VoiceStream := AudioPlayback.CreateVoiceStream(CHANNELMAP_FRONT, AudioFormat); - end; - end; - - // replace old with new buffer (Note: Sound might be nil) - CaptureChannel[ChannelIndex] := Sound; -end; - -{ TSound } - -constructor TCaptureBuffer.Create; -begin - inherited; - LogBuffer := TMemoryStream.Create; - AnalysisBufferLock := SDL_CreateMutex(); - AnalysisBufferSize := Length(AnalysisBuffer); -end; - -destructor TCaptureBuffer.Destroy; -begin - FreeAndNil(LogBuffer); - FreeAndNil(VoiceStream); - FreeAndNil(AudioFormat); - SDL_DestroyMutex(AnalysisBufferLock); - inherited; -end; - -procedure TCaptureBuffer.LockAnalysisBuffer(); -begin - SDL_mutexP(AnalysisBufferLock); -end; - -procedure TCaptureBuffer.UnlockAnalysisBuffer(); -begin - SDL_mutexV(AnalysisBufferLock); -end; - -procedure TCaptureBuffer.Clear; -begin - if assigned(LogBuffer) then - LogBuffer.Clear; - LockAnalysisBuffer(); - FillChar(AnalysisBuffer[0], Length(AnalysisBuffer) * SizeOf(SmallInt), 0); - UnlockAnalysisBuffer(); -end; - -procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PChar; BufferSize: integer); -var - BufferOffset: integer; - SampleCount: integer; - i: integer; -begin - // apply software boost - //BoostBuffer(Buffer, Size); - - // voice passthrough (send data to playback-device) - if (assigned(VoiceStream)) then - VoiceStream.WriteData(Buffer, BufferSize); - - // we assume that samples are in S16Int format - // TODO: support float too - if (AudioFormat.Format <> asfS16) then - Exit; - - // process BufferArray - BufferOffset := 0; - - SampleCount := BufferSize div SizeOf(SmallInt); - - // check if we have more new samples than we can store - if (SampleCount > Length(AnalysisBuffer)) then - begin - // discard the oldest of the new samples - BufferOffset := (SampleCount - Length(AnalysisBuffer)) * SizeOf(SmallInt); - SampleCount := Length(AnalysisBuffer); - end; - - - LockAnalysisBuffer(); - try - - // move old samples to the beginning of the array (if necessary) - for i := 0 to High(AnalysisBuffer)-SampleCount do - AnalysisBuffer[i] := AnalysisBuffer[i+SampleCount]; - - // copy new samples to analysis buffer - Move(Buffer[BufferOffset], AnalysisBuffer[Length(AnalysisBuffer)-SampleCount], - SampleCount * SizeOf(SmallInt)); - - finally - UnlockAnalysisBuffer(); - end; - - - // save capture-data to BufferLong if enabled - if (Ini.SavePlayback = 1) then - begin - // this is just for debugging (approx 15MB per player for a 3min song!!!) - // For an in-game replay-mode we need to compress data so we do not - // waste that much memory. Maybe ogg-vorbis with voice-preset in fast-mode? - // Or we could use a faster but not that efficient lossless compression. - LogBuffer.WriteBuffer(Buffer, BufferSize); - end; -end; - -procedure TCaptureBuffer.AnalyzeBuffer; -var - Volume: single; - MaxVolume: single; - SampleIndex: integer; - Threshold: single; -begin - ToneValid := false; - ToneAbs := -1; - Tone := -1; - - LockAnalysisBuffer(); - try - - // find maximum volume of first 1024 samples - MaxVolume := 0; - for SampleIndex := 0 to 1023 do - begin - Volume := Abs(AnalysisBuffer[SampleIndex]) / -Low(Smallint); - if Volume > MaxVolume then - MaxVolume := Volume; - end; - - Threshold := IThresholdVals[Ini.ThresholdIndex]; - - // check if signal has an acceptable volume (ignore background-noise) - if MaxVolume >= Threshold then - begin - // analyse the current voice pitch - AnalyzeByAutocorrelation; - ToneValid := true; - end; - - finally - UnlockAnalysisBuffer(); - end; -end; - -procedure TCaptureBuffer.AnalyzeByAutocorrelation; -var - ToneIndex: integer; - CurFreq: real; - CurWeight: real; - MaxWeight: real; - MaxTone: integer; -const - HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave) -begin - // prepare to analyze - MaxWeight := -1; - MaxTone := 0; // this is not needed, but it satifies the compiler - - // analyze halftones - // Note: at the lowest tone (~65Hz) and a buffer-size of 4096 - // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be - // too few samples -> use a bigger buffer-size - for ToneIndex := 0 to NumHalftones-1 do - begin - CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex); - CurWeight := AnalyzeAutocorrelationFreq(CurFreq); - - // TODO: prefer higher frequencies (use >= or use downto) - if (CurWeight > MaxWeight) then - begin - // this frequency has a higher weight - MaxWeight := CurWeight; - MaxTone := ToneIndex; - end; - end; - - ToneAbs := MaxTone; - Tone := MaxTone mod 12; -end; - -// result medium difference -function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real; -var - Dist: real; // distance (0=equal .. 1=totally different) between correlated samples - AccumDist: real; // accumulated distances - SampleIndex: integer; // index of sample to analyze - CorrelatingSampleIndex: integer; // index of sample one period ahead - SamplesPerPeriod: integer; // samples in one period -begin - SampleIndex := 0; - SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq); - CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod; - - AccumDist := 0; - - // compare correlating samples - while (CorrelatingSampleIndex < AnalysisBufferSize) do - begin - // calc distance (correlation: 1-dist) to corresponding sample in next period - Dist := Abs(AnalysisBuffer[SampleIndex] - AnalysisBuffer[CorrelatingSampleIndex]) / - High(Word); - AccumDist := AccumDist + Dist; - Inc(SampleIndex); - Inc(CorrelatingSampleIndex); - end; - - // return "inverse" average distance (=correlation) - Result := 1 - AccumDist / AnalysisBufferSize; -end; - -function TCaptureBuffer.MaxSampleVolume: Single; -var - lSampleIndex: Integer; - lMaxVol : Longint; -begin; - LockAnalysisBuffer(); - try - lMaxVol := 0; - for lSampleIndex := 0 to High(AnalysisBuffer) do - begin - if Abs(AnalysisBuffer[lSampleIndex]) > lMaxVol then - lMaxVol := Abs(AnalysisBuffer[lSampleIndex]); - end; - finally - UnlockAnalysisBuffer(); - end; - - result := lMaxVol / -Low(Smallint); -end; - -const - ToneStrings: array[0..11] of string = ( - 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B' - ); - -function TCaptureBuffer.GetToneString: string; -begin - if (ToneValid) then - Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2) - else - Result := '-'; -end; - -procedure TCaptureBuffer.BoostBuffer(Buffer: PChar; Size: Cardinal); -var - i: integer; - Value: Longint; - SampleCount: integer; - SampleBuffer: PSmallIntArray; // buffer handled as array of samples - Boost: byte; -begin - // TODO: set boost per device - { - case Ini.MicBoost of - 0: Boost := 1; - 1: Boost := 2; - 2: Boost := 4; - 3: Boost := 8; - else Boost := 1; - end; - } - Boost := 1; - - // at the moment we will boost SInt16 data only - if (AudioFormat.Format = asfS16) then - begin - // interpret buffer as buffer of bytes - SampleBuffer := PSmallIntArray(Buffer); - SampleCount := Size div AudioFormat.FrameSize; - - // boost buffer - for i := 0 to SampleCount-1 do - begin - Value := SampleBuffer^[i] * Boost; - - // TODO : JB - This will clip the audio... cant we reduce the "Boost" if the data clips ?? - if Value > High(Smallint) then - Value := High(Smallint); - - if Value < Low(Smallint) then - Value := Low(Smallint); - - SampleBuffer^[i] := Value; - end; - end; -end; - - -{ TAudioInputProcessor } - -constructor TAudioInputProcessor.Create; -var - i: integer; -begin - inherited; - SetLength(Sound, 6 {max players});//Ini.Players+1); - for i := 0 to High(Sound) do - Sound[i] := TCaptureBuffer.Create; -end; - -destructor TAudioInputProcessor.Destroy; -var - i: integer; -begin - for i := 0 to High(Sound) do - Sound[i].Free; - SetLength(Sound, 0); - inherited; -end; - -// updates InputDeviceConfig with current input-device information -// See: TIni.LoadInputDeviceCfg() -procedure TAudioInputProcessor.UpdateInputDeviceConfig; -var - deviceIndex: integer; - newDevice: boolean; - deviceIniIndex: integer; - deviceCfg: PInputDeviceConfig; - device: TAudioInputDevice; - channelCount: integer; - channelIndex: integer; - i: integer; -begin - // Input devices - append detected soundcards - for deviceIndex := 0 to High(DeviceList) do - begin - newDevice := true; - //Search for Card in List - for deviceIniIndex := 0 to High(Ini.InputDeviceConfig) do - begin - deviceCfg := @Ini.InputDeviceConfig[deviceIniIndex]; - device := DeviceList[deviceIndex]; - - if (deviceCfg.Name = Trim(device.Name)) then - begin - newDevice := false; - - // store highest channel index as an offset for the new channels - channelIndex := High(deviceCfg.ChannelToPlayerMap); - // add missing channels or remove non-existing ones - SetLength(deviceCfg.ChannelToPlayerMap, device.AudioFormat.Channels); - // initialize added channels to 0 - for i := channelIndex+1 to High(deviceCfg.ChannelToPlayerMap) do - begin - deviceCfg.ChannelToPlayerMap[i] := 0; - end; - - // associate ini-index with device - device.CfgIndex := deviceIniIndex; - break; - end; - end; - - //If not in List -> Add - if newDevice then - begin - // resize list - SetLength(Ini.InputDeviceConfig, Length(Ini.InputDeviceConfig)+1); - deviceCfg := @Ini.InputDeviceConfig[High(Ini.InputDeviceConfig)]; - device := DeviceList[deviceIndex]; - - // associate ini-index with device - device.CfgIndex := High(Ini.InputDeviceConfig); - - deviceCfg.Name := Trim(device.Name); - deviceCfg.Input := 0; - - channelCount := device.AudioFormat.Channels; - SetLength(deviceCfg.ChannelToPlayerMap, channelCount); - - for channelIndex := 0 to channelCount-1 do - begin - // set default at first start of USDX (1st device, 1st channel -> player1) - if ((channelIndex = 0) and (device.CfgIndex = 0)) then - deviceCfg.ChannelToPlayerMap[0] := 1 - else - deviceCfg.ChannelToPlayerMap[channelIndex] := 0; - end; - end; - end; -end; - -{* - * Handles captured microphone input data. - * Params: - * Buffer - buffer of signed 16bit interleaved stereo PCM-samples. - * Interleaved means that a right-channel sample follows a left- - * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...). - * Length - number of bytes in Buffer - * Input - Soundcard-Input used for capture - *} -procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PChar; Size: Cardinal; InputDevice: TAudioInputDevice); -var - MultiChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel) - SingleChannelBuffer: PChar; // temporary buffer for new samples per channel - SingleChannelBufferSize: integer; - ChannelIndex: integer; - CaptureChannel: TCaptureBuffer; - AudioFormat: TAudioFormatInfo; - SampleSize: integer; - SampleCount: integer; - SamplesPerChannel: integer; - i: integer; -begin - AudioFormat := InputDevice.AudioFormat; - SampleSize := AudioSampleSize[AudioFormat.Format]; - SampleCount := Size div SampleSize; - SamplesPerChannel := Size div AudioFormat.FrameSize; - - SingleChannelBufferSize := SamplesPerChannel * SampleSize; - GetMem(SingleChannelBuffer, SingleChannelBufferSize); - - // process channels - for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do - begin - CaptureChannel := InputDevice.CaptureChannel[ChannelIndex]; - // check if a capture buffer was assigned, otherwise there is nothing to do - if (CaptureChannel <> nil) then - begin - // set offset according to channel index - MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize]; - // seperate channel-data from interleaved multi-channel (e.g. stereo) data - for i := 0 to SamplesPerChannel-1 do - begin - Move(MultiChannelBuffer[i*AudioFormat.FrameSize], - SingleChannelBuffer[i*SampleSize], - SampleSize); - end; - CaptureChannel.ProcessNewBuffer(SingleChannelBuffer, SingleChannelBufferSize); - end; - end; - - FreeMem(SingleChannelBuffer); -end; - - -{ TAudioInputBase } - -function TAudioInputBase.FinalizeRecord: boolean; -var - i: integer; -begin - for i := 0 to High(AudioInputProcessor.DeviceList) do - AudioInputProcessor.DeviceList[i].Free(); - AudioInputProcessor.DeviceList := nil; - Result := true; -end; - -{* - * Start capturing on all used input-device. - *} -procedure TAudioInputBase.CaptureStart; -var - S: integer; - DeviceIndex: integer; - ChannelIndex: integer; - Device: TAudioInputDevice; - DeviceCfg: PInputDeviceConfig; - DeviceUsed: boolean; - Player: integer; -begin - if (Started) then - CaptureStop(); - - // reset buffers - for S := 0 to High(AudioInputProcessor.Sound) do - AudioInputProcessor.Sound[S].Clear; - - // start capturing on each used device - for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do - begin - Device := AudioInputProcessor.DeviceList[DeviceIndex]; - if not assigned(Device) then - continue; - DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex]; - - DeviceUsed := false; - - // check if device is used - for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do - begin - Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1; - if (Player < 0) or (Player >= PlayersPlay) then - begin - Device.LinkCaptureBuffer(ChannelIndex, nil); - end - else - begin - Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]); - DeviceUsed := true; - end; - end; - - // start device if used - if (DeviceUsed) then - begin - //Log.BenchmarkStart(2); - Device.Start(); - //Log.BenchmarkEnd(2); - //Log.LogBenchmark('Device.Start', 2) ; - end; - end; - - Started := true; -end; - -{* - * Stop input-capturing on all soundcards. - *} -procedure TAudioInputBase.CaptureStop; -var - DeviceIndex: integer; - ChannelIndex: integer; - Device: TAudioInputDevice; - DeviceCfg: PInputDeviceConfig; -begin - for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do - begin - Device := AudioInputProcessor.DeviceList[DeviceIndex]; - if not assigned(Device) then - continue; - - Device.Stop(); - - // disconnect capture buffers - DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex]; - for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do - Device.LinkCaptureBuffer(ChannelIndex, nil); - end; - - Started := false; -end; - -function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string; -var - count: integer; // count of devices with this name - - function IsDuplicate(const name: string): boolean; - var - i: integer; - begin - Result := False; - // search devices with same description - For i := 0 to deviceIndex-1 do - begin - if (AudioInputProcessor.DeviceList[i].Name = name) then - begin - Result := True; - Break; - end; - end; - end; -begin - count := 1; - result := name; - - // if there is another device with the same ID, search for an available name - while (IsDuplicate(result)) do - begin - Inc(count); - // set description - result := name + ' ('+IntToStr(count)+')'; - end; -end; - -end. - - - diff --git a/src/Classes/URingBuffer.pas b/src/Classes/URingBuffer.pas deleted file mode 100644 index ce51e209..00000000 --- a/src/Classes/URingBuffer.pas +++ /dev/null @@ -1,128 +0,0 @@ -unit URingBuffer; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils; - -type - TRingBuffer = class - private - RingBuffer: PChar; - BufferCount: integer; - BufferSize: integer; - WritePos: integer; - ReadPos: integer; - public - constructor Create(Size: integer); - destructor Destroy; override; - function Read(Buffer: PChar; Count: integer): integer; - function Write(Buffer: PChar; Count: integer): integer; - procedure Flush(); - end; - -implementation - -uses - Math; - -constructor TRingBuffer.Create(Size: integer); -begin - BufferSize := Size; - - GetMem(RingBuffer, Size); - if (RingBuffer = nil) then - raise Exception.Create('No memory'); -end; - -destructor TRingBuffer.Destroy; -begin - FreeMem(RingBuffer); -end; - -function TRingBuffer.Read(Buffer: PChar; Count: integer): integer; -var - PartCount: integer; -begin - // adjust output count - if (Count > BufferCount) then - begin - //DebugWriteln('Read too much: ' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize)); - Count := BufferCount; - end; - - // check if there is something to do - if (Count <= 0) then - begin - Result := Count; - Exit; - end; - - // copy data to output buffer - - // first step: copy from the area between the read-position and the end of the buffer - PartCount := Min(Count, BufferSize - ReadPos); - Move(RingBuffer[ReadPos], Buffer[0], PartCount); - - // second step: if we need more data, copy from the beginning of the buffer - if (PartCount < Count) then - Move(RingBuffer[0], Buffer[0], Count-PartCount); - - // mark the copied part of the buffer as free - BufferCount := BufferCount - Count; - ReadPos := (ReadPos + Count) mod BufferSize; - - Result := Count; -end; - -function TRingBuffer.Write(Buffer: PChar; Count: integer): integer; -var - PartCount: integer; -begin - // check for a reasonable request - if (Count <= 0) then - begin - Result := Count; - Exit; - end; - - // skip input data if the input buffer is bigger than the ring-buffer - if (Count > BufferSize) then - begin - //DebugWriteln('Write skip data:' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize)); - Buffer := @Buffer[Count - BufferSize]; - Count := BufferSize; - end; - - // first step: copy to the area between the write-position and the end of the buffer - PartCount := Min(Count, BufferSize - WritePos); - Move(Buffer[0], RingBuffer[WritePos], PartCount); - - // second step: copy data to front of buffer - if (PartCount < Count) then - Move(Buffer[PartCount], RingBuffer[0], Count-PartCount); - - // update info - BufferCount := Min(BufferCount + Count, BufferSize); - WritePos := (WritePos + Count) mod BufferSize; - // if the buffer is full, we have to reposition the read-position - if (BufferCount = BufferSize) then - ReadPos := WritePos; - - Result := Count; -end; - -procedure TRingBuffer.Flush(); -begin - ReadPos := 0; - WritePos := 0; - BufferCount := 0; -end; - -end. \ No newline at end of file diff --git a/src/Classes/UServices.pas b/src/Classes/UServices.pas deleted file mode 100644 index 6325444c..00000000 --- a/src/Classes/UServices.pas +++ /dev/null @@ -1,358 +0,0 @@ -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: TwParam; lParam: TlParam): integer; - - Function NametoHash(const ServiceName: TServiceName): Integer; - Function ServiceExists(const ServiceName: PChar): Integer; - end; - -var - ServiceManager: TServiceManager; - -implementation -uses - ULog, - UCore; - -//------------ -// Create - Creates Class and Set Standard Values -//------------ -Constructor TServiceManager.Create; -begin - inherited; - - FirstService := nil; - LastService := nil; - - ServiceCache[0] := nil; - ServiceCache[1] := nil; - ServiceCache[2] := nil; - ServiceCache[3] := nil; - - NextCacheItem := 0; - - NextHandle := 1; - - {$IFDEF DEBUG} - debugWriteln('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} - debugWriteln('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); - {$ENDIF} - - //Inc Next Handle - Inc(NextHandle); - end - {$IFDEF DEBUG} - else debugWriteln('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} - debugWriteln('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: TwParam; lParam: TlParam): 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} - debugWriteln('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); - {$ENDIF} -end; - -//------------ -// Generates the Hash for the given Name -//------------ -Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; -// FIXME: check if the non-asm version is fast enough and use it by default if so -{$IF Defined(CPUX86_64)} -{$IFDEF FPC} - {$ASMMODE Intel} -{$ENDIF} -asm - { CL: Counter; RAX: Result; RDX: Current Memory Address } - Mov RCX, 14 - Mov RDX, ServiceName {Save Address of String that should be "Hashed"} - Mov RAX, [RDX] - @FoldLoop: ADD RDX, 4 {jump 4 Byte(32 Bit) to the next tile } - ADD RAX, [RDX] {Add the Value of the next 4 Byte of the String to the Hash} - LOOP @FoldLoop {Fold again if there are Chars Left} -end; -{$ELSEIF Defined(CPU386) or Defined(CPUI386)} -{$IFDEF FPC} - {$ASMMODE Intel} -{$ENDIF} -asm - { CL: Counter; EAX: Result; EDX: Current Memory Address } - Mov ECX, 14 {Init Counter, Fold 14 Times to get 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; -{$ELSE} -var - i: integer; - ptr: ^integer; -begin - ptr := @ServiceName; - Result := 0; - for i := 1 to 14 do - begin - Result := Result + ptr^; - Inc(ptr); - end; -end; -{$IFEND} - - -//------------ -// 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} - debugWriteln('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} - debugWriteln('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/src/Classes/USingNotes.pas b/src/Classes/USingNotes.pas deleted file mode 100644 index 3b268d10..00000000 --- a/src/Classes/USingNotes.pas +++ /dev/null @@ -1,13 +0,0 @@ -unit USingNotes; - -interface - -{$I switches.inc} - -{ Dummy Unit atm - For further expantation - Placeholder for Class that will handle the Notes Drawing} - -implementation - -end. diff --git a/src/Classes/USingScores.pas b/src/Classes/USingScores.pas deleted file mode 100644 index 77d40b84..00000000 --- a/src/Classes/USingScores.pas +++ /dev/null @@ -1,973 +0,0 @@ -unit USingScores; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses UThemes, - gl, - 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 constants 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 - inherited; - - //Clear PopupList Pointers - FirstPopUp := nil; - LastPopUp := nil; - - //Clear Variables - Visible := True; - Enabled := True; - RBVisible := True; - - //Clear Position Index - oPositionCount := 0; - oPlayerCount := 0; - - Settings.Phase1Time := 350; // plop it up . -> [ ] - Settings.Phase2Time := 550; // shift it up ^[ ]^ - Settings.Phase3Time := 200; // increase score [s++] - - Settings.PopUpTex[0].TexNum := 0; - Settings.PopUpTex[1].TexNum := 0; - Settings.PopUpTex[2].TexNum := 0; - Settings.PopUpTex[3].TexNum := 0; - Settings.PopUpTex[4].TexNum := 0; - Settings.PopUpTex[5].TexNum := 0; - Settings.PopUpTex[6].TexNum := 0; - Settings.PopUpTex[7].TexNum := 0; - Settings.PopUpTex[8].TexNum := 0; - - Settings.RatingBar_BG_Tex.TexNum := 0; - Settings.RatingBar_FG_Tex.TexNum := 0; - Settings.RatingBar_Bar_Tex.TexNum := 0; -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 - lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); - lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); - - 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 - MaxPlayersPerScreen := 0; - - 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/src/Classes/USkins.pas b/src/Classes/USkins.pas deleted file mode 100644 index 88549c9f..00000000 --- a/src/Classes/USkins.pas +++ /dev/null @@ -1,185 +0,0 @@ -unit USkins; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -type - TSkinTexture = record - Name: string; - FileName: string; - end; - - TSkinEntry = record - Theme: string; - Name: string; - Path: string; - FileName: string; - Creator: string; // not used yet - end; - - TSkin = class - Skin: array of TSkinEntry; - SkinTexture: array of TSkinTexture; - SkinPath: string; - Color: integer; - constructor Create; - procedure LoadList; - procedure ParseDir(Dir: string); - procedure LoadHeader(FileName: string); - procedure LoadSkin(Name: string); - function GetTextureFileName(TextureName: string): string; - function GetSkinNumber(Name: string): integer; - procedure onThemeChange; - end; - -var - Skin: TSkin; - -implementation - -uses IniFiles, - Classes, - SysUtils, - UMain, - ULog, - UIni; - -constructor TSkin.Create; -begin - inherited; - LoadList; -// LoadSkin('Lisek'); -// SkinColor := Color; -end; - -procedure TSkin.LoadList; -var - SR: TSearchRec; -begin - if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - ParseDir(SkinsPath + SR.Name + PathDelim); - until FindNext(SR) <> 0; - end; // if - FindClose(SR); -end; - -procedure TSkin.ParseDir(Dir: string); -var - SR: TSearchRec; -begin - if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin - repeat - - if (SR.Name <> '.') and (SR.Name <> '..') then - LoadHeader(Dir + SR.Name); - - until FindNext(SR) <> 0; - end; -end; - -procedure TSkin.LoadHeader(FileName: string); -var - SkinIni: TMemIniFile; - S: integer; -begin - SkinIni := TMemIniFile.Create(FileName); - - S := Length(Skin); - SetLength(Skin, S+1); - - Skin[S].Path := IncludeTrailingPathDelimiter(ExtractFileDir(FileName)); - Skin[S].FileName := ExtractFileName(FileName); - Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); - Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); - Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); - - SkinIni.Free; -end; - -procedure TSkin.LoadSkin(Name: string); -var - SkinIni: TMemIniFile; - SL: TStringList; - T: integer; - S: integer; -begin - S := GetSkinNumber(Name); - SkinPath := Skin[S].Path; - - SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); - - SL := TStringList.Create; - SkinIni.ReadSection('Textures', SL); - - SetLength(SkinTexture, SL.Count); - for T := 0 to SL.Count-1 do - begin - SkinTexture[T].Name := SL.Strings[T]; - SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); - end; - - SL.Free; - SkinIni.Free; -end; - -function TSkin.GetTextureFileName(TextureName: string): string; -var - T: integer; -begin - Result := ''; - - for T := 0 to High(SkinTexture) do - begin - if ( SkinTexture[T].Name = TextureName ) AND - ( SkinTexture[T].FileName <> '' ) then - begin - Result := SkinPath + SkinTexture[T].FileName; - end; - end; - - if ( TextureName <> '' ) AND - ( Result <> '' ) THEN - begin - //Log.LogError('', '-----------------------------------------'); - //Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName'); - end; - -{ Result := SkinPath + 'Bar.jpg'; - if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} -end; - -function TSkin.GetSkinNumber(Name: string): integer; -var - S: integer; -begin - Result := 0; // set default to the first available skin - for S := 0 to High(Skin) do - if Skin[S].Name = Name then Result := S; -end; - -procedure TSkin.onThemeChange; -var - S: integer; - Name: String; -begin - Ini.SkinNo:=0; - SetLength(ISkin, 0); - Name := Uppercase(ITheme[Ini.Theme]); - for S := 0 to High(Skin) do - if Name = Uppercase(Skin[S].Theme) then begin - SetLength(ISkin, Length(ISkin)+1); - ISkin[High(ISkin)] := Skin[S].Name; - end; - -end; - -end. diff --git a/src/Classes/USong.pas b/src/Classes/USong.pas deleted file mode 100644 index 3517bce6..00000000 --- a/src/Classes/USong.pas +++ /dev/null @@ -1,1027 +0,0 @@ -unit USong; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - {$IFDEF MSWINDOWS} - Windows, - {$ELSE} - {$IFNDEF DARWIN} - syscall, - {$ENDIF} - baseunix, - UnixType, - {$ENDIF} - SysUtils, - Classes, - UPlatform, - ULog, - UTexture, - UCommon, - {$IFDEF DARWIN} - cthreads, - {$ENDIF} - {$IFDEF USE_PSEUDO_THREAD} - PseudoThread, - {$ENDIF} - UCatCovers, - UXMLSong; - -type - - TSingMode = ( smNormal, smPartyMode, smPlaylistRandom ); - - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: WideString; - Score: integer; - Length: string; - end; - - TSong = class - FileLineNo : integer; //Line which is readed at Last, for error reporting - - procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); - procedure NewSentence(LineNumberP: integer; Param1, Param2: integer); - - function ReadTXTHeader( const aFileName : WideString ): boolean; - function ReadXMLHeader( const aFileName : WideString ): boolean; - public - Path: WideString; - Folder: WideString; // for sorting by folder - fFileName, - FileName: WideString; - - // sorting methods - Category: array of WideString; // TODO: do we need this? - Genre: WideString; - Edition: WideString; - Language: WideString; - - Title: WideString; - Artist: WideString; - - Text: WideString; - Creator: WideString; - - Cover: WideString; - CoverTex: TTexture; - Mp3: WideString; - Background: WideString; - Video: WideString; - VideoGAP: real; - VideoLoaded: boolean; // true if the video has been loaded - NotesGAP: integer; - Start: real; // in seconds - Finish: integer; // in miliseconds - Relative: boolean; - Resolution: integer; - BPM: array of TBPM; - GAP: real; // in miliseconds - - Score: array[0..2] of array of TScore; - - // these are used when sorting is enabled - Visible: boolean; // false if hidden, true if visible - Main: boolean; // false for songs, true for category buttons - OrderNum: integer; // has a number of category for category buttons and songs - OrderTyp: integer; // type of sorting for this button (0=name) - CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs - - SongFile: TextFile; // all procedures in this unit operate on this file - - Base : array[0..1] of integer; - Rel : array[0..1] of integer; - Mult : integer; - MultBPM : integer; - - constructor Create (); overload; - constructor Create ( const aFileName : WideString ); overload; - function LoadSong: boolean; - function LoadXMLSong: boolean; - function Analyse(): boolean; - function AnalyseXML(): boolean; - procedure Clear(); - end; - -implementation - -uses - TextGL, - UIni, - UMusic, //needed for Lines - UMain; //needed for Player - -constructor TSong.Create(); -begin - inherited; -end; - -constructor TSong.Create( const aFileName : WideString ); -begin - inherited Create(); - - Mult := 1; - MultBPM := 4; - fFileName := aFileName; - - if fileexists( aFileName ) then - begin - self.Path := ExtractFilePath( aFileName ); - self.Folder := ExtractFilePath( aFileName ); - self.FileName := ExtractFileName( aFileName ); - (* - if ReadTXTHeader( aFileName ) then - begin - LoadSong(); - end - else - begin - Log.LogError('Error Loading SongHeader, abort Song Loading'); - Exit; - end; - *) - end; -end; - -//Load TXT Song -function TSong.LoadSong(): boolean; - -var - TempC: char; - Text: string; - CP: integer; // Current Player (0 or 1) - Count: integer; - Both: boolean; - Param1: integer; - Param2: integer; - Param3: integer; - ParamS: string; - I: integer; -begin - Result := false; - - if not FileExists(Path + PathDelim + FileName) then - begin - Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()'); - exit; - end; - - MultBPM := 4; // multiply beat-count of note by 4 - Mult := 1; // accuracy of measurement of note - Base[0] := 100; // high number - Lines[0].ScoreValue := 0; - self.Relative := false; - Rel[0] := 0; - CP := 0; - Both := false; - - if Length(Player) = 2 then - Both := true; - - try - // Open song file for reading..... - FileMode := fmOpenRead; - AssignFile(SongFile, fFileName); - Reset(SongFile); - - //Clear old Song Header - if (self.Path = '') then - self.Path := ExtractFilePath(FileName); - - if (self.FileName = '') then - self.Filename := ExtractFileName(FileName); - - Result := False; - - Reset(SongFile); - FileLineNo := 0; - //Search for Note Begining - repeat - ReadLn(SongFile, Text); - Inc(FileLineNo); - - if (EoF(SongFile)) then - begin //Song File Corrupted - No Notes - CloseFile(SongFile); - Log.LogError('Could not load txt File, no Notes found: ' + FileName); - Result := False; - Exit; - end; - Read(SongFile, TempC); - until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); - - SetLength(Lines, 2); - for Count := 0 to High(Lines) do - begin - SetLength(Lines[Count].Line, 1); - Lines[Count].High := 0; - Lines[Count].Number := 1; - Lines[Count].Current := 0; - Lines[Count].Resolution := self.Resolution; - Lines[Count].NotesGAP := self.NotesGAP; - Lines[Count].Line[0].HighNote := -1; - Lines[Count].Line[0].LastLine := False; - end; - - // TempC := ':'; - // TempC := Text[1]; // read from backup variable, don't use default ':' value - - while (TempC <> 'E') AND (not EOF(SongFile)) do - begin - - if (TempC = ':') or (TempC = '*') or (TempC = 'F') then - begin - // read notes - Read(SongFile, Param1); - Read(SongFile, Param2); - Read(SongFile, Param3); - Read(SongFile, ParamS); - - - //Check for ZeroNote - if Param2 = 0 then Log.LogError('Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamS+'" -> Note ignored!') else - begin - // add notes - if not Both then - // P1 - ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) - else begin - // P1 + P2 - ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); - ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); - end; - end; //Zeronote check - end; // if - - if TempC = '-' then - begin - // reads sentence - Read(SongFile, Param1); - if self.Relative then Read(SongFile, Param2); // read one more data for relative system - - // new sentence - if not Both then - // P1 - NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) - else begin - // P1 + P2 - NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); - NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); - end; - end; // if - - if TempC = 'B' then - begin - SetLength(self.BPM, Length(self.BPM) + 1); - Read(SongFile, self.BPM[High(self.BPM)].StartBeat); - self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0]; - - Read(SongFile, Text); - self.BPM[High(self.BPM)].BPM := StrToFloat(Text); - self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM; - end; - - - if not Both then - begin - Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP]; - Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric)); - //Total Notes Patch - Lines[CP].Line[Lines[CP].High].TotalNotes := 0; - for I := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do - begin - if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; - - if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; - end; - //Total Notes Patch End - end else begin - for Count := 0 to High(Lines) do - begin - Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count]; - Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric)); - //Total Notes Patch - Lines[Count].Line[Lines[Count].High].TotalNotes := 0; - for I := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do - begin - if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length; - if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length; - end; - //Total Notes Patch End - end; - end; - Read(SongFile, TempC); - Inc(FileLineNo); - end; // while} - - for Count := 0 to High(Lines) do - begin - Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; - end; - - CloseFile(SongFile); - except - try - CloseFile(SongFile); - except - - end; - - Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo)); - exit; - end; - - Result := true; -end; - -//Load XML Song -function TSong.LoadXMLSong(): boolean; -var - //TempC: char; - Text: string; - CP: integer; // Current Player (0 or 1) - Count: integer; - Both: boolean; - Param1: integer; - Param2: integer; - Param3: integer; - ParamS: string; - I,J,X: integer; - - NoteType: Char; - SentenceEnd, Rest, Time: Integer; - Parser: TParser; -begin - Result := false; - - if not FileExists(Path + PathDelim + FileName) then - begin - Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()'); - exit; - end; - - MultBPM := 4; // multiply beat-count of note by 4 - Mult := 1; // accuracy of measurement of note - Base[0] := 100; // high number - Lines[0].ScoreValue := 0; - self.Relative := false; - Rel[0] := 0; - CP := 0; - Both := false; - - if Length(Player) = 2 then - Both := true; - - Parser := TParser.Create; - Parser.Settings.DashReplacement := '~'; - - for Count := 0 to High(Lines) do - begin - SetLength(Lines[Count].Line, 1); - Lines[Count].High := 0; - Lines[Count].Number := 1; - Lines[Count].Current := 0; - Lines[Count].Resolution := self.Resolution; - Lines[Count].NotesGAP := self.NotesGAP; - Lines[Count].Line[0].HighNote := -1; - Lines[Count].Line[0].LastLine := False; - end; - -//Try to Parse the Song - - if Parser.ParseSong(Path + PathDelim + FileName) then - begin -// Writeln('XML Inputfile Parsed succesful'); - //Start write parsed information to Song - //Notes Part - for I := 0 to High(Parser.SongInfo.Sentences) do - begin - //Add Notes - for J := 0 to High(Parser.SongInfo.Sentences[I].Notes) do - begin - case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of - NT_Normal: NoteType := ':'; - NT_Golden: NoteType := '*'; - NT_Freestyle: NoteType := 'F'; - end; - - Param1:=Parser.SongInfo.Sentences[I].Notes[J].Start; //Note Start - Param2:=Parser.SongInfo.Sentences[I].Notes[J].Duration; //Note Duration - Param3:=Parser.SongInfo.Sentences[I].Notes[J].Tone; //Note Tone - ParamS:=' ' + Parser.SongInfo.Sentences[I].Notes[J].Lyric; //Note Lyric - - if not Both then - // P1 - ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) - else - begin - // P1 + P2 - ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); - ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); - end; - - if not Both then - begin - Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP]; - Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric)); - //Total Notes Patch - Lines[CP].Line[Lines[CP].High].TotalNotes := 0; - for X := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do - begin - if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; - - if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; - end; - //Total Notes Patch End - end - else - begin - for Count := 0 to High(Lines) do - begin - Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count]; - Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric)); - //Total Notes Patch - Lines[Count].Line[Lines[Count].High].TotalNotes := 0; - for X := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do - begin - if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; - if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; - - end; - //Total Notes Patch End - end; - end; { end of for loop } - - end; //J Forloop - - //Add Sentence break - if (I < High(Parser.SongInfo.Sentences)) then - begin - - SentenceEnd := Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Start + Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Duration; - Rest := Parser.SongInfo.Sentences[I+1].Notes[0].Start - SentenceEnd; - - //Calculate Time - case Rest of - 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; - 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1; - 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2; - else - if (Rest >= 4) then - Time := SentenceEnd + 2 - else //Sentence overlapping :/ - Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; - end; - // new sentence - if not Both then - // P1 - NewSentence(0, (Time + Rel[0]) * Mult, Param2) - else - begin - // P1 + P2 - NewSentence(0, (Time + Rel[0]) * Mult, Param2); - NewSentence(1, (Time + Rel[1]) * Mult, Param2); - end; - - end; - end; - //End write parsed information to Song - Parser.Free; - end - else - begin - Log.LogError('Could not parse Inputfile: ' + Path + PathDelim + FileName); - exit; - end; - - for Count := 0 to High(Lines) do - begin - Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; - end; - - Result := true; -end; - -function TSong.ReadXMLHeader(const aFileName : WideString): boolean; -var - Line, Identifier, Value: string; - Temp : word; - Done : byte; - Parser : TParser; -begin - Result := true; - Done := 0; - -//Parse XML - Parser := TParser.Create; - Parser.Settings.DashReplacement := '~'; - - - if Parser.ParseSong(self.Path + self.FileName) then - begin - //----------- - //Required Attributes - //----------- - - //Title - self.Title := Parser.SongInfo.Header.Title; - - //Add Title Flag to Done - Done := Done or 1; - - //Artist - self.Artist := Parser.SongInfo.Header.Artist; - - //Add Artist Flag to Done - Done := Done or 2; - - //MP3 File //Test if Exists - self.Mp3 := platform.FindSongFile(Path, '*.mp3'); - if (FileExists(self.Path + self.Mp3)) then - //Add Mp3 Flag to Done - Done := Done or 4; - - //Beats per Minute - SetLength(self.BPM, 1); - self.BPM[0].StartBeat := 0; - - self.BPM[0].BPM := (Parser.SongInfo.Header.BPM * Parser.SongInfo.Header.Resolution/4 ) * Mult * MultBPM; - - if self.BPM[0].BPM <> 0 then - //Add BPM Flag to Done - Done := Done or 8; - - //--------- - //Additional Header Information - //--------- - - // Gap - self.GAP := Parser.SongInfo.Header.Gap; - - //Cover Picture - self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); - - //Background Picture - self.Background := platform.FindSongFile(Path, '*[BG].jpg'); - - // Video File - // self.Video := Value - - // Video Gap - // self.VideoGAP := song_StrtoFloat( Value ) - - //Genre Sorting - self.Genre := Parser.SongInfo.Header.Genre; - - //Edition Sorting - self.Edition := Parser.SongInfo.Header.Edition; - - //Year Sorting - //Parser.SongInfo.Header.Year - - //Language Sorting - self.Language := Parser.SongInfo.Header.Language; - end else - Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName); - - Parser.Free; - - //Check if all Required Values are given - if (Done <> 15) then - begin - Result := False; - if (Done and 8) = 0 then //No BPM Flag - Log.LogError('BPM Tag Missing: ' + self.FileName) - else if (Done and 4) = 0 then //No MP3 Flag - Log.LogError('MP3 Tag/File Missing: ' + self.FileName) - else if (Done and 2) = 0 then //No Artist Flag - Log.LogError('Artist Tag Missing: ' + self.FileName) - else if (Done and 1) = 0 then //No Title Flag - Log.LogError('Title Tag Missing: ' + self.FileName) - else //unknown Error - Log.LogError('File Incomplete or not SingStar XML (B - '+ inttostr(Done) +'): ' + aFileName); - end; - -end; - - -function TSong.ReadTXTHeader(const aFileName : WideString): boolean; - - function song_StrtoFloat( aValue : string ) : Extended; - var - lValue : string; -// lOldDecimalSeparator : Char; // Auto Removed, Unused Variable - begin - lValue := aValue; - - if (Pos(',', lValue) <> 0) then - lValue[Pos(',', lValue)] := '.'; - - Result := StrToFloatDef(lValue, 0); - end; - -var - Line, Identifier, Value: string; - Temp : word; - Done : byte; -begin - Result := true; - Done := 0; - - //Read first Line - ReadLn (SongFile, Line); - - if (Length(Line)<=0) then - begin - Log.LogError('File Starts with Empty Line: ' + aFileName); - Result := False; - Exit; - end; - - //Read Lines while Line starts with # or its empty - while ( Length(Line) = 0 ) or - ( Line[1] = '#' ) do - begin - //Increase Line Number - Inc (FileLineNo); - Temp := Pos(':', Line); - - //Line has a Seperator-> Headerline - if (Temp <> 0) then - begin - //Read Identifier and Value - Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks - Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); - - //Check the Identifier (If Value is given) - if (Length(Value) <> 0) then - begin - - //----------- - //Required Attributes - //----------- - - {$IFDEF UTF8_FILENAMES} - if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then - Value := Utf8Encode(Value); - {$ENDIF} - - //Title - if (Identifier = 'TITLE') then - begin - self.Title := Value; - - //Add Title Flag to Done - Done := Done or 1; - end - - //Artist - else if (Identifier = 'ARTIST') then - begin - self.Artist := Value; - - //Add Artist Flag to Done - Done := Done or 2; - end - - //MP3 File //Test if Exists - else if (Identifier = 'MP3') AND - (FileExists(self.Path + Value)) then - begin - self.Mp3 := Value; - - //Add Mp3 Flag to Done - Done := Done or 4; - end - - //Beats per Minute - else if (Identifier = 'BPM') then - begin - SetLength(self.BPM, 1); - self.BPM[0].StartBeat := 0; - - self.BPM[0].BPM := song_StrtoFloat( Value ) * Mult * MultBPM; - - if self.BPM[0].BPM <> 0 then - begin - //Add BPM Flag to Done - Done := Done or 8; - end; - end - - //--------- - //Additional Header Information - //--------- - - // Gap - else if (Identifier = 'GAP') then - self.GAP := song_StrtoFloat( Value ) - - //Cover Picture - else if (Identifier = 'COVER') then - self.Cover := Value - - //Background Picture - else if (Identifier = 'BACKGROUND') then - self.Background := Value - - // Video File - else if (Identifier = 'VIDEO') then - begin - if (FileExists(self.Path + Value)) then - self.Video := Value - else - Log.LogError('Can''t find Video File in Song: ' + aFileName); - end - - // Video Gap - else if (Identifier = 'VIDEOGAP') then - self.VideoGAP := song_StrtoFloat( Value ) - - //Genre Sorting - else if (Identifier = 'GENRE') then - self.Genre := Value - - //Edition Sorting - else if (Identifier = 'EDITION') then - self.Edition := Value - - //Creator Tag - else if (Identifier = 'CREATOR') then - self.Creator := Value - - //Language Sorting - else if (Identifier = 'LANGUAGE') then - self.Language := Value - - // Song Start - else if (Identifier = 'START') then - self.Start := song_StrtoFloat( Value ) - - // Song Ending - else if (Identifier = 'END') then - TryStrtoInt(Value, self.Finish) - - // Resolution - else if (Identifier = 'RESOLUTION') then - TryStrtoInt(Value, self.Resolution) - - // Notes Gap - else if (Identifier = 'NOTESGAP') then - TryStrtoInt(Value, self.NotesGAP) - // Relative Notes - else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then - self.Relative := True; - - end; - end; - - if not EOf(SongFile) then - ReadLn (SongFile, Line) - else - begin - Result := False; - Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName); - break; - end; - - end; - - if self.Cover = '' then - self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); - - //Check if all Required Values are given - if (Done <> 15) then - begin - Result := False; - if (Done and 8) = 0 then //No BPM Flag - Log.LogError('BPM Tag Missing: ' + self.FileName) - else if (Done and 4) = 0 then //No MP3 Flag - Log.LogError('MP3 Tag/File Missing: ' + self.FileName) - else if (Done and 2) = 0 then //No Artist Flag - Log.LogError('Artist Tag Missing: ' + self.FileName) - else if (Done and 1) = 0 then //No Title Flag - Log.LogError('Title Tag Missing: ' + self.FileName) - else //unknown Error - Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName); - end; - -end; - -procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); -//var -// Space: boolean; // Auto Removed, Unused Variable -begin - case Ini.Solmization of - 1: // european - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' sol '; - 9..10: LyricS := ' la '; - 11: LyricS := ' si '; - end; - end; - 2: // japanese - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' so '; - 9..10: LyricS := ' la '; - 11: LyricS := ' shi '; - end; - end; - 3: // american - begin - case (NoteP mod 12) of - 0..1: LyricS := ' do '; - 2..3: LyricS := ' re '; - 4: LyricS := ' mi '; - 5..6: LyricS := ' fa '; - 7..8: LyricS := ' sol '; - 9..10: LyricS := ' la '; - 11: LyricS := ' ti '; - end; - end; - end; // case - - with Lines[LineNumber].Line[Lines[LineNumber].High] do - begin - SetLength(Note, Length(Note) + 1); - HighNote := High(Note); - - Note[HighNote].Start := StartP; - if HighNote = 0 then - begin - if Lines[LineNumber].Number = 1 then - Start := -100; -// Start := Note[HighNote].Start; - end; - - Note[HighNote].Length := DurationP; - - // back to the normal system with normal, golden and now freestyle notes - case TypeP of - 'F': Note[HighNote].NoteType := ntFreestyle; - ':': Note[HighNote].NoteType := ntNormal; - '*': Note[HighNote].NoteType := ntGolden; - end; - - if (Note[HighNote].NoteType = ntGolden) then - Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; - - if (Note[HighNote].NoteType <> ntFreestyle) then - Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; - - Note[HighNote].Tone := NoteP; - if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone; - - Note[HighNote].Text := Copy(LyricS, 2, 100); - Lyric := Lyric + Note[HighNote].Text; - - End_ := Note[HighNote].Start + Note[HighNote].Length; - end; // with -end; - -procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer); -var - I: integer; -begin - - // stara czesc //Alter Satz //Update Old Part - Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP]; - Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(PChar(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric)); - - //Total Notes Patch - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0; - for I := low(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) to high(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) do - begin - if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType = ntGolden) then - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; - - if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType <> ntFreestyle) then - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; - end; - //Total Notes Patch End - - - // nowa czesc //Neuer Satz //Update New Part - SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1); - Lines[LineNumberP].High := Lines[LineNumberP].High + 1; - Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1; - Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1; - - if self.Relative then - begin - Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; - Rel[LineNumberP] := Rel[LineNumberP] + Param2; - end - else - Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; - - Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := False; - - Base[LineNumberP] := 100; // high number -end; - -procedure TSong.clear(); -begin - //Main Information - Title := ''; - Artist := ''; - - //Sortings: - Genre := 'Unknown'; - Edition := 'Unknown'; - Language := 'Unknown'; //Language Patch - - //Required Information - Mp3 := ''; - {$IFDEF FPC} - setlength( BPM, 0 ); - {$ELSE} - BPM := nil; - {$ENDIF} - - GAP := 0; - Start := 0; - Finish := 0; - - //Additional Information - Background := ''; - Cover := ''; - Video := ''; - VideoGAP := 0; - NotesGAP := 0; - Resolution := 4; - Creator := ''; - -end; - -function TSong.Analyse(): boolean; -begin - Result := False; - - //Reset LineNo - FileLineNo := 0; - - //Open File and set File Pointer to the beginning - AssignFile(SongFile, self.Path + self.FileName); - - try - Reset(SongFile); - - //Clear old Song Header - self.clear; - - //Read Header - Result := self.ReadTxTHeader( FileName ) - - //And Close File - finally - CloseFile(SongFile); - end; -end; - - -function TSong.AnalyseXML(): boolean; -begin - Result := False; - - //Reset LineNo - FileLineNo := 0; - - //Clear old Song Header - self.clear; - - //Read Header - Result := self.ReadXMLHeader( FileName ); - -end; - -end. diff --git a/src/Classes/USongs.pas b/src/Classes/USongs.pas deleted file mode 100644 index 710cd44f..00000000 --- a/src/Classes/USongs.pas +++ /dev/null @@ -1,806 +0,0 @@ -unit USongs; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -{$IFDEF DARWIN} - {$IFDEF DEBUG} - {$DEFINE USE_PSEUDO_THREAD} - {$ENDIF} -{$ENDIF} - -uses - {$IFDEF MSWINDOWS} - Windows, - DirWatch, - {$ELSE} - {$IFNDEF DARWIN} - syscall, - {$ENDIF} - baseunix, - UnixType, - {$ENDIF} - SysUtils, - Classes, - UPlatform, - ULog, - UTexture, - UCommon, - {$IFDEF DARWIN} - cthreads, - {$ENDIF} - {$IFDEF USE_PSEUDO_THREAD} - PseudoThread, - {$ENDIF} - USong, - UCatCovers; - -type - - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: widestring; - Score: integer; - Length: string; - end; - - {$IFDEF USE_PSEUDO_THREAD} - TSongs = class( TPseudoThread ) - {$ELSE} - TSongs = class( TThread ) - {$ENDIF} - private - fNotify, fWatch : longint; - fParseSongDirectory : boolean; - fProcessing : boolean; - {$ifdef MSWINDOWS} - fDirWatch : TDirectoryWatch; - {$endif} - procedure int_LoadSongList; - procedure DoDirChanged(Sender: TObject); - protected - procedure Execute; override; - public - SongList : TList; // array of songs - Selected : integer; // selected song index - constructor Create(); - destructor Destroy(); override; - - - procedure LoadSongList; // load all songs - procedure BrowseDir(Dir: widestring); // should return number of songs in the future - procedure BrowseTXTFiles(Dir: widestring); - procedure BrowseXMLFiles(Dir: widestring); - procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: widestring): widestring; - property Processing : boolean read fProcessing; - end; - - - TCatSongs = class - Song: array of TSong; // array of categories with songs - Selected: integer; // selected song index - Order: integer; // order type (0=title) - CatNumShow: integer; // Category Number being seen - CatCount: integer; //Number of Categorys - - procedure SortSongs(); - procedure Refresh; // refreshes arrays by recreating them from Songs array - procedure ShowCategory(Index: integer); // expands all songs in category - procedure HideCategory(Index: integer); // hides all songs in category - procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed - procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys - function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song - function VisibleSongs: integer; // returns number of visible songs (for tabs) - function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - - function SetFilter(FilterStr: string; const fType: Byte): Cardinal; - end; - -var - Songs: TSongs; // all songs - CatSongs: TCatSongs; // categorized songs - -const - IN_ACCESS = $00000001; //* File was accessed */ - IN_MODIFY = $00000002; //* File was modified */ - IN_ATTRIB = $00000004; //* Metadata changed */ - IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ - IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ - IN_OPEN = $00000020; //* File was opened */ - IN_MOVED_FROM = $00000040; //* File was moved from X */ - IN_MOVED_TO = $00000080; //* File was moved to Y */ - IN_CREATE = $00000100; //* Subfile was created */ - IN_DELETE = $00000200; //* Subfile was deleted */ - IN_DELETE_SELF = $00000400; //* Self was deleted */ - - -implementation - -uses StrUtils, - UGraphic, - UCovers, - UFiles, - UMain, - UIni; - -constructor TSongs.Create(); -begin - // do not start thread BEFORE initialization (suspended = true) - inherited Create(true); - Self.FreeOnTerminate := true; - - SongList := TList.Create(); - - // FIXME: threaded loading does not work this way. - // It will just cause crashes but nothing else at the moment. - (* - {$ifdef MSWINDOWS} - fDirWatch := TDirectoryWatch.create(nil); - fDirWatch.OnChange := DoDirChanged; - fDirWatch.Directory := SongPath; - fDirWatch.WatchSubDirs := true; - fDirWatch.active := true; - {$ENDIF} - - // now we can start the thread - Resume(); - *) - - // until it is fixed, simply load the song-list - int_LoadSongList(); -end; - -destructor TSongs.Destroy(); -begin - FreeAndNil( SongList ); - inherited; -end; - -procedure TSongs.DoDirChanged(Sender: TObject); -begin - LoadSongList(); -end; - -procedure TSongs.Execute(); -var - fChangeNotify : THandle; -begin -{$IFDEF USE_PSEUDO_THREAD} - int_LoadSongList(); -{$ELSE} - fParseSongDirectory := true; - - while not terminated do - begin - - if fParseSongDirectory then - begin - Log.LogStatus('Calling int_LoadSongList', 'TSongs.Execute'); - int_LoadSongList(); - end; - - Suspend(); - end; -{$ENDIF} -end; - -procedure TSongs.int_LoadSongList; -var - I: integer; -begin - try - fProcessing := true; - - Log.LogStatus('Searching For Songs', 'SongList'); - - // browse directories - for I := 0 to SongPaths.Count-1 do - BrowseDir(SongPaths[I]); - - if assigned( CatSongs ) then - CatSongs.Refresh; - - if assigned( CatCovers ) then - CatCovers.Load; - - //if assigned( Covers ) then - // Covers.Load; - - if assigned(ScreenSong) then - begin - ScreenSong.GenerateThumbnails(); - ScreenSong.OnShow; // refresh ScreenSong - end; - - finally - Log.LogStatus('Search Complete', 'SongList'); - - fParseSongDirectory := false; - fProcessing := false; - end; -end; - - -procedure TSongs.LoadSongList; -begin - fParseSongDirectory := true; - Resume(); -end; - -procedure TSongs.BrowseDir(Dir: widestring); -begin - BrowseTXTFiles(Dir); - BrowseXMLFiles(Dir); -end; - -procedure TSongs.BrowseTXTFiles(Dir: widestring); -var - i : integer; - Files : TDirectoryEntryArray; - lSong : TSong; -begin - - Files := Platform.DirectoryFindFiles( Dir, '.txt', true); - - for i := 0 to Length(Files)-1 do - begin - if Files[i].IsDirectory then - begin - BrowseTXTFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call - end - else - begin - lSong := TSong.create( Dir + Files[i].Name ); - - if lSong.Analyse then - SongList.add( lSong ) - else - begin - Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); - freeandnil( lSong ); - end; - - end; - end; - SetLength( Files, 0); - -end; - -procedure TSongs.BrowseXMLFiles(Dir: widestring); -var - i : integer; - Files : TDirectoryEntryArray; - lSong : TSong; -begin - - Files := Platform.DirectoryFindFiles( Dir, '.xml', true); - - for i := 0 to Length(Files)-1 do - begin - if Files[i].IsDirectory then - begin - BrowseXMLFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call - end - else - begin - lSong := TSong.create( Dir + Files[i].Name ); - - if lSong.AnalyseXML then - SongList.add( lSong ) - else - begin - Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); - freeandnil( lSong ); - end; - - end; - end; - SetLength( Files, 0); - -end; - -(* - * Comparison functions for sorting - *) - -function CompareByEdition(Song1, Song2: Pointer): integer; -begin - Result := CompareText(TSong(Song1).Edition, TSong(Song2).Edition); -end; - -function CompareByGenre(Song1, Song2: Pointer): integer; -begin - Result := CompareText(TSong(Song1).Genre, TSong(Song2).Genre); -end; - -function CompareByTitle(Song1, Song2: Pointer): integer; -begin - Result := CompareText(TSong(Song1).Title, TSong(Song2).Title); -end; - -function CompareByArtist(Song1, Song2: Pointer): integer; -begin - Result := CompareText(TSong(Song1).Artist, TSong(Song2).Artist); -end; - -function CompareByFolder(Song1, Song2: Pointer): integer; -begin - Result := CompareText(TSong(Song1).Folder, TSong(Song2).Folder); -end; - -function CompareByLanguage(Song1, Song2: Pointer): integer; -begin - Result := CompareText(TSong(Song1).Language, TSong(Song2).Language); -end; - -procedure TSongs.Sort(Order: integer); -var - CompareFunc: TListSortCompare; -begin - // FIXME: what is the difference between artist and artist2, etc.? - case Order of - sEdition: // by edition - CompareFunc := CompareByEdition; - sGenre: // by genre - CompareFunc := CompareByGenre; - sTitle: // by title - CompareFunc := CompareByTitle; - sArtist: // by artist - CompareFunc := CompareByArtist; - sFolder: // by folder - CompareFunc := CompareByFolder; - sTitle2: // by title2 - CompareFunc := CompareByTitle; - sArtist2: // by artist2 - CompareFunc := CompareByArtist; - sLanguage: // by Language - CompareFunc := CompareByLanguage; - else - Log.LogCritical('Unsupported comparison', 'TSongs.Sort'); - Exit; // suppress warning - end; // case - - // Note: Do not use TList.Sort() as it uses QuickSort which is instable. - // For example, if a list is sorted by title first and - // by artist afterwards, the songs of an artist will not be sorted by title anymore. - // The stable MergeSort guarantees to maintain this order. - MergeSort(SongList, CompareFunc); -end; - -function TSongs.FindSongFile(Dir, Mask: widestring): widestring; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if FindFirst(Dir + Mask, faDirectory, SR) = 0 then - begin - Result := SR.Name; - end; // if - FindClose(SR); -end; - -procedure TCatSongs.SortSongs(); -begin - case Ini.Sorting of - sEdition: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist); - Songs.Sort(sEdition); - end; - sGenre: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist); - Songs.Sort(sGenre); - end; - sLanguage: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist); - Songs.Sort(sLanguage); - end; - sFolder: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist); - Songs.Sort(sFolder); - end; - sTitle: begin - Songs.Sort(sTitle); - end; - sArtist: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist); - end; - sTitle2: begin - Songs.Sort(sArtist2); - Songs.Sort(sTitle2); - end; - sArtist2: begin - Songs.Sort(sTitle2); - Songs.Sort(sArtist2); - end; - end; // case -end; - -procedure TCatSongs.Refresh; -var - SongIndex: integer; - CurSong: TSong; - CatIndex: integer; // index of current song in Song - Letter: char; // current letter for sorting using letter - CurCategory: string; // current edition for sorting using edition, genre etc. - Order: integer; // number used for ordernum - LetterTmp: char; - CatNumber: integer; // Number of Song in Category - - procedure AddCategoryButton(const CategoryName: string); - var - PrevCatBtnIndex: integer; - begin - Inc(Order); - CatIndex := Length(Song); - SetLength(Song, CatIndex+1); - Song[CatIndex] := TSong.Create(); - Song[CatIndex].Artist := '[' + CategoryName + ']'; - Song[CatIndex].Main := true; - Song[CatIndex].OrderTyp := 0; - Song[CatIndex].OrderNum := Order; - Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName); - Song[CatIndex].Visible := true; - - // set number of songs in previous category - PrevCatBtnIndex := CatIndex - CatNumber - 1; - if ((PrevCatBtnIndex >= 0) and Song[PrevCatBtnIndex].Main) then - Song[PrevCatBtnIndex].CatNumber := CatNumber; - - CatNumber := 0; - end; - -begin - CatNumShow := -1; - - SortSongs(); - - CurCategory := ''; - Order := 0; - CatNumber := 0; - - // Note: do NOT set Letter to ' ', otherwise no category-button will be - // created for songs beginning with ' ' if songs of this category exist. - // TODO: trim song-properties so ' ' will not occur as first chararcter. - Letter := #0; - - // clear song-list - for SongIndex := 0 to Songs.SongList.Count-1 do - begin - // free category buttons - // Note: do NOT delete songs, they are just references to Songs.SongList entries - CurSong := TSong(Songs.SongList[SongIndex]); - if (CurSong.Main) then - CurSong.Free; - end; - SetLength(Song, 0); - - for SongIndex := 0 to Songs.SongList.Count-1 do - begin - CurSong := TSong(Songs.SongList[SongIndex]); - // if tabs are on, add section buttons for each new section - if (Ini.Tabs = 1) then - begin - if (Ini.Sorting = sEdition) and - (CompareText(CurCategory, CurSong.Edition) <> 0) then - begin - CurCategory := CurSong.Edition; - - // TODO: remove this block if it is not needed anymore - { - if CurSection = 'Singstar Part 2' then CoverName := 'Singstar'; - if CurSection = 'Singstar German' then CoverName := 'Singstar'; - if CurSection = 'Singstar Spanish' then CoverName := 'Singstar'; - if CurSection = 'Singstar Italian' then CoverName := 'Singstar'; - if CurSection = 'Singstar French' then CoverName := 'Singstar'; - if CurSection = 'Singstar 80s Polish' then CoverName := 'Singstar 80s'; - } - - // add Category Button - AddCategoryButton(CurCategory); - end - - else if (Ini.Sorting = sGenre) and - (CompareText(CurCategory, CurSong.Genre) <> 0) then - begin - CurCategory := CurSong.Genre; - // add Genre Button - AddCategoryButton(CurCategory); - end - - else if (Ini.Sorting = sLanguage) and - (CompareText(CurCategory, CurSong.Language) <> 0) then - begin - CurCategory := CurSong.Language; - // add Language Button - AddCategoryButton(CurCategory); - end - - else if (Ini.Sorting = sTitle) and - (Length(CurSong.Title) >= 1) and - (Letter <> UpperCase(CurSong.Title)[1]) then - begin - Letter := Uppercase(CurSong.Title)[1]; - // add a letter Category Button - AddCategoryButton(Letter); - end - - else if (Ini.Sorting = sArtist) and - (Length(CurSong.Artist) >= 1) and - (Letter <> UpperCase(CurSong.Artist)[1]) then - begin - Letter := UpperCase(CurSong.Artist)[1]; - // add a letter Category Button - AddCategoryButton(Letter); - end - - else if (Ini.Sorting = sFolder) and - (CompareText(CurCategory, CurSong.Folder) <> 0) then - begin - CurCategory := CurSong.Folder; - // add folder tab - AddCategoryButton(CurCategory); - end - - else if (Ini.Sorting = sTitle2) and - (Length(CurSong.Title) >= 1) then - begin - // pack all numbers into a category named '#' - if (CurSong.Title[1] >= '0') and (CurSong.Title[1] <= '9') then - LetterTmp := '#' - else - LetterTmp := UpperCase(CurSong.Title)[1]; - - if (Letter <> LetterTmp) then - begin - Letter := LetterTmp; - // add a letter Category Button - AddCategoryButton(Letter); - end; - end - - else if (Ini.Sorting = sArtist2) and - (Length(CurSong.Artist)>=1) then - begin - // pack all numbers into a category named '#' - if (CurSong.Artist[1] >= '0') and (CurSong.Artist[1] <= '9') then - LetterTmp := '#' - else - LetterTmp := UpperCase(CurSong.Artist)[1]; - - if (Letter <> LetterTmp) then - begin - Letter := LetterTmp; - // add a letter Category Button - AddCategoryButton(Letter); - end; - end; - end; - - CatIndex := Length(Song); - SetLength(Song, CatIndex+1); - - Inc(CatNumber); // increase number of songs in category - - // copy reference to current song - Song[CatIndex] := CurSong; - - // set song's category info - CurSong.OrderNum := Order; // assigns category - CurSong.CatNumber := CatNumber; - - if (Ini.Tabs = 0) then - CurSong.Visible := true - else if (Ini.Tabs = 1) then - CurSong.Visible := false; - - { - if (Ini.Tabs = 1) and (Order = 1) then - begin - //open first tab - CurSong.Visible := true; - end; - CurSong.Visible := true; - } - end; - - // set CatNumber of last category - if (Ini.Tabs_at_startup = 1) and (High(Song) >= 1) then - begin - // set number of songs in previous category - SongIndex := CatIndex - CatNumber; - if ((SongIndex >= 0) and Song[SongIndex].Main) then - Song[SongIndex].CatNumber := CatNumber; - end; - - // update number of categories - CatCount := Order; -end; - -procedure TCatSongs.ShowCategory(Index: integer); -var - S: integer; // song -begin - CatNumShow := Index; - for S := 0 to high(CatSongs.Song) do - begin -{ - if (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false; -} -// KMS: This should be the same, but who knows :-) - CatSongs.Song[S].Visible := ( (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) ); - end; -end; - -procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category -var - S: integer; // song -begin - for S := 0 to high(CatSongs.Song) do - begin - if not CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := false // hides all at now - end; -end; - -procedure TCatSongs.ClickCategoryButton(Index: integer); -var - Num, S: integer; -begin - Num := CatSongs.Song[Index].OrderNum; - if Num <> CatNumShow then - begin - ShowCategory(Num); - end - else - begin - ShowCategoryList; - end; -end; - -//Hide Categorys when in Category Hack -procedure TCatSongs.ShowCategoryList; -var - Num, S: integer; -begin - // Hide All Songs Show All Cats - for S := 0 to high(CatSongs.Song) do - CatSongs.Song[S].Visible := CatSongs.Song[S].Main; - CatSongs.Selected := CatNumShow; //Show last shown Category - CatNumShow := -1; -end; -//Hide Categorys when in Category Hack End - -//Wrong song selected when tabs on bug -function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song -var - I: integer; -begin - Result := -1; - I := SearchFrom + 1; - while not CatSongs.Song[I].Visible do - begin - Inc (I); - if (I>high(CatSongs.Song)) then - I := low(CatSongs.Song); - if (I = SearchFrom) then //Make One Round and no song found->quit - break; - end; -end; -//Wrong song selected when tabs on bug End - -(** - * Returns the number of visible songs. - *) -function TCatSongs.VisibleSongs: integer; -var - SongIndex: integer; -begin - Result := 0; - for SongIndex := 0 to High(CatSongs.Song) do - begin - if (CatSongs.Song[SongIndex].Visible) then - Inc(Result); - end; -end; - -(** - * Returns the index of a song in the subset of all visible songs. - * If all songs are visible, the result will be equal to the Index parameter. - *) -function TCatSongs.VisibleIndex(Index: integer): integer; -var - SongIndex: integer; -begin - Result := 0; - for SongIndex := 0 to Index-1 do - begin - if (CatSongs.Song[SongIndex].Visible) then - Inc(Result); - end; -end; - -function TCatSongs.SetFilter(FilterStr: string; const fType: Byte): Cardinal; -var - I, J: integer; - cString: string; - SearchStr: array of string; -begin - {fType: 0: All - 1: Title - 2: Artist} - FilterStr := Trim(FilterStr); - if FilterStr<>'' then - begin - Result := 0; - //Create Search Array - SetLength(SearchStr, 1); - I := Pos (' ', FilterStr); - while (I <> 0) do - begin - SetLength (SearchStr, Length(SearchStr) + 1); - cString := Copy(FilterStr, 1, I-1); - if (cString <> ' ') and (cString <> '') then - SearchStr[High(SearchStr)-1] := cString; - Delete (FilterStr, 1, I); - - I := Pos (' ', FilterStr); - end; - //Copy last Word - if (FilterStr <> ' ') and (FilterStr <> '') then - SearchStr[High(SearchStr)] := FilterStr; - - for I:=0 to High(Song) do - begin - if not Song[i].Main then - begin - case fType of - 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; - 1: cString := Song[I].Title; - 2: cString := Song[I].Artist; - end; - Song[i].Visible:=True; - //Look for every Searched Word - for J := 0 to High(SearchStr) do - begin - Song[i].Visible := Song[i].Visible and AnsiContainsText(cString, SearchStr[J]) - end; - if Song[i].Visible then - Inc(Result); - end - else - Song[i].Visible:=False; - end; - CatNumShow := -2; - end - else - begin - for i:=0 to High(Song) do - begin - Song[i].Visible := (Ini.Tabs=1) = Song[i].Main; - CatNumShow := -1; - end; - Result := 0; - end; -end; - -// ----------------------------------------------------------------------------- - -end. diff --git a/src/Classes/UTextClasses.pas b/src/Classes/UTextClasses.pas deleted file mode 100644 index 9a12e1f5..00000000 --- a/src/Classes/UTextClasses.pas +++ /dev/null @@ -1,60 +0,0 @@ -unit UTextClasses; - -interface - -{$I switches.inc} - -uses - gl, - SDL, - UTexture, - Classes, -// SDL_ttf, - ULog; - -{ -// okay i just outline what should be here, so we can create a nice and clean implementation of sdl_ttf -// based up on this uml: http://jnr.sourceforge.net/fusion_images/www_FRS.png -// thanks to Bob Pendelton and Koshmaar! -// (1) let's start with a glyph, this represents one character in a word - -type - TGlyph = record - character : Char; // unsigned char, uchar is something else in delphi - glyphsSolid[8] : GlyphTexture; // fast, but not that - glyphsBlended[8] : GlyphTexture; // slower than solid, but it look's more pretty - -//this class has a method, which should be a deconstructor (mog is on his way to understand the principles of oop :P) - deconstructor procedure ReleaseTextures(); -end; - -// (2) okay, we now need the stuff that's even beneath this glyph - we're right at the birth of text in here :P - - GlyphTexture = record - textureID : GLuint; // we need this for caching the letters, if the texture wasn't created before create it, should be very fast because of this one - width, - height : Cardinal; - charWidth, - charHeight : Integer; - advance : Integer; // don't know yet for what this one is -} - -{ -// after the glyph is done, we now start to build whole words - this one is pretty important, and does most of the work we need - TGlyphsContainer = record - glyphs array of TGlyph; - FontName array of string; - refCount : uChar; // unsigned char, uchar is something else in delphi - font : PTTF_font; - size, - lineSkip : Cardinal; // vertical distance between multi line text output - descent : Integer; - - - -} - - -implementation - -end. diff --git a/src/Classes/UTexture.pas b/src/Classes/UTexture.pas deleted file mode 100644 index 4879760a..00000000 --- a/src/Classes/UTexture.pas +++ /dev/null @@ -1,525 +0,0 @@ -unit UTexture; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - gl, - glu, - glext, - Classes, - SysUtils, - UCommon, - SDL, - SDL_Image; - -type - PTexture = ^TTexture; - TTexture = record - TexNum: GLuint; - X: real; - Y: real; - Z: real; - W: real; - H: real; - ScaleW: real; // for dynamic scalling while leaving width constant - ScaleH: real; // for dynamic scalling while leaving height constant - Rot: real; // 0 - 2*pi - Int: real; // intensity - ColR: real; - ColG: real; - ColB: real; - TexW: real; // percentage of width to use [0..1] - TexH: real; // percentage of height to use [0..1] - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - Alpha: real; - Name: string; // experimental for handling cache images. maybe it's useful for dynamic skins - end; - -type - TTextureType = ( - TEXTURE_TYPE_PLAIN, // Plain (alpha = 1) - TEXTURE_TYPE_TRANSPARENT, // Alpha is used - TEXTURE_TYPE_COLORIZED // Alpha is used; Hue of the HSV color-model will be replaced by a new value - ); - -const - TextureTypeStr: array[TTextureType] of string = ( - 'Plain', - 'Transparent', - 'Colorized' - ); - -function TextureTypeToStr(TexType: TTextureType): string; -function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType; - -procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType); - -type - PTextureEntry = ^TTextureEntry; - TTextureEntry = record - Name: string; - Typ: TTextureType; - Color: Cardinal; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; // Full-size texture - TextureCache: TTexture; // Thumbnail texture - end; - - TTextureDatabase = class - private - Texture: array of TTextureEntry; - public - procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); - function FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer; - end; - - TTextureUnit = class - private - TextureDatabase: TTextureDatabase; - public - Limit: integer; - - procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload; - procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean = false); overload; - function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload; - function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload; - function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload; - function LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload; - function LoadTexture(const Identifier: string): TTexture; overload; - function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; - procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload; - procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload; - //procedure FlushTextureDatabase(); - - constructor Create; - destructor Destroy; override; - end; - -var - Texture: TTextureUnit; - -implementation - -uses - DateUtils, - StrUtils, - Math, - ULog, - UCovers, - UThemes, - UImage; - -procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType); -var - TempSurface: PSDL_Surface; - NeededPixFmt: PSDL_Pixelformat; -begin - if (Typ = TEXTURE_TYPE_PLAIN) then - NeededPixFmt := @PixelFmt_RGB - else if (Typ = TEXTURE_TYPE_TRANSPARENT) or - (Typ = TEXTURE_TYPE_COLORIZED) then - NeededPixFmt := @PixelFmt_RGBA - else - NeededPixFmt := @PixelFmt_RGB; - - if not PixelformatEquals(TexSurface^.format, NeededPixFmt) then - begin - TempSurface := TexSurface; - TexSurface := SDL_ConvertSurface(TempSurface, NeededPixFmt, SDL_SWSURFACE); - SDL_FreeSurface(TempSurface); - end; -end; - -{ TTextureDatabase } - -procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); -var - TextureIndex: integer; -begin - TextureIndex := FindTexture(Tex.Name, Typ, Color); - if (TextureIndex = -1) then - begin - TextureIndex := Length(Texture); - SetLength(Texture, TextureIndex+1); - - Texture[TextureIndex].Name := Tex.Name; - Texture[TextureIndex].Typ := Typ; - Texture[TextureIndex].Color := Color; - end; - - if (Cache) then - Texture[TextureIndex].TextureCache := Tex - else - Texture[TextureIndex].Texture := Tex; -end; - -function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer; -var - TextureIndex: integer; - CurrentTexture: PTextureEntry; -begin - Result := -1; - for TextureIndex := 0 to High(Texture) do - begin - CurrentTexture := @Texture[TextureIndex]; - if (CurrentTexture.Name = Name) and - (CurrentTexture.Typ = Typ) then - begin - // colorized textures must match in their color too - if (CurrentTexture.Typ <> TEXTURE_TYPE_COLORIZED) or - (CurrentTexture.Color = Color) then - begin - Result := TextureIndex; - Break; - end; - end; - end; -end; - - -{ TTextureUnit } - -constructor TTextureUnit.Create; -begin - inherited Create; - TextureDatabase := TTextureDatabase.Create; -end; - -destructor TTextureUnit.Destroy; -begin - TextureDatabase.Free; - inherited Destroy; -end; - - -procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean); -begin - TextureDatabase.AddTexture(Tex, Typ, 0, Cache); -end; - -procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); -begin - TextureDatabase.AddTexture(Tex, Typ, Color, Cache); -end; - -function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; -begin - // FIXME: what is the FromRegistry parameter supposed to do? - Result := LoadTexture(Identifier, Typ, Col); -end; - -function TTextureUnit.LoadTexture(const Identifier: string): TTexture; -begin - Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0); -end; - -function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; -var - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - ActTex: GLuint; -begin - // zero texture data - FillChar(Result, SizeOf(Result), 0); - - // load texture data into memory - TexSurface := LoadImage(Identifier); - if not assigned(TexSurface) then - begin - Log.LogError('Could not load texture: "' + Identifier +' '+ TextureTypeToStr(Typ) +'"', - 'TTextureUnit.LoadTexture'); - Exit; - end; - - // convert pixel format as needed - AdjustPixelFormat(TexSurface, Typ); - - // adjust texture size (scale down, if necessary) - newWidth := TexSurface.W; - newHeight := TexSurface.H; - - if (newWidth > Limit) then - newWidth := Limit; - - if (newHeight > Limit) then - newHeight := Limit; - - if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then - ScaleImage(TexSurface, newWidth, newHeight); - - // now we might colorize the whole thing - if (Typ = TEXTURE_TYPE_COLORIZED) then - ColorizeImage(TexSurface, Col); - - // save actual dimensions of our texture - oldWidth := newWidth; - oldHeight := newHeight; - - // make texture dimensions be powers of 2 - newWidth := Round(Power(2, Ceil(Log2(newWidth)))); - newHeight := Round(Power(2, Ceil(Log2(newHeight)))); - if (newHeight <> oldHeight) or (newWidth <> oldWidth) then - FitImage(TexSurface, newWidth, newHeight); - - // at this point we have the image in memory... - // scaled to be at most 1024x1024 pixels large - // scaled so that dimensions are powers of 2 - // and converted to either RGB or RGBA - - // if we got a Texture of Type Plain, Transparent or Colorized, - // then we're done manipulating it - // and could now create our openGL texture from it - - // prepare OpenGL texture - glGenTextures(1, @ActTex); - - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - // load data into gl texture - if (Typ = TEXTURE_TYPE_TRANSPARENT) or - (Typ = TEXTURE_TYPE_COLORIZED) then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - else //if Typ = TEXTURE_TYPE_PLAIN then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; - - // setup texture struct - with Result do - begin - X := 0; - Y := 0; - Z := 0; - W := 0; - H := 0; - ScaleW := 1; - ScaleH := 1; - Rot := 0; - TexNum := ActTex; - TexW := oldWidth / newWidth; - TexH := oldHeight / newHeight; - - Int := 1; - ColR := 1; - ColG := 1; - ColB := 1; - Alpha := 1; - - // new test - default use whole texure, taking TexW and TexH as const and changing these - TexX1 := 0; - TexY1 := 0; - TexX2 := 1; - TexY2 := 1; - - Name := Identifier; - end; - - SDL_FreeSurface(TexSurface); -end; - -function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean): TTexture; -begin - Result := GetTexture(Name, Typ, 0, FromCache); -end; - -function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture; -var - TextureIndex: integer; - CoverIndex: integer; -begin - if (Name = '') then - begin - // zero texture data - FillChar(Result, SizeOf(Result), 0); - Exit; - end; - - if (FromCache) then - begin - (* - // use cache texture - CoverIndex := Covers.FindCover(Name); - - if TextureDatabase.Texture[TextureIndex].TextureCache.TexNum = 0 then - begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[TextureIndex].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[CoverIndex].Width, Covers.Cover[CoverIndex].Height, 24); - end; - *) - - // use texture - TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col); - if (TextureIndex > -1) then - Result := TextureDatabase.Texture[TextureIndex].TextureCache; - Exit; - end; - - // find texture entry in database - TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col); - if (TextureIndex = -1) then - begin - // create texture entry in database - TextureIndex := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, TextureIndex+1); - - TextureDatabase.Texture[TextureIndex].Name := Name; - TextureDatabase.Texture[TextureIndex].Typ := Typ; - TextureDatabase.Texture[TextureIndex].Color := Col; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[TextureIndex].Texture.TexNum := 0; - TextureDatabase.Texture[TextureIndex].TextureCache.TexNum := 0; - end; - - // load full texture - if (TextureDatabase.Texture[TextureIndex].Texture.TexNum = 0) then - TextureDatabase.Texture[TextureIndex].Texture := LoadTexture(false, Name, Typ, Col); - - // use texture - Result := TextureDatabase.Texture[TextureIndex].Texture; -end; - -function TTextureUnit.CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; -var - Error: integer; - ActTex: GLuint; -begin - glGenTextures(1, @ActTex); // ActText = new texture number - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data); - - { - if Mipmapping then - begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); - if Error > 0 then - Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture'); - end; - } - - Result.X := 0; - Result.Y := 0; - Result.Z := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := 1; - Result.TexH := 1; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - Result.Name := Name; -end; - -procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); -begin - UnloadTexture(Name, Typ, 0, FromCache); -end; - -procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := TextureDatabase.FindTexture(Name, Typ, Col); - - if not FromCache then - begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum > 0 then - begin - glDeleteTextures(1, PGLuint(@TexNum)); - TextureDatabase.Texture[T].Texture.TexNum := 0; - //Log.LogError('Unload texture no '+IntToStr(TexNum)); - end; - end - else - begin - TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; - if TexNum > 0 then - begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].TextureCache.TexNum := 0; - //Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -(* This needs some work -procedure TTextureUnit.FlushTextureDatabase(); -var - i: integer; - Tex: ^TTexture; -begin - for i := 0 to High(TextureDatabase.Texture) do - begin - // only delete non-cached entries - if (TextureDatabase.Texture[i].Texture.TexNum > 0) then - begin - Tex := @TextureDatabase.Texture[i].Texture; - glDeleteTextures(1, PGLuint(Tex^.TexNum)); - Tex^.TexNum := 0; - end; - end; -end; -*) - -function TextureTypeToStr(TexType: TTextureType): string; -begin - Result := TextureTypeStr[TexType]; -end; - -function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType; -var - TexType: TTextureType; - UpCaseStr: string; -begin - UpCaseStr := UpperCase(TypeStr); - for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do - begin - if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then - begin - Result := TexType; - Exit; - end; - end; - Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType'); - Result := TEXTURE_TYPE_PLAIN; -end; - -end. diff --git a/src/Classes/UThemes.pas b/src/Classes/UThemes.pas deleted file mode 100644 index fca75c24..00000000 --- a/src/Classes/UThemes.pas +++ /dev/null @@ -1,2234 +0,0 @@ -unit UThemes; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - ULog, - IniFiles, - SysUtils, - Classes, - UTexture; - -type - TRGB = record - R: single; - G: single; - B: single; - end; - - TRGBA = record - R, G, B, A: Double; - end; - - TThemeBackground = record - Tex: string; - end; - - TThemeStatic = record - X: integer; - Y: integer; - Z: real; - W: integer; - H: integer; - Color: string; - ColR: real; - ColG: real; - ColB: real; - Tex: string; - Typ: TTextureType; - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - //Reflection - Reflection: boolean; - Reflectionspacing: Real; - end; - AThemeStatic = array of TThemeStatic; - - TThemeText = record - X: integer; - Y: integer; - W: integer; - Z: real; - Color: string; - ColR: real; - ColG: real; - ColB: real; - Font: integer; - Size: integer; - Align: integer; - Text: string; - //Reflection - Reflection: boolean; - ReflectionSpacing: Real; - end; - AThemeText = array of TThemeText; - - TThemeButton = record - Text: AThemeText; - X: integer; - Y: integer; - Z: Real; - W: integer; - H: integer; - Color: string; - ColR: real; - ColG: real; - ColB: real; - Int: real; - DColor: string; - DColR: real; - DColG: real; - DColB: real; - DInt: real; - Tex: string; - Typ: TTextureType; - - Visible: Boolean; - - //Reflection Mod - Reflection: boolean; - Reflectionspacing: Real; - //Fade Mod - SelectH: integer; - SelectW: integer; - Fade: boolean; - FadeText: boolean; - DeSelectReflectionspacing : Real; - FadeTex: string; - FadeTexPos: integer; - - //Button Collection Mod - Parent: Byte; //Number of the Button Collection this Button is assigned to. IF 0: No Assignement - end; - - //Button Collection Mod - TThemeButtonCollection = record - Style: TThemeButton; - ChildCount: Byte; //No of assigned Childs - FirstChild: Byte; //No of Child on whose Interaction Position the Button should be - end; - - AThemeButtonCollection = array of TThemeButtonCollection; - PAThemeButtonCollection = ^AThemeButtonCollection; - - TThemeSelectSlide = record - Tex: string; - TexSBG: string; - X: integer; - Y: integer; - W: integer; - H: integer; - Z: real; - - TextSize: integer; - - //SBGW Mod - SBGW: integer; - - Text: string; - ColR, ColG, ColB, Int: real; - DColR, DColG, DColB, DInt: real; - TColR, TColG, TColB, TInt: real; - TDColR, TDColG, TDColB, TDInt: real; - SBGColR, SBGColG, SBGColB, SBGInt: real; - SBGDColR, SBGDColG, SBGDColB, SBGDInt: real; - STColR, STColG, STColB, STInt: real; - STDColR, STDColG, STDColB, STDInt: real; - SkipX: integer; - end; - - PThemeBasic = ^TThemeBasic; - TThemeBasic = class - Background: TThemeBackground; - Text: AThemeText; - Static: AThemeStatic; - - //Button Collection Mod - ButtonCollection: AThemeButtonCollection; - end; - - TThemeLoading = class(TThemeBasic) - StaticAnimation: TThemeStatic; - TextLoading: TThemeText; - end; - - TThemeMain = class(TThemeBasic) - ButtonSolo: TThemeButton; - ButtonMulti: TThemeButton; - ButtonStat: TThemeButton; - ButtonEditor: TThemeButton; - ButtonOptions: TThemeButton; - ButtonExit: TThemeButton; - - TextDescription: TThemeText; - TextDescriptionLong: TThemeText; - Description: array[0..5] of string; - DescriptionLong: array[0..5] of string; - end; - - TThemeName = class(TThemeBasic) - ButtonPlayer: array[1..6] of TThemeButton; - end; - - TThemeLevel = class(TThemeBasic) - ButtonEasy: TThemeButton; - ButtonMedium: TThemeButton; - ButtonHard: TThemeButton; - end; - - TThemeSong = class(TThemeBasic) - TextArtist: TThemeText; - TextTitle: TThemeText; - TextNumber: TThemeText; - - //Video Icon Mod - VideoIcon: TThemeStatic; - - //Show Cat in TopLeft Mod - TextCat: TThemeText; - StaticCat: TThemeStatic; - - //Cover Mod - Cover: record - Reflections: Boolean; - X: Integer; - Y: Integer; - Z: Integer; - W: Integer; - H: Integer; - Style: Integer; - end; - - //Equalizer Mod - Equalizer: record - Visible: Boolean; - Direction: Boolean; - Alpha: real; - X: Integer; - Y: Integer; - Z: Real; - W: Integer; - H: Integer; - Space: Integer; - Bands: Integer; - Length: Integer; - ColR, ColG, ColB: Real; - end; - - - //Party and Non Party specific Statics and Texts - StaticParty: AThemeStatic; - TextParty: AThemeText; - - StaticNonParty: AThemeStatic; - TextNonParty: AThemeText; - - //Party Mode - StaticTeam1Joker1: TThemeStatic; - StaticTeam1Joker2: TThemeStatic; - StaticTeam1Joker3: TThemeStatic; - StaticTeam1Joker4: TThemeStatic; - StaticTeam1Joker5: TThemeStatic; - StaticTeam2Joker1: TThemeStatic; - StaticTeam2Joker2: TThemeStatic; - StaticTeam2Joker3: TThemeStatic; - StaticTeam2Joker4: TThemeStatic; - StaticTeam2Joker5: TThemeStatic; - StaticTeam3Joker1: TThemeStatic; - StaticTeam3Joker2: TThemeStatic; - StaticTeam3Joker3: TThemeStatic; - StaticTeam3Joker4: TThemeStatic; - StaticTeam3Joker5: TThemeStatic; - - - end; - - TThemeSing = class(TThemeBasic) - - //TimeBar mod - StaticTimeProgress: TThemeStatic; - TextTimeText : TThemeText; - //eoa TimeBar mod - - StaticP1: TThemeStatic; - TextP1: TThemeText; - StaticP1ScoreBG: TThemeStatic; //Static for ScoreBG - TextP1Score: TThemeText; - - //moveable singbar mod - StaticP1SingBar: TThemeStatic; - StaticP1ThreePSingBar: TThemeStatic; - StaticP1TwoPSingBar: TThemeStatic; - StaticP2RSingBar: TThemeStatic; - StaticP2MSingBar: TThemeStatic; - StaticP3SingBar: TThemeStatic; - //eoa moveable singbar - - //added for ps3 skin - //game in 2/4 player modi - StaticP1TwoP: TThemeStatic; - StaticP1TwoPScoreBG: TThemeStatic; //Static for ScoreBG - TextP1TwoP: TThemeText; - TextP1TwoPScore: TThemeText; - //game in 3/6 player modi - StaticP1ThreeP: TThemeStatic; - StaticP1ThreePScoreBG: TThemeStatic; //Static for ScoreBG - TextP1ThreeP: TThemeText; - TextP1ThreePScore: TThemeText; - //eoa - - StaticP2R: TThemeStatic; - StaticP2RScoreBG: TThemeStatic; //Static for ScoreBG - TextP2R: TThemeText; - TextP2RScore: TThemeText; - - StaticP2M: TThemeStatic; - StaticP2MScoreBG: TThemeStatic; //Static for ScoreBG - TextP2M: TThemeText; - TextP2MScore: TThemeText; - - StaticP3R: TThemeStatic; - StaticP3RScoreBG: TThemeStatic; //Static for ScoreBG - TextP3R: TThemeText; - TextP3RScore: TThemeText; - - //Linebonus Translations - LineBonusText: Array [0..8] of String; - - //Pause Popup - PausePopUp: TThemeStatic; - end; - - TThemeScore = class(TThemeBasic) - TextArtist: TThemeText; - TextTitle: TThemeText; - - TextArtistTitle: TThemeText; - - PlayerStatic: array[1..6] of AThemeStatic; - PlayerTexts: array[1..6] of AThemeText; - - TextName: array[1..6] of TThemeText; - TextScore: array[1..6] of TThemeText; - - TextNotes: array[1..6] of TThemeText; - TextNotesScore: array[1..6] of TThemeText; - TextLineBonus: array[1..6] of TThemeText; - TextLineBonusScore: array[1..6] of TThemeText; - TextGoldenNotes: array[1..6] of TThemeText; - TextGoldenNotesScore: array[1..6] of TThemeText; - TextTotal: array[1..6] of TThemeText; - TextTotalScore: array[1..6] of TThemeText; - - StaticBoxLightest: array[1..6] of TThemeStatic; - StaticBoxLight: array[1..6] of TThemeStatic; - StaticBoxDark: array[1..6] of TThemeStatic; - - StaticRatings: array[1..6] of TThemeStatic; - - StaticBackLevel: array[1..6] of TThemeStatic; - StaticBackLevelRound: array[1..6] of TThemeStatic; - StaticLevel: array[1..6] of TThemeStatic; - StaticLevelRound: array[1..6] of TThemeStatic; - -// Description: array[0..5] of string;} - end; - - TThemeTop5 = class(TThemeBasic) - TextLevel: TThemeText; - TextArtistTitle: TThemeText; - - StaticNumber: AThemeStatic; - TextNumber: AThemeText; - TextName: AThemeText; - TextScore: AThemeText; - end; - - TThemeOptions = class(TThemeBasic) - ButtonGame: TThemeButton; - ButtonGraphics: TThemeButton; - ButtonSound: TThemeButton; - ButtonLyrics: TThemeButton; - ButtonThemes: TThemeButton; - ButtonRecord: TThemeButton; - ButtonAdvanced: TThemeButton; - ButtonExit: TThemeButton; - - TextDescription: TThemeText; - Description: array[0..7] of string; - end; - - TThemeOptionsGame = class(TThemeBasic) - SelectPlayers: TThemeSelectSlide; - SelectDifficulty: TThemeSelectSlide; - SelectLanguage: TThemeSelectSlide; - SelectTabs: TThemeSelectSlide; - SelectSorting: TThemeSelectSlide; - SelectDebug: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsGraphics = class(TThemeBasic) - SelectFullscreen: TThemeSelectSlide; - SelectResolution: TThemeSelectSlide; - SelectDepth: TThemeSelectSlide; - SelectVisualizer: TThemeSelectSlide; - SelectOscilloscope: TThemeSelectSlide; - SelectLineBonus: TThemeSelectSlide; - SelectMovieSize: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsSound = class(TThemeBasic) - SelectMicBoost: TThemeSelectSlide; - SelectBackgroundMusic: TThemeSelectSlide; - SelectClickAssist: TThemeSelectSlide; - SelectBeatClick: TThemeSelectSlide; - SelectThreshold: TThemeSelectSlide; - SelectSlidePreviewVolume: TThemeSelectSlide; - SelectSlidePreviewFading: TThemeSelectSlide; - SelectSlideVoicePassthrough: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsLyrics = class(TThemeBasic) - SelectLyricsFont: TThemeSelectSlide; - SelectLyricsEffect: TThemeSelectSlide; -// SelectSolmization: TThemeSelectSlide; - SelectNoteLines: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsThemes = class(TThemeBasic) - SelectTheme: TThemeSelectSlide; - SelectSkin: TThemeSelectSlide; - SelectColor: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsRecord = class(TThemeBasic) - SelectSlideCard: TThemeSelectSlide; - SelectSlideInput: TThemeSelectSlide; - SelectSlideChannel: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsAdvanced = class(TThemeBasic) - SelectLoadAnimation: TThemeSelectSlide; - SelectEffectSing: TThemeSelectSlide; - SelectScreenFade: TThemeSelectSlide; - SelectLineBonus: TThemeSelectSlide; - SelectAskbeforeDel: TThemeSelectSlide; - SelectOnSongClick: TThemeSelectSlide; - SelectPartyPopup: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - //Error- and Check-Popup - TThemeError = class(TThemeBasic) - Button1: TThemeButton; - TextError: TThemeText; - end; - - TThemeCheck = class(TThemeBasic) - Button1: TThemeButton; - Button2: TThemeButton; - TextCheck: TThemeText; - end; - - - //ScreenSong Menue - TThemeSongMenu = class(TThemeBasic) - Button1: TThemeButton; - Button2: TThemeButton; - Button3: TThemeButton; - Button4: TThemeButton; - - SelectSlide3: TThemeSelectSlide; - - TextMenu: TThemeText; - end; - - TThemeSongJumpTo = class(TThemeBasic) - ButtonSearchText: TThemeButton; - SelectSlideType: TThemeSelectSlide; - TextFound: TThemeText; - - //Translated Texts - Songsfound: String; - NoSongsfound: String; - CatText: String; - IType: array [0..2] of String; - end; - - //Party Screens - TThemePartyNewRound = class(TThemeBasic) - TextRound1: TThemeText; - TextRound2: TThemeText; - TextRound3: TThemeText; - TextRound4: TThemeText; - TextRound5: TThemeText; - TextRound6: TThemeText; - TextRound7: TThemeText; - TextWinner1: TThemeText; - TextWinner2: TThemeText; - TextWinner3: TThemeText; - TextWinner4: TThemeText; - TextWinner5: TThemeText; - TextWinner6: TThemeText; - TextWinner7: TThemeText; - TextNextRound: TThemeText; - TextNextRoundNo: TThemeText; - TextNextPlayer1: TThemeText; - TextNextPlayer2: TThemeText; - TextNextPlayer3: TThemeText; - - StaticRound1: TThemeStatic; - StaticRound2: TThemeStatic; - StaticRound3: TThemeStatic; - StaticRound4: TThemeStatic; - StaticRound5: TThemeStatic; - StaticRound6: TThemeStatic; - StaticRound7: TThemeStatic; - - TextScoreTeam1: TThemeText; - TextScoreTeam2: TThemeText; - TextScoreTeam3: TThemeText; - TextNameTeam1: TThemeText; - TextNameTeam2: TThemeText; - TextNameTeam3: TThemeText; - TextTeam1Players: TThemeText; - TextTeam2Players: TThemeText; - TextTeam3Players: TThemeText; - - StaticTeam1: TThemeStatic; - StaticTeam2: TThemeStatic; - StaticTeam3: TThemeStatic; - StaticNextPlayer1: TThemeStatic; - StaticNextPlayer2: TThemeStatic; - StaticNextPlayer3: TThemeStatic; - end; - - TThemePartyScore = class(TThemeBasic) - TextScoreTeam1: TThemeText; - TextScoreTeam2: TThemeText; - TextScoreTeam3: TThemeText; - TextNameTeam1: TThemeText; - TextNameTeam2: TThemeText; - TextNameTeam3: TThemeText; - StaticTeam1: TThemeStatic; - StaticTeam1BG: TThemeStatic; - StaticTeam1Deco: TThemeStatic; - StaticTeam2: TThemeStatic; - StaticTeam2BG: TThemeStatic; - StaticTeam2Deco: TThemeStatic; - StaticTeam3: TThemeStatic; - StaticTeam3BG: TThemeStatic; - StaticTeam3Deco: TThemeStatic; - - DecoTextures: record - ChangeTextures: Boolean; - - FirstTexture: String; - FirstTyp: TTextureType; - FirstColor: String; - - SecondTexture: String; - SecondTyp: TTextureType; - SecondColor: String; - - ThirdTexture: String; - ThirdTyp: TTextureType; - ThirdColor: String; - end; - - - TextWinner: TThemeText; - end; - - TThemePartyWin = class(TThemeBasic) - TextScoreTeam1: TThemeText; - TextScoreTeam2: TThemeText; - TextScoreTeam3: TThemeText; - TextNameTeam1: TThemeText; - TextNameTeam2: TThemeText; - TextNameTeam3: TThemeText; - StaticTeam1: TThemeStatic; - StaticTeam1BG: TThemeStatic; - StaticTeam1Deco: TThemeStatic; - StaticTeam2: TThemeStatic; - StaticTeam2BG: TThemeStatic; - StaticTeam2Deco: TThemeStatic; - StaticTeam3: TThemeStatic; - StaticTeam3BG: TThemeStatic; - StaticTeam3Deco: TThemeStatic; - - TextWinner: TThemeText; - end; - - TThemePartyOptions = class(TThemeBasic) - SelectLevel: TThemeSelectSlide; - SelectPlayList: TThemeSelectSlide; - SelectPlayList2: TThemeSelectSlide; - SelectRounds: TThemeSelectSlide; - SelectTeams: TThemeSelectSlide; - SelectPlayers1: TThemeSelectSlide; - SelectPlayers2: TThemeSelectSlide; - SelectPlayers3: TThemeSelectSlide; - - {ButtonNext: TThemeButton; - ButtonPrev: TThemeButton;} - end; - - TThemePartyPlayer = class(TThemeBasic) - Team1Name: TThemeButton; - Player1Name: TThemeButton; - Player2Name: TThemeButton; - Player3Name: TThemeButton; - Player4Name: TThemeButton; - - Team2Name: TThemeButton; - Player5Name: TThemeButton; - Player6Name: TThemeButton; - Player7Name: TThemeButton; - Player8Name: TThemeButton; - - Team3Name: TThemeButton; - Player9Name: TThemeButton; - Player10Name: TThemeButton; - Player11Name: TThemeButton; - Player12Name: TThemeButton; - - {ButtonNext: TThemeButton; - ButtonPrev: TThemeButton;} - end; - - //Stats Screens - TThemeStatMain = class(TThemeBasic) - ButtonScores: TThemeButton; - ButtonSingers: TThemeButton; - ButtonSongs: TThemeButton; - ButtonBands: TThemeButton; - ButtonExit: TThemeButton; - - TextOverview: TThemeText; - end; - - TThemeStatDetail = class(TThemeBasic) - ButtonNext: TThemeButton; - ButtonPrev: TThemeButton; - ButtonReverse: TThemeButton; - ButtonExit: TThemeButton; - - TextDescription: TThemeText; - TextPage: TThemeText; - TextList: AThemeText; - - Description: array[0..3] of string; - DescriptionR: array[0..3] of string; - FormatStr: array[0..3] of string; - PageStr: String; - end; - - //Playlist Translations - TThemePlaylist = record - CatText: string; - end; - - TTheme = class - private - {$IFDEF THEMESAVE} - ThemeIni: TIniFile; - {$ELSE} - ThemeIni: TMemIniFile; - {$ENDIF} - - LastThemeBasic: TThemeBasic; - procedure create_theme_objects(); - public - - Loading: TThemeLoading; - Main: TThemeMain; - Name: TThemeName; - Level: TThemeLevel; - Song: TThemeSong; - Sing: TThemeSing; - Score: TThemeScore; - Top5: TThemeTop5; - Options: TThemeOptions; - OptionsGame: TThemeOptionsGame; - OptionsGraphics: TThemeOptionsGraphics; - OptionsSound: TThemeOptionsSound; - OptionsLyrics: TThemeOptionsLyrics; - OptionsThemes: TThemeOptionsThemes; - OptionsRecord: TThemeOptionsRecord; - OptionsAdvanced: TThemeOptionsAdvanced; - //error and check popup - ErrorPopup: TThemeError; - CheckPopup: TThemeCheck; - //ScreenSong extensions - SongMenu: TThemeSongMenu; - SongJumpto: TThemeSongJumpTo; - //Party Screens: - PartyNewRound: TThemePartyNewRound; - PartyScore: TThemePartyScore; - PartyWin: TThemePartyWin; - PartyOptions: TThemePartyOptions; - PartyPlayer: TThemePartyPlayer; - - //Stats Screens: - StatMain: TThemeStatMain; - StatDetail: TThemeStatDetail; - - Playlist: TThemePlaylist; - - ILevel: array[0..2] of String; - - constructor Create(FileName: string); overload; // Initialize theme system - constructor Create(FileName: string; Color: integer); overload; // Initialize theme system with color - function LoadTheme(FileName: string; sColor: integer): boolean; // Load some theme settings from file - - procedure LoadColors; - - procedure ThemeLoadBasic(Theme: TThemeBasic; Name: string); - procedure ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string); - procedure ThemeLoadText(var ThemeText: TThemeText; Name: string); - procedure ThemeLoadTexts(var ThemeText: AThemeText; Name: string); - procedure ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string); - procedure ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string); - procedure ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection = nil); - procedure ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string); - procedure ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string); - procedure ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); - - procedure ThemeSave(FileName: string); - procedure ThemeSaveBasic(Theme: TThemeBasic; Name: string); - procedure ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string); - procedure ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string); - procedure ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string); - procedure ThemeSaveText(ThemeText: TThemeText; Name: string); - procedure ThemeSaveTexts(ThemeText: AThemeText; Name: string); - procedure ThemeSaveButton(ThemeButton: TThemeButton; Name: string); - - end; - - TColor = record - Name: string; - RGB: TRGB; - end; - -function ColorExists(Name: string): integer; -procedure LoadColor(var R, G, B: real; ColorName: string); -function GetSystemColor(Color: integer): TRGB; -function ColorSqrt(RGB: TRGB): TRGB; - -var - //Skin: TSkin; - Theme: TTheme; - Color: array of TColor; - -implementation - -uses - UCommon, - ULanguage, - USkins, - UIni; - -constructor TTheme.Create(FileName: string); -begin - Create(FileName, 0); -end; - -constructor TTheme.Create(FileName: string; Color: integer); -begin - inherited Create(); - - Loading := TThemeLoading.Create; - Main := TThemeMain.Create; - Name := TThemeName.Create; - Level := TThemeLevel.Create; - Song := TThemeSong.Create; - Sing := TThemeSing.Create; - Score := TThemeScore.Create; - Top5 := TThemeTop5.Create; - Options := TThemeOptions.Create; - OptionsGame := TThemeOptionsGame.Create; - OptionsGraphics := TThemeOptionsGraphics.Create; - OptionsSound := TThemeOptionsSound.Create; - OptionsLyrics := TThemeOptionsLyrics.Create; - OptionsThemes := TThemeOptionsThemes.Create; - OptionsRecord := TThemeOptionsRecord.Create; - OptionsAdvanced := TThemeOptionsAdvanced.Create; - - ErrorPopup := TThemeError.Create; - CheckPopup := TThemeCheck.Create; - - SongMenu := TThemeSongMenu.Create; - SongJumpto := TThemeSongJumpto.Create; - //Party Screens - PartyNewRound := TThemePartyNewRound.Create; - PartyWin := TThemePartyWin.Create; - PartyScore := TThemePartyScore.Create; - PartyOptions := TThemePartyOptions.Create; - PartyPlayer := TThemePartyPlayer.Create; - - //Stats Screens: - StatMain := TThemeStatMain.Create; - StatDetail := TThemeStatDetail.Create; - - LoadTheme(FileName, Color); - -end; - - -function TTheme.LoadTheme(FileName: string; sColor: integer): boolean; -var - I: integer; - Path: string; -begin - Result := false; - - create_theme_objects(); - - Log.LogStatus('Loading: '+ FileName, 'TTheme.LoadTheme'); - - FileName := AdaptFilePaths( FileName ); - - if not FileExists(FileName) then - begin - Log.LogError('Theme does not exist ('+ FileName +')', 'TTheme.LoadTheme'); - end; - - if FileExists(FileName) then - begin - Result := true; - - {$IFDEF THEMESAVE} - ThemeIni := TIniFile.Create(FileName); - {$ELSE} - ThemeIni := TMemIniFile.Create(FileName); - {$ENDIF} - - if ThemeIni.ReadString('Theme', 'Name', '') <> '' then - begin - - {Skin.SkinName := ThemeIni.ReadString('Theme', 'Name', 'Singstar'); - Skin.SkinPath := 'Skins\' + Skin.SkinName + '\'; - Skin.SkinReg := false; } - Skin.Color := sColor; - - Skin.LoadSkin(ISkin[Ini.SkinNo]); - - LoadColors; - -// ThemeIni.Free; -// ThemeIni := TIniFile.Create('Themes\Singstar\Main.ini'); - - // Loading - ThemeLoadBasic(Loading, 'Loading'); - ThemeLoadText(Loading.TextLoading, 'LoadingTextLoading'); - ThemeLoadStatic(Loading.StaticAnimation, 'LoadingStaticAnimation'); - - // Main - ThemeLoadBasic(Main, 'Main'); - - ThemeLoadText(Main.TextDescription, 'MainTextDescription'); - ThemeLoadText(Main.TextDescriptionLong, 'MainTextDescriptionLong'); - ThemeLoadButton(Main.ButtonSolo, 'MainButtonSolo'); - ThemeLoadButton(Main.ButtonMulti, 'MainButtonMulti'); - ThemeLoadButton(Main.ButtonStat, 'MainButtonStats'); - ThemeLoadButton(Main.ButtonEditor, 'MainButtonEditor'); - ThemeLoadButton(Main.ButtonOptions, 'MainButtonOptions'); - ThemeLoadButton(Main.ButtonExit, 'MainButtonExit'); - - //Main Desc Text Translation Start - - Main.Description[0] := Language.Translate('SING_SING'); - Main.DescriptionLong[0] := Language.Translate('SING_SING_DESC'); - Main.Description[1] := Language.Translate('SING_MULTI'); - Main.DescriptionLong[1] := Language.Translate('SING_MULTI_DESC'); - Main.Description[2] := Language.Translate('SING_STATS'); - Main.DescriptionLong[2] := Language.Translate('SING_STATS_DESC'); - Main.Description[3] := Language.Translate('SING_EDITOR'); - Main.DescriptionLong[3] := Language.Translate('SING_EDITOR_DESC'); - Main.Description[4] := Language.Translate('SING_GAME_OPTIONS'); - Main.DescriptionLong[4] := Language.Translate('SING_GAME_OPTIONS_DESC'); - Main.Description[5] := Language.Translate('SING_EXIT'); - Main.DescriptionLong[5] := Language.Translate('SING_EXIT_DESC'); - - //Main Desc Text Translation End - - Main.TextDescription.Text := Main.Description[0]; - Main.TextDescriptionLong.Text := Main.DescriptionLong[0]; - - // Name - ThemeLoadBasic(Name, 'Name'); - - for I := 1 to 6 do - ThemeLoadButton(Name.ButtonPlayer[I], 'NameButtonPlayer'+IntToStr(I)); - - // Level - ThemeLoadBasic(Level, 'Level'); - - ThemeLoadButton(Level.ButtonEasy, 'LevelButtonEasy'); - ThemeLoadButton(Level.ButtonMedium, 'LevelButtonMedium'); - ThemeLoadButton(Level.ButtonHard, 'LevelButtonHard'); - - - // Song - ThemeLoadBasic(Song, 'Song'); - - ThemeLoadText(Song.TextArtist, 'SongTextArtist'); - ThemeLoadText(Song.TextTitle, 'SongTextTitle'); - ThemeLoadText(Song.TextNumber, 'SongTextNumber'); - - //Video Icon Mod - ThemeLoadStatic(Song.VideoIcon, 'SongVideoIcon'); - - //Show Cat in TopLeft Mod - ThemeLoadStatic(Song.StaticCat, 'SongStaticCat'); - ThemeLoadText(Song.TextCat, 'SongTextCat'); - - //Load Cover Pos and Size from Theme Mod - Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 300); - Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 190); - Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 300); - Song.Cover.H := ThemeIni.ReadInteger('SongCover', 'H', 200); - Song.Cover.Style := ThemeIni.ReadInteger('SongCover', 'Style', 4); - Song.Cover.Reflections := (ThemeIni.ReadInteger('SongCover', 'Reflections', 0) = 1); - //Load Cover Pos and Size from Theme Mod End - - //Load Equalizer Pos and Size from Theme Mod - Song.Equalizer.Visible := (ThemeIni.ReadInteger('SongEqualizer', 'Visible', 0) = 1); - Song.Equalizer.Direction := (ThemeIni.ReadInteger('SongEqualizer', 'Direction', 0) = 1); - Song.Equalizer.Alpha := ThemeIni.ReadInteger('SongEqualizer', 'Alpha', 1); - Song.Equalizer.Space := ThemeIni.ReadInteger('SongEqualizer', 'Space', 1); - Song.Equalizer.X := ThemeIni.ReadInteger('SongEqualizer', 'X', 0); - Song.Equalizer.Y := ThemeIni.ReadInteger('SongEqualizer', 'Y', 0); - Song.Equalizer.Z := ThemeIni.ReadInteger('SongEqualizer', 'Z', 1); - Song.Equalizer.W := ThemeIni.ReadInteger('SongEqualizer', 'PieceW', 8); - Song.Equalizer.H := ThemeIni.ReadInteger('SongEqualizer', 'PieceH', 8); - Song.Equalizer.Bands := ThemeIni.ReadInteger('SongEqualizer', 'Bands', 5); - Song.Equalizer.Length := ThemeIni.ReadInteger('SongEqualizer', 'Length', 12); - - //Color - I := ColorExists(ThemeIni.ReadString('SongEqualizer', 'Color', 'Black')); - if I >= 0 then begin - Song.Equalizer.ColR := Color[I].RGB.R; - Song.Equalizer.ColG := Color[I].RGB.G; - Song.Equalizer.ColB := Color[I].RGB.B; - end - else begin - Song.Equalizer.ColR := 0; - Song.Equalizer.ColG := 0; - Song.Equalizer.ColB := 0; - end; - //Load Equalizer Pos and Size from Theme Mod End - - //Party and Non Party specific Statics and Texts - ThemeLoadStatics (Song.StaticParty, 'SongStaticParty'); - ThemeLoadTexts (Song.TextParty, 'SongTextParty'); - - ThemeLoadStatics (Song.StaticNonParty, 'SongStaticNonParty'); - ThemeLoadTexts (Song.TextNonParty, 'SongTextNonParty'); - - //Party Mode - ThemeLoadStatic(Song.StaticTeam1Joker1, 'SongStaticTeam1Joker1'); - ThemeLoadStatic(Song.StaticTeam1Joker2, 'SongStaticTeam1Joker2'); - ThemeLoadStatic(Song.StaticTeam1Joker3, 'SongStaticTeam1Joker3'); - ThemeLoadStatic(Song.StaticTeam1Joker4, 'SongStaticTeam1Joker4'); - ThemeLoadStatic(Song.StaticTeam1Joker5, 'SongStaticTeam1Joker5'); - - ThemeLoadStatic(Song.StaticTeam2Joker1, 'SongStaticTeam2Joker1'); - ThemeLoadStatic(Song.StaticTeam2Joker2, 'SongStaticTeam2Joker2'); - ThemeLoadStatic(Song.StaticTeam2Joker3, 'SongStaticTeam2Joker3'); - ThemeLoadStatic(Song.StaticTeam2Joker4, 'SongStaticTeam2Joker4'); - ThemeLoadStatic(Song.StaticTeam2Joker5, 'SongStaticTeam2Joker5'); - - ThemeLoadStatic(Song.StaticTeam3Joker1, 'SongStaticTeam3Joker1'); - ThemeLoadStatic(Song.StaticTeam3Joker2, 'SongStaticTeam3Joker2'); - ThemeLoadStatic(Song.StaticTeam3Joker3, 'SongStaticTeam3Joker3'); - ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4'); - ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5'); - - - // Sing - ThemeLoadBasic(Sing, 'Sing'); - - //TimeBar mod - ThemeLoadStatic(Sing.StaticTimeProgress, 'SingTimeProgress'); - ThemeLoadText(Sing.TextTimeText, 'SingTimeText'); - //eoa TimeBar mod - - //moveable singbar mod - ThemeLoadStatic(Sing.StaticP1SingBar, 'SingP1SingBar'); - ThemeLoadStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar'); - ThemeLoadStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar'); - ThemeLoadStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar'); - ThemeLoadStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar'); - ThemeLoadStatic(Sing.StaticP3SingBar, 'SingP3SingBar'); - //eoa moveable singbar - - ThemeLoadStatic(Sing.StaticP1, 'SingP1Static'); - ThemeLoadText(Sing.TextP1, 'SingP1Text'); - ThemeLoadStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); - ThemeLoadText(Sing.TextP1Score, 'SingP1TextScore'); - //Added for ps3 skin - //This one is shown in 2/4P mode - //if it exists, otherwise the one Player equivaltents are used - if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then - begin - ThemeLoadStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic'); - ThemeLoadText(Sing.TextP1TwoP, 'SingP1TwoPText'); - ThemeLoadStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2'); - ThemeLoadText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore'); - end - else - begin - Sing.StaticP1TwoP := Sing.StaticP1; - Sing.TextP1TwoP := Sing.TextP1; - Sing.StaticP1TwoPScoreBG := Sing.StaticP1ScoreBG; - Sing.TextP1TwoPScore := Sing.TextP1Score; - end; - - //This one is shown in 3/6P mode - //if it exists, otherwise the one Player equivaltents are used - if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then - begin - ThemeLoadStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic'); - ThemeLoadText(Sing.TextP1ThreeP, 'SingP1ThreePText'); - ThemeLoadStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2'); - ThemeLoadText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore'); - end - else - begin - Sing.StaticP1ThreeP := Sing.StaticP1; - Sing.TextP1ThreeP := Sing.TextP1; - Sing.StaticP1ThreePScoreBG := Sing.StaticP1ScoreBG; - Sing.TextP1ThreePScore := Sing.TextP1Score; - end; - //eoa - ThemeLoadStatic(Sing.StaticP2R, 'SingP2RStatic'); - ThemeLoadText(Sing.TextP2R, 'SingP2RText'); - ThemeLoadStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); - ThemeLoadText(Sing.TextP2RScore, 'SingP2RTextScore'); - - ThemeLoadStatic(Sing.StaticP2M, 'SingP2MStatic'); - ThemeLoadText(Sing.TextP2M, 'SingP2MText'); - ThemeLoadStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); - ThemeLoadText(Sing.TextP2MScore, 'SingP2MTextScore'); - - ThemeLoadStatic(Sing.StaticP3R, 'SingP3RStatic'); - ThemeLoadText(Sing.TextP3R, 'SingP3RText'); - ThemeLoadStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); - ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore'); - - //Line Bonus Texts - Sing.LineBonusText[0] := Language.Translate('POPUP_AWFUL'); - Sing.LineBonusText[1] := Sing.LineBonusText[0]; - Sing.LineBonusText[2] := Language.Translate('POPUP_POOR'); - Sing.LineBonusText[3] := Language.Translate('POPUP_BAD'); - Sing.LineBonusText[4] := Language.Translate('POPUP_NOTBAD'); - Sing.LineBonusText[5] := Language.Translate('POPUP_GOOD'); - Sing.LineBonusText[6] := Language.Translate('POPUP_GREAT'); - Sing.LineBonusText[7] := Language.Translate('POPUP_AWESOME'); - Sing.LineBonusText[8] := Language.Translate('POPUP_PERFECT'); - - //PausePopup - ThemeLoadStatic(Sing.PausePopUp, 'PausePopUpStatic'); - - // Score - ThemeLoadBasic(Score, 'Score'); - - ThemeLoadText(Score.TextArtist, 'ScoreTextArtist'); - ThemeLoadText(Score.TextTitle, 'ScoreTextTitle'); - ThemeLoadText(Score.TextArtistTitle, 'ScoreTextArtistTitle'); - - for I := 1 to 6 do begin - ThemeLoadStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); - ThemeLoadTexts(Score.PlayerTexts[I], 'ScorePlayer' + IntToStr(I) + 'Text'); - - ThemeLoadText(Score.TextName[I], 'ScoreTextName' + IntToStr(I)); - ThemeLoadText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I)); - ThemeLoadText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I)); - ThemeLoadText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I)); - ThemeLoadText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I)); - ThemeLoadText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I)); - ThemeLoadText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I)); - ThemeLoadText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I)); - ThemeLoadText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I)); - ThemeLoadText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I)); - - ThemeLoadStatic(Score.StaticBoxLightest[I], 'ScoreStaticBoxLightest' + IntToStr(I)); - ThemeLoadStatic(Score.StaticBoxLight[I], 'ScoreStaticBoxLight' + IntToStr(I)); - ThemeLoadStatic(Score.StaticBoxDark[I], 'ScoreStaticBoxDark' + IntToStr(I)); - - ThemeLoadStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I)); - ThemeLoadStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I)); - ThemeLoadStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I)); - ThemeLoadStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I)); - - ThemeLoadStatic(Score.StaticRatings[I], 'ScoreStaticRatingPicture' + IntToStr(I)); - end; - - // Top5 - ThemeLoadBasic(Top5, 'Top5'); - - ThemeLoadText(Top5.TextLevel, 'Top5TextLevel'); - ThemeLoadText(Top5.TextArtistTitle, 'Top5TextArtistTitle'); - ThemeLoadStatics(Top5.StaticNumber, 'Top5StaticNumber'); - ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber'); - ThemeLoadTexts(Top5.TextName, 'Top5TextName'); - ThemeLoadTexts(Top5.TextScore, 'Top5TextScore'); - - // Options - ThemeLoadBasic(Options, 'Options'); - - ThemeLoadButton(Options.ButtonGame, 'OptionsButtonGame'); - ThemeLoadButton(Options.ButtonGraphics, 'OptionsButtonGraphics'); - ThemeLoadButton(Options.ButtonSound, 'OptionsButtonSound'); - ThemeLoadButton(Options.ButtonLyrics, 'OptionsButtonLyrics'); - ThemeLoadButton(Options.ButtonThemes, 'OptionsButtonThemes'); - ThemeLoadButton(Options.ButtonRecord, 'OptionsButtonRecord'); - ThemeLoadButton(Options.ButtonAdvanced, 'OptionsButtonAdvanced'); - ThemeLoadButton(Options.ButtonExit, 'OptionsButtonExit'); - - Options.Description[0] := Language.Translate('SING_OPTIONS_GAME_DESC'); - Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS_DESC'); - Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND_DESC'); - Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS_DESC'); - Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES_DESC'); - Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD_DESC'); - Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED_DESC'); - Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT'); - - ThemeLoadText(Options.TextDescription, 'OptionsTextDescription'); - Options.TextDescription.Text := Options.Description[0]; - - // Options Game - ThemeLoadBasic(OptionsGame, 'OptionsGame'); - - ThemeLoadSelectSlide(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers'); - ThemeLoadSelectSlide(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty'); - ThemeLoadSelectSlide(OptionsGame.SelectLanguage, 'OptionsGameSelectSlideLanguage'); - ThemeLoadSelectSlide(OptionsGame.SelectTabs, 'OptionsGameSelectTabs'); - ThemeLoadSelectSlide(OptionsGame.SelectSorting, 'OptionsGameSelectSlideSorting'); - ThemeLoadSelectSlide(OptionsGame.SelectDebug, 'OptionsGameSelectDebug'); - ThemeLoadButton(OptionsGame.ButtonExit, 'OptionsGameButtonExit'); - - // Options Graphics - ThemeLoadBasic(OptionsGraphics, 'OptionsGraphics'); - - ThemeLoadSelectSlide(OptionsGraphics.SelectFullscreen, 'OptionsGraphicsSelectFullscreen'); - ThemeLoadSelectSlide(OptionsGraphics.SelectResolution, 'OptionsGraphicsSelectSlideResolution'); - ThemeLoadSelectSlide(OptionsGraphics.SelectDepth, 'OptionsGraphicsSelectDepth'); - ThemeLoadSelectSlide(OptionsGraphics.SelectVisualizer, 'OptionsGraphicsSelectVisualizer'); - ThemeLoadSelectSlide(OptionsGraphics.SelectOscilloscope, 'OptionsGraphicsSelectOscilloscope'); - ThemeLoadSelectSlide(OptionsGraphics.SelectLineBonus, 'OptionsGraphicsSelectLineBonus'); - ThemeLoadSelectSlide(OptionsGraphics.SelectMovieSize, 'OptionsGraphicsSelectMovieSize'); - ThemeLoadButton(OptionsGraphics.ButtonExit, 'OptionsGraphicsButtonExit'); - - // Options Sound - ThemeLoadBasic(OptionsSound, 'OptionsSound'); - - ThemeLoadSelectSlide(OptionsSound.SelectBackgroundMusic, 'OptionsSoundSelectBackgroundMusic'); - ThemeLoadSelectSlide(OptionsSound.SelectMicBoost, 'OptionsSoundSelectMicBoost'); - ThemeLoadSelectSlide(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist'); - ThemeLoadSelectSlide(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick'); - ThemeLoadSelectSlide(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold'); - //Song Preview - ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume'); - ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading'); - ThemeLoadSelectSlide(OptionsSound.SelectSlideVoicePassthrough, 'OptionsSoundSelectVoicePassthrough'); - - ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); - - // Options Lyrics - ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); - - ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); - ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); - //ThemeLoadSelectSlide(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); - ThemeLoadSelectSlide(OptionsLyrics.SelectNoteLines, 'OptionsLyricsSelectNoteLines'); - ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit'); - - // Options Themes - ThemeLoadBasic(OptionsThemes, 'OptionsThemes'); - - ThemeLoadSelectSlide(OptionsThemes.SelectTheme, 'OptionsThemesSelectTheme'); - ThemeLoadSelectSlide(OptionsThemes.SelectSkin, 'OptionsThemesSelectSkin'); - ThemeLoadSelectSlide(OptionsThemes.SelectColor, 'OptionsThemesSelectColor'); - ThemeLoadButton(OptionsThemes.ButtonExit, 'OptionsThemesButtonExit'); - - // Options Record - ThemeLoadBasic(OptionsRecord, 'OptionsRecord'); - - ThemeLoadSelectSlide(OptionsRecord.SelectSlideCard, 'OptionsRecordSelectSlideCard'); - ThemeLoadSelectSlide(OptionsRecord.SelectSlideInput, 'OptionsRecordSelectSlideInput'); - ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannel, 'OptionsRecordSelectSlideChannel'); - ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit'); - - //Options Advanced - ThemeLoadBasic(OptionsAdvanced, 'OptionsAdvanced'); - - ThemeLoadSelectSlide(OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectPartyPopup, 'OptionsAdvancedSelectPartyPopup'); - ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit'); - - //error and check popup - ThemeLoadBasic (ErrorPopup, 'ErrorPopup'); - ThemeLoadButton(ErrorPopup.Button1, 'ErrorPopupButton1'); - ThemeLoadText (ErrorPopup.TextError,'ErrorPopupText'); - ThemeLoadBasic (CheckPopup, 'CheckPopup'); - ThemeLoadButton(CheckPopup.Button1, 'CheckPopupButton1'); - ThemeLoadButton(CheckPopup.Button2, 'CheckPopupButton2'); - ThemeLoadText(CheckPopup.TextCheck , 'CheckPopupText'); - - //Song Menu - ThemeLoadBasic (SongMenu, 'SongMenu'); - ThemeLoadButton(SongMenu.Button1, 'SongMenuButton1'); - ThemeLoadButton(SongMenu.Button2, 'SongMenuButton2'); - ThemeLoadButton(SongMenu.Button3, 'SongMenuButton3'); - ThemeLoadButton(SongMenu.Button4, 'SongMenuButton4'); - ThemeLoadSelectSlide(SongMenu.SelectSlide3, 'SongMenuSelectSlide3'); - - ThemeLoadText(SongMenu.TextMenu, 'SongMenuTextMenu'); - - //Song Jumpto - ThemeLoadBasic (SongJumpto, 'SongJumpto'); - ThemeLoadButton(SongJumpto.ButtonSearchText, 'SongJumptoButtonSearchText'); - ThemeLoadSelectSlide(SongJumpto.SelectSlideType, 'SongJumptoSelectSlideType'); - ThemeLoadText(SongJumpto.TextFound, 'SongJumptoTextFound'); - //Translations - SongJumpto.IType[0] := Language.Translate('SONG_JUMPTO_TYPE1'); - SongJumpto.IType[1] := Language.Translate('SONG_JUMPTO_TYPE2'); - SongJumpto.IType[2] := Language.Translate('SONG_JUMPTO_TYPE3'); - SongJumpto.SongsFound := Language.Translate('SONG_JUMPTO_SONGSFOUND'); - SongJumpto.NoSongsFound := Language.Translate('SONG_JUMPTO_NOSONGSFOUND'); - SongJumpto.CatText := Language.Translate('SONG_JUMPTO_CATTEXT'); - - //Party Screens: - //Party NewRound - ThemeLoadBasic(PartyNewRound, 'PartyNewRound'); - - ThemeLoadText (PartyNewRound.TextRound1, 'PartyNewRoundTextRound1'); - ThemeLoadText (PartyNewRound.TextRound2, 'PartyNewRoundTextRound2'); - ThemeLoadText (PartyNewRound.TextRound3, 'PartyNewRoundTextRound3'); - ThemeLoadText (PartyNewRound.TextRound4, 'PartyNewRoundTextRound4'); - ThemeLoadText (PartyNewRound.TextRound5, 'PartyNewRoundTextRound5'); - ThemeLoadText (PartyNewRound.TextRound6, 'PartyNewRoundTextRound6'); - ThemeLoadText (PartyNewRound.TextRound7, 'PartyNewRoundTextRound7'); - ThemeLoadText (PartyNewRound.TextWinner1, 'PartyNewRoundTextWinner1'); - ThemeLoadText (PartyNewRound.TextWinner2, 'PartyNewRoundTextWinner2'); - ThemeLoadText (PartyNewRound.TextWinner3, 'PartyNewRoundTextWinner3'); - ThemeLoadText (PartyNewRound.TextWinner4, 'PartyNewRoundTextWinner4'); - ThemeLoadText (PartyNewRound.TextWinner5, 'PartyNewRoundTextWinner5'); - ThemeLoadText (PartyNewRound.TextWinner6, 'PartyNewRoundTextWinner6'); - ThemeLoadText (PartyNewRound.TextWinner7, 'PartyNewRoundTextWinner7'); - ThemeLoadText (PartyNewRound.TextNextRound, 'PartyNewRoundTextNextRound'); - ThemeLoadText (PartyNewRound.TextNextRoundNo, 'PartyNewRoundTextNextRoundNo'); - ThemeLoadText (PartyNewRound.TextNextPlayer1, 'PartyNewRoundTextNextPlayer1'); - ThemeLoadText (PartyNewRound.TextNextPlayer2, 'PartyNewRoundTextNextPlayer2'); - ThemeLoadText (PartyNewRound.TextNextPlayer3, 'PartyNewRoundTextNextPlayer3'); - - ThemeLoadStatic (PartyNewRound.StaticRound1, 'PartyNewRoundStaticRound1'); - ThemeLoadStatic (PartyNewRound.StaticRound2, 'PartyNewRoundStaticRound2'); - ThemeLoadStatic (PartyNewRound.StaticRound3, 'PartyNewRoundStaticRound3'); - ThemeLoadStatic (PartyNewRound.StaticRound4, 'PartyNewRoundStaticRound4'); - ThemeLoadStatic (PartyNewRound.StaticRound5, 'PartyNewRoundStaticRound5'); - ThemeLoadStatic (PartyNewRound.StaticRound6, 'PartyNewRoundStaticRound6'); - ThemeLoadStatic (PartyNewRound.StaticRound7, 'PartyNewRoundStaticRound7'); - - ThemeLoadText (PartyNewRound.TextScoreTeam1, 'PartyNewRoundTextScoreTeam1'); - ThemeLoadText (PartyNewRound.TextScoreTeam2, 'PartyNewRoundTextScoreTeam2'); - ThemeLoadText (PartyNewRound.TextScoreTeam3, 'PartyNewRoundTextScoreTeam3'); - ThemeLoadText (PartyNewRound.TextNameTeam1, 'PartyNewRoundTextNameTeam1'); - ThemeLoadText (PartyNewRound.TextNameTeam2, 'PartyNewRoundTextNameTeam2'); - ThemeLoadText (PartyNewRound.TextNameTeam3, 'PartyNewRoundTextNameTeam3'); - - ThemeLoadText (PartyNewRound.TextTeam1Players, 'PartyNewRoundTextTeam1Players'); - ThemeLoadText (PartyNewRound.TextTeam2Players, 'PartyNewRoundTextTeam2Players'); - ThemeLoadText (PartyNewRound.TextTeam3Players, 'PartyNewRoundTextTeam3Players'); - - ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1'); - ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2'); - ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3'); - ThemeLoadStatic (PartyNewRound.StaticNextPlayer1, 'PartyNewRoundStaticNextPlayer1'); - ThemeLoadStatic (PartyNewRound.StaticNextPlayer2, 'PartyNewRoundStaticNextPlayer2'); - ThemeLoadStatic (PartyNewRound.StaticNextPlayer3, 'PartyNewRoundStaticNextPlayer3'); - - //Party Score - ThemeLoadBasic(PartyScore, 'PartyScore'); - - ThemeLoadText (PartyScore.TextScoreTeam1, 'PartyScoreTextScoreTeam1'); - ThemeLoadText (PartyScore.TextScoreTeam2, 'PartyScoreTextScoreTeam2'); - ThemeLoadText (PartyScore.TextScoreTeam3, 'PartyScoreTextScoreTeam3'); - ThemeLoadText (PartyScore.TextNameTeam1, 'PartyScoreTextNameTeam1'); - ThemeLoadText (PartyScore.TextNameTeam2, 'PartyScoreTextNameTeam2'); - ThemeLoadText (PartyScore.TextNameTeam3, 'PartyScoreTextNameTeam3'); - - ThemeLoadStatic (PartyScore.StaticTeam1, 'PartyScoreStaticTeam1'); - ThemeLoadStatic (PartyScore.StaticTeam1BG, 'PartyScoreStaticTeam1BG'); - ThemeLoadStatic (PartyScore.StaticTeam1Deco, 'PartyScoreStaticTeam1Deco'); - ThemeLoadStatic (PartyScore.StaticTeam2, 'PartyScoreStaticTeam2'); - ThemeLoadStatic (PartyScore.StaticTeam2BG, 'PartyScoreStaticTeam2BG'); - ThemeLoadStatic (PartyScore.StaticTeam2Deco, 'PartyScoreStaticTeam2Deco'); - ThemeLoadStatic (PartyScore.StaticTeam3, 'PartyScoreStaticTeam3'); - ThemeLoadStatic (PartyScore.StaticTeam3BG, 'PartyScoreStaticTeam3BG'); - ThemeLoadStatic (PartyScore.StaticTeam3Deco, 'PartyScoreStaticTeam3Deco'); - - //Load Party Score DecoTextures Object - PartyScore.DecoTextures.ChangeTextures := (ThemeIni.ReadInteger('PartyScoreDecoTextures', 'ChangeTextures', 0) = 1); - PartyScore.DecoTextures.FirstTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTexture', ''); - PartyScore.DecoTextures.FirstTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', ''), TEXTURE_TYPE_COLORIZED); - PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black'); - - PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', ''); - PartyScore.DecoTextures.SecondTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', ''), TEXTURE_TYPE_COLORIZED); - PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black'); - - PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', ''); - PartyScore.DecoTextures.ThirdTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', ''), TEXTURE_TYPE_COLORIZED); - PartyScore.DecoTextures.ThirdColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdColor', 'Black'); - - ThemeLoadText (PartyScore.TextWinner, 'PartyScoreTextWinner'); - - //Party Win - ThemeLoadBasic(PartyWin, 'PartyWin'); - - ThemeLoadText (PartyWin.TextScoreTeam1, 'PartyWinTextScoreTeam1'); - ThemeLoadText (PartyWin.TextScoreTeam2, 'PartyWinTextScoreTeam2'); - ThemeLoadText (PartyWin.TextScoreTeam3, 'PartyWinTextScoreTeam3'); - ThemeLoadText (PartyWin.TextNameTeam1, 'PartyWinTextNameTeam1'); - ThemeLoadText (PartyWin.TextNameTeam2, 'PartyWinTextNameTeam2'); - ThemeLoadText (PartyWin.TextNameTeam3, 'PartyWinTextNameTeam3'); - - ThemeLoadStatic (PartyWin.StaticTeam1, 'PartyWinStaticTeam1'); - ThemeLoadStatic (PartyWin.StaticTeam1BG, 'PartyWinStaticTeam1BG'); - ThemeLoadStatic (PartyWin.StaticTeam1Deco, 'PartyWinStaticTeam1Deco'); - ThemeLoadStatic (PartyWin.StaticTeam2, 'PartyWinStaticTeam2'); - ThemeLoadStatic (PartyWin.StaticTeam2BG, 'PartyWinStaticTeam2BG'); - ThemeLoadStatic (PartyWin.StaticTeam2Deco, 'PartyWinStaticTeam2Deco'); - ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3'); - ThemeLoadStatic (PartyWin.StaticTeam3BG, 'PartyWinStaticTeam3BG'); - ThemeLoadStatic (PartyWin.StaticTeam3Deco, 'PartyWinStaticTeam3Deco'); - - ThemeLoadText (PartyWin.TextWinner, 'PartyWinTextWinner'); - - //Party Options - ThemeLoadBasic(PartyOptions, 'PartyOptions'); - ThemeLoadSelectSlide(PartyOptions.SelectLevel, 'PartyOptionsSelectLevel'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayList, 'PartyOptionsSelectPlayList'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayList2, 'PartyOptionsSelectPlayList2'); - ThemeLoadSelectSlide(PartyOptions.SelectRounds, 'PartyOptionsSelectRounds'); - ThemeLoadSelectSlide(PartyOptions.SelectTeams, 'PartyOptionsSelectTeams'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayers1, 'PartyOptionsSelectPlayers1'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayers2, 'PartyOptionsSelectPlayers2'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayers3, 'PartyOptionsSelectPlayers3'); - - {ThemeLoadButton (ButtonNext, 'ButtonNext'); - ThemeLoadButton (ButtonPrev, 'ButtonPrev');} - - //Party Player - ThemeLoadBasic(PartyPlayer, 'PartyPlayer'); - ThemeLoadButton(PartyPlayer.Team1Name, 'PartyPlayerTeam1Name'); - ThemeLoadButton(PartyPlayer.Player1Name, 'PartyPlayerPlayer1Name'); - ThemeLoadButton(PartyPlayer.Player2Name, 'PartyPlayerPlayer2Name'); - ThemeLoadButton(PartyPlayer.Player3Name, 'PartyPlayerPlayer3Name'); - ThemeLoadButton(PartyPlayer.Player4Name, 'PartyPlayerPlayer4Name'); - - ThemeLoadButton(PartyPlayer.Team2Name, 'PartyPlayerTeam2Name'); - ThemeLoadButton(PartyPlayer.Player5Name, 'PartyPlayerPlayer5Name'); - ThemeLoadButton(PartyPlayer.Player6Name, 'PartyPlayerPlayer6Name'); - ThemeLoadButton(PartyPlayer.Player7Name, 'PartyPlayerPlayer7Name'); - ThemeLoadButton(PartyPlayer.Player8Name, 'PartyPlayerPlayer8Name'); - - ThemeLoadButton(PartyPlayer.Team3Name, 'PartyPlayerTeam3Name'); - ThemeLoadButton(PartyPlayer.Player9Name, 'PartyPlayerPlayer9Name'); - ThemeLoadButton(PartyPlayer.Player10Name, 'PartyPlayerPlayer10Name'); - ThemeLoadButton(PartyPlayer.Player11Name, 'PartyPlayerPlayer11Name'); - ThemeLoadButton(PartyPlayer.Player12Name, 'PartyPlayerPlayer12Name'); - - {ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext'); - ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');} - - ThemeLoadBasic(StatMain, 'StatMain'); - - ThemeLoadButton(StatMain.ButtonScores, 'StatMainButtonScores'); - ThemeLoadButton(StatMain.ButtonSingers, 'StatMainButtonSingers'); - ThemeLoadButton(StatMain.ButtonSongs, 'StatMainButtonSongs'); - ThemeLoadButton(StatMain.ButtonBands, 'StatMainButtonBands'); - ThemeLoadButton(StatMain.ButtonExit, 'StatMainButtonExit'); - - ThemeLoadText (StatMain.TextOverview, 'StatMainTextOverview'); - - - ThemeLoadBasic(StatDetail, 'StatDetail'); - - ThemeLoadButton(StatDetail.ButtonNext, 'StatDetailButtonNext'); - ThemeLoadButton(StatDetail.ButtonPrev, 'StatDetailButtonPrev'); - ThemeLoadButton(StatDetail.ButtonReverse, 'StatDetailButtonReverse'); - ThemeLoadButton(StatDetail.ButtonExit, 'StatDetailButtonExit'); - - ThemeLoadText (StatDetail.TextDescription, 'StatDetailTextDescription'); - ThemeLoadText (StatDetail.TextPage, 'StatDetailTextPage'); - ThemeLoadTexts(StatDetail.TextList, 'StatDetailTextList'); - - //Translate Texts - StatDetail.Description[0] := Language.Translate('STAT_DESC_SCORES'); - StatDetail.Description[1] := Language.Translate('STAT_DESC_SINGERS'); - StatDetail.Description[2] := Language.Translate('STAT_DESC_SONGS'); - StatDetail.Description[3] := Language.Translate('STAT_DESC_BANDS'); - - StatDetail.DescriptionR[0] := Language.Translate('STAT_DESC_SCORES_REVERSED'); - StatDetail.DescriptionR[1] := Language.Translate('STAT_DESC_SINGERS_REVERSED'); - StatDetail.DescriptionR[2] := Language.Translate('STAT_DESC_SONGS_REVERSED'); - StatDetail.DescriptionR[3] := Language.Translate('STAT_DESC_BANDS_REVERSED'); - - StatDetail.FormatStr[0] := Language.Translate('STAT_FORMAT_SCORES'); - StatDetail.FormatStr[1] := Language.Translate('STAT_FORMAT_SINGERS'); - StatDetail.FormatStr[2] := Language.Translate('STAT_FORMAT_SONGS'); - StatDetail.FormatStr[3] := Language.Translate('STAT_FORMAT_BANDS'); - - StatDetail.PageStr := Language.Translate('STAT_PAGE'); - - //Playlist Translations - Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT'); - - //Level Translations - //Fill ILevel - ILevel[0] := Language.Translate('SING_EASY'); - ILevel[1] := Language.Translate('SING_MEDIUM'); - ILevel[2] := Language.Translate('SING_HARD'); - end; - - ThemeIni.Free; - end; -end; - -procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; Name: string); -begin - ThemeLoadBackground(Theme.Background, Name); - ThemeLoadTexts(Theme.Text, Name + 'Text'); - ThemeLoadStatics(Theme.Static, Name + 'Static'); - ThemeLoadButtonCollections(Theme.ButtonCollection, Name + 'ButtonCollection'); - - LastThemeBasic := Theme; -end; - -procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string); -begin - ThemeBackground.Tex := ThemeIni.ReadString(Name + 'Background', 'Tex', ''); -end; - -procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; Name: string); -var - C: integer; -begin - ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0); - ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeText.W := ThemeIni.ReadInteger(Name, 'W', 0); - - ThemeText.Z := ThemeIni.ReadFloat(Name, 'Z', 0); - - ThemeText.ColR := ThemeIni.ReadFloat(Name, 'ColR', 0); - ThemeText.ColG := ThemeIni.ReadFloat(Name, 'ColG', 0); - ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0); - - ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0); - ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0); - ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0); - - ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - ThemeText.Color := ThemeIni.ReadString(Name, 'Color', ''); - - //Reflection - ThemeText.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0)) = 1; - ThemeText.Reflectionspacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); - - C := ColorExists(ThemeText.Color); - if C >= 0 then begin - ThemeText.ColR := Color[C].RGB.R; - ThemeText.ColG := Color[C].RGB.G; - ThemeText.ColB := Color[C].RGB.B; - end; -end; - -procedure TTheme.ThemeLoadTexts(var ThemeText: AThemeText; Name: string); -var - T: integer; -begin - T := 1; - while ThemeIni.SectionExists(Name + IntToStr(T)) do begin - SetLength(ThemeText, T); - ThemeLoadText(ThemeText[T-1], Name + IntToStr(T)); - Inc(T); - end; -end; - -procedure TTheme.ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string); -var - C: integer; -begin - ThemeStatic.Tex := ThemeIni.ReadString(Name, 'Tex', ''); - - ThemeStatic.X := ThemeIni.ReadInteger(Name, 'X', 0); - ThemeStatic.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeStatic.Z := ThemeIni.ReadFloat (Name, 'Z', 0); - ThemeStatic.W := ThemeIni.ReadInteger(Name, 'W', 0); - ThemeStatic.H := ThemeIni.ReadInteger(Name, 'H', 0); - - ThemeStatic.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN); - ThemeStatic.Color := ThemeIni.ReadString(Name, 'Color', ''); - - C := ColorExists(ThemeStatic.Color); - if C >= 0 then begin - ThemeStatic.ColR := Color[C].RGB.R; - ThemeStatic.ColG := Color[C].RGB.G; - ThemeStatic.ColB := Color[C].RGB.B; - end; - - ThemeStatic.TexX1 := ThemeIni.ReadFloat(Name, 'TexX1', 0); - ThemeStatic.TexY1 := ThemeIni.ReadFloat(Name, 'TexY1', 0); - ThemeStatic.TexX2 := ThemeIni.ReadFloat(Name, 'TexX2', 1); - ThemeStatic.TexY2 := ThemeIni.ReadFloat(Name, 'TexY2', 1); - - //Reflection Mod - ThemeStatic.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); - ThemeStatic.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); -end; - -procedure TTheme.ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string); -var - S: integer; -begin - S := 1; - while ThemeIni.SectionExists(Name + IntToStr(S)) do begin - SetLength(ThemeStatic, S); - ThemeLoadStatic(ThemeStatic[S-1], Name + IntToStr(S)); - Inc(S); - end; -end; - -//Button Collection Mod -procedure TTheme.ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string); -var T: Integer; -begin - //Load Collection Style - ThemeLoadButton(Collection.Style, Name); - - //Load Other Attributes - T := ThemeIni.ReadInteger (Name, 'FirstChild', 0); - if (T > 0) And (T < 256) then - Collection.FirstChild := T - else - Collection.FirstChild := 0; -end; - -procedure TTheme.ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string); -var - I: integer; -begin - I := 1; - while ThemeIni.SectionExists(Name + IntToStr(I)) do begin - SetLength(Collections, I); - ThemeLoadButtonCollection(Collections[I-1], Name + IntToStr(I)); - Inc(I); - end; -end; -//End Button Collection Mod - -procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection); -var - C: integer; - TLen: integer; - T: integer; - Collections2: PAThemeButtonCollection; -begin - if not ThemeIni.SectionExists(Name) then - begin - ThemeButton.Visible := False; - exit; - end; - ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', ''); - ThemeButton.X := ThemeIni.ReadInteger (Name, 'X', 0); - ThemeButton.Y := ThemeIni.ReadInteger (Name, 'Y', 0); - ThemeButton.Z := ThemeIni.ReadFloat (Name, 'Z', 0); - ThemeButton.W := ThemeIni.ReadInteger (Name, 'W', 0); - ThemeButton.H := ThemeIni.ReadInteger (Name, 'H', 0); - ThemeButton.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN); - - //Reflection Mod - ThemeButton.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); - ThemeButton.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); - - ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1); - ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1); - ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1); - ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1); - ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1); - ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1); - ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1); - ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); - - ThemeButton.Color := ThemeIni.ReadString(Name, 'Color', ''); - C := ColorExists(ThemeButton.Color); - if C >= 0 then begin - ThemeButton.ColR := Color[C].RGB.R; - ThemeButton.ColG := Color[C].RGB.G; - ThemeButton.ColB := Color[C].RGB.B; - end; - - ThemeButton.DColor := ThemeIni.ReadString(Name, 'DColor', ''); - C := ColorExists(ThemeButton.DColor); - if C >= 0 then begin - ThemeButton.DColR := Color[C].RGB.R; - ThemeButton.DColG := Color[C].RGB.G; - ThemeButton.DColB := Color[C].RGB.B; - end; - - ThemeButton.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 1) = 1); - - //Fade Mod - ThemeButton.SelectH := ThemeIni.ReadInteger (Name, 'SelectH', ThemeButton.H); - ThemeButton.SelectW := ThemeIni.ReadInteger (Name, 'SelectW', ThemeButton.W); - - ThemeButton.DeSelectReflectionspacing := ThemeIni.ReadFloat(Name, 'DeSelectReflectionSpacing', ThemeButton.Reflectionspacing); - - ThemeButton.Fade := (ThemeIni.ReadInteger(Name, 'Fade', 0) = 1); - ThemeButton.FadeText := (ThemeIni.ReadInteger(Name, 'FadeText', 0) = 1); - - - ThemeButton.FadeTex := ThemeIni.ReadString(Name, 'FadeTex', ''); - ThemeButton.FadeTexPos:= ThemeIni.ReadInteger(Name, 'FadeTexPos', 0); - if (ThemeButton.FadeTexPos > 4) Or (ThemeButton.FadeTexPos < 0) then - ThemeButton.FadeTexPos := 0; - - //Button Collection Mod - T := ThemeIni.ReadInteger(Name, 'Parent', 0); - - //Set Collections to Last Basic Collections if no valid Value - if (Collections = nil) then - Collections2 := @LastThemeBasic.ButtonCollection - else - Collections2 := Collections; - //Test for valid Value - if (Collections2 <> nil) AND (T > 0) AND (T <= Length(Collections2^)) then - begin - Inc(Collections2^[T-1].ChildCount); - ThemeButton.Parent := T; - end - else - ThemeButton.Parent := 0; - - //Read ButtonTexts - TLen := ThemeIni.ReadInteger(Name, 'Texts', 0); - SetLength(ThemeButton.Text, TLen); - for T := 1 to TLen do - ThemeLoadText(ThemeButton.Text[T-1], Name + 'Text' + IntToStr(T)); -end; - -procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); -var - C: integer; -begin - ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - - ThemeSelectS.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', ''); - ThemeSelectS.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', ''); - - ThemeSelectS.X := ThemeIni.ReadInteger(Name, 'X', 0); - ThemeSelectS.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeSelectS.W := ThemeIni.ReadInteger(Name, 'W', 0); - ThemeSelectS.H := ThemeIni.ReadInteger(Name, 'H', 0); - - ThemeSelectS.Z := ThemeIni.ReadFloat(Name, 'Z', 0); - - ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 10); - - ThemeSelectS.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); - - ThemeSelectS.SBGW := ThemeIni.ReadInteger(Name, 'SBGW', 450); - - LoadColor(ThemeSelectS.ColR, ThemeSelectS.ColG, ThemeSelectS.ColB, ThemeIni.ReadString(Name, 'Color', '')); - ThemeSelectS.Int := ThemeIni.ReadFloat(Name, 'Int', 1); - LoadColor(ThemeSelectS.DColR, ThemeSelectS.DColG, ThemeSelectS.DColB, ThemeIni.ReadString(Name, 'DColor', '')); - ThemeSelectS.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); - - LoadColor(ThemeSelectS.TColR, ThemeSelectS.TColG, ThemeSelectS.TColB, ThemeIni.ReadString(Name, 'TColor', '')); - ThemeSelectS.TInt := ThemeIni.ReadFloat(Name, 'TInt', 1); - LoadColor(ThemeSelectS.TDColR, ThemeSelectS.TDColG, ThemeSelectS.TDColB, ThemeIni.ReadString(Name, 'TDColor', '')); - ThemeSelectS.TDInt := ThemeIni.ReadFloat(Name, 'TDInt', 1); - - LoadColor(ThemeSelectS.SBGColR, ThemeSelectS.SBGColG, ThemeSelectS.SBGColB, ThemeIni.ReadString(Name, 'SBGColor', '')); - ThemeSelectS.SBGInt := ThemeIni.ReadFloat(Name, 'SBGInt', 1); - LoadColor(ThemeSelectS.SBGDColR, ThemeSelectS.SBGDColG, ThemeSelectS.SBGDColB, ThemeIni.ReadString(Name, 'SBGDColor', '')); - ThemeSelectS.SBGDInt := ThemeIni.ReadFloat(Name, 'SBGDInt', 1); - - LoadColor(ThemeSelectS.STColR, ThemeSelectS.STColG, ThemeSelectS.STColB, ThemeIni.ReadString(Name, 'STColor', '')); - ThemeSelectS.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1); - LoadColor(ThemeSelectS.STDColR, ThemeSelectS.STDColG, ThemeSelectS.STDColB, ThemeIni.ReadString(Name, 'STDColor', '')); - ThemeSelectS.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1); -end; - -procedure TTheme.LoadColors; -var - SL: TStringList; - C: integer; - S: string; - Col: integer; - RGB: TRGB; -begin - SL := TStringList.Create; - ThemeIni.ReadSection('Colors', SL); - - // normal colors - SetLength(Color, SL.Count); - for C := 0 to SL.Count-1 do begin - Color[C].Name := SL.Strings[C]; - - S := ThemeIni.ReadString('Colors', SL.Strings[C], ''); - - Color[C].RGB.R := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255; - Delete(S, 1, Pos(' ', S)); - - Color[C].RGB.G := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255; - Delete(S, 1, Pos(' ', S)); - - Color[C].RGB.B := StrToInt(S)/255; - end; - - // skin color - SetLength(Color, SL.Count + 3); - C := SL.Count; - Color[C].Name := 'ColorDark'; - Color[C].RGB := GetSystemColor(Skin.Color); //Ini.Color); - - C := C+1; - Color[C].Name := 'ColorLight'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'ColorLightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // players colors - SetLength(Color, Length(Color)+18); - - // P1 - C := C+1; - Color[C].Name := 'P1Dark'; - Color[C].RGB := GetSystemColor(0); // 0 - blue - - C := C+1; - Color[C].Name := 'P1Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P1Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // P2 - C := C+1; - Color[C].Name := 'P2Dark'; - Color[C].RGB := GetSystemColor(3); // 3 - red - - C := C+1; - Color[C].Name := 'P2Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P2Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // P3 - C := C+1; - Color[C].Name := 'P3Dark'; - Color[C].RGB := GetSystemColor(1); // 1 - green - - C := C+1; - Color[C].Name := 'P3Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P3Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // P4 - C := C+1; - Color[C].Name := 'P4Dark'; - Color[C].RGB := GetSystemColor(4); // 4 - brown - - C := C+1; - Color[C].Name := 'P4Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P4Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // P5 - C := C+1; - Color[C].Name := 'P5Dark'; - Color[C].RGB := GetSystemColor(5); // 5 - yellow - - C := C+1; - Color[C].Name := 'P5Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P5Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // P6 - C := C+1; - Color[C].Name := 'P6Dark'; - Color[C].RGB := GetSystemColor(6); // 6 - violet - - C := C+1; - Color[C].Name := 'P6Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P6Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - - SL.Free; -end; - -function ColorExists(Name: string): integer; -var - C: integer; -begin - Result := -1; - for C := 0 to High(Color) do - if Color[C].Name = Name then Result := C; -end; - -procedure LoadColor(var R, G, B: real; ColorName: string); -var - C: integer; -begin - C := ColorExists(ColorName); - if C >= 0 then begin - R := Color[C].RGB.R; - G := Color[C].RGB.G; - B := Color[C].RGB.B; - end; -end; - -function GetSystemColor(Color: integer): TRGB; -begin - case Color of - 0: begin - // blue - Result.R := 71/255; - Result.G := 175/255; - Result.B := 247/255; - end; - 1: begin - // green - Result.R := 63/255; - Result.G := 191/255; - Result.B := 63/255; - end; - 2: begin - // pink - Result.R := 255/255; -{ Result.G := 63/255; - Result.B := 192/255;} - Result.G := 175/255; - Result.B := 247/255; - end; - 3: begin - // red - Result.R := 247/255; - Result.G := 71/255; - Result.B := 71/255; - end; - //'Violet', 'Orange', 'Yellow', 'Brown', 'Black' - //New Theme-Color Patch - 4: begin - // violet - Result.R := 230/255; - Result.G := 63/255; - Result.B := 230/255; - end; - 5: begin - // orange - Result.R := 255/255; - Result.G := 144/255; - Result.B := 0; - end; - 6: begin - // yellow - Result.R := 230/255; - Result.G := 230/255; - Result.B := 95/255; - end; - 7: begin - // brown - Result.R := 192/255; - Result.G := 127/255; - Result.B := 31/255; - end; - 8: begin - // black - Result.R := 0; - Result.G := 0; - Result.B := 0; - end; - //New Theme-Color Patch End - - end; -end; - -function ColorSqrt(RGB: TRGB): TRGB; -begin - Result.R := sqrt(RGB.R); - Result.G := sqrt(RGB.G); - Result.B := sqrt(RGB.B); -end; - -procedure TTheme.ThemeSave(FileName: string); -var - I: integer; -begin - {$IFDEF THEMESAVE} - ThemeIni := TIniFile.Create(FileName); - {$ELSE} - ThemeIni := TMemIniFile.Create(FileName); - {$ENDIF} - - ThemeSaveBasic(Loading, 'Loading'); - - ThemeSaveBasic(Main, 'Main'); - ThemeSaveText(Main.TextDescription, 'MainTextDescription'); - ThemeSaveText(Main.TextDescriptionLong, 'MainTextDescriptionLong'); - ThemeSaveButton(Main.ButtonSolo, 'MainButtonSolo'); - ThemeSaveButton(Main.ButtonEditor, 'MainButtonEditor'); - ThemeSaveButton(Main.ButtonOptions, 'MainButtonOptions'); - ThemeSaveButton(Main.ButtonExit, 'MainButtonExit'); - - ThemeSaveBasic(Name, 'Name'); - for I := 1 to 6 do - ThemeSaveButton(Name.ButtonPlayer[I], 'NameButtonPlayer' + IntToStr(I)); - - ThemeSaveBasic(Level, 'Level'); - ThemeSaveButton(Level.ButtonEasy, 'LevelButtonEasy'); - ThemeSaveButton(Level.ButtonMedium, 'LevelButtonMedium'); - ThemeSaveButton(Level.ButtonHard, 'LevelButtonHard'); - - ThemeSaveBasic(Song, 'Song'); - ThemeSaveText(Song.TextArtist, 'SongTextArtist'); - ThemeSaveText(Song.TextTitle, 'SongTextTitle'); - ThemeSaveText(Song.TextNumber, 'SongTextNumber'); - - //Show CAt in Top Left Mod - ThemeSaveText(Song.TextCat, 'SongTextCat'); - ThemeSaveStatic(Song.StaticCat, 'SongStaticCat'); - - ThemeSaveBasic(Sing, 'Sing'); - - //TimeBar mod - ThemeSaveStatic(Sing.StaticTimeProgress, 'SingTimeProgress'); - ThemeSaveText(Sing.TextTimeText, 'SingTimeText'); - //eoa TimeBar mod - - ThemeSaveStatic(Sing.StaticP1, 'SingP1Static'); - ThemeSaveText(Sing.TextP1, 'SingP1Text'); - ThemeSaveStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); - ThemeSaveText(Sing.TextP1Score, 'SingP1TextScore'); - - //moveable singbar mod - ThemeSaveStatic(Sing.StaticP1SingBar, 'SingP1SingBar'); - ThemeSaveStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar'); - ThemeSaveStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar'); - ThemeSaveStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar'); - ThemeSaveStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar'); - ThemeSaveStatic(Sing.StaticP3SingBar, 'SingP3SingBar'); - //eoa moveable singbar - - //Added for ps3 skin - //This one is shown in 2/4P mode - ThemeSaveStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic'); - ThemeSaveText(Sing.TextP1TwoP, 'SingP1TwoPText'); - ThemeSaveStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2'); - ThemeSaveText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore'); - - //This one is shown in 3/6P mode - ThemeSaveStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic'); - ThemeSaveText(Sing.TextP1ThreeP, 'SingP1ThreePText'); - ThemeSaveStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2'); - ThemeSaveText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore'); - //eoa - - ThemeSaveStatic(Sing.StaticP2R, 'SingP2RStatic'); - ThemeSaveText(Sing.TextP2R, 'SingP2RText'); - ThemeSaveStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); - ThemeSaveText(Sing.TextP2RScore, 'SingP2RTextScore'); - - ThemeSaveStatic(Sing.StaticP2M, 'SingP2MStatic'); - ThemeSaveText(Sing.TextP2M, 'SingP2MText'); - ThemeSaveStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); - ThemeSaveText(Sing.TextP2MScore, 'SingP2MTextScore'); - - ThemeSaveStatic(Sing.StaticP3R, 'SingP3RStatic'); - ThemeSaveText(Sing.TextP3R, 'SingP3RText'); - ThemeSaveStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); - ThemeSaveText(Sing.TextP3RScore, 'SingP3RTextScore'); - - ThemeSaveBasic(Score, 'Score'); - ThemeSaveText(Score.TextArtist, 'ScoreTextArtist'); - ThemeSaveText(Score.TextTitle, 'ScoreTextTitle'); - - for I := 1 to 6 do begin - ThemeSaveStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); - - ThemeSaveText(Score.TextName[I], 'ScoreTextName' + IntToStr(I)); - ThemeSaveText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I)); - ThemeSaveText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I)); - ThemeSaveText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I)); - ThemeSaveText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I)); - ThemeSaveText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I)); - ThemeSaveText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I)); - ThemeSaveText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I)); - ThemeSaveText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I)); - ThemeSaveText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I)); - - ThemeSaveStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I)); - ThemeSaveStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I)); - ThemeSaveStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I)); - ThemeSaveStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I)); - end; - - ThemeSaveBasic(Top5, 'Top5'); - ThemeSaveText(Top5.TextLevel, 'Top5TextLevel'); - ThemeSaveText(Top5.TextArtistTitle, 'Top5TextArtistTitle'); - ThemeSaveStatics(Top5.StaticNumber, 'Top5StaticNumber'); - ThemeSaveTexts(Top5.TextNumber, 'Top5TextNumber'); - ThemeSaveTexts(Top5.TextName, 'Top5TextName'); - ThemeSaveTexts(Top5.TextScore, 'Top5TextScore'); - - - ThemeIni.Free; -end; - -procedure TTheme.ThemeSaveBasic(Theme: TThemeBasic; Name: string); -begin - ThemeIni.WriteInteger(Name, 'Texts', Length(Theme.Text)); - - ThemeSaveBackground(Theme.Background, Name + 'Background'); - ThemeSaveStatics(Theme.Static, Name + 'Static'); - ThemeSaveTexts(Theme.Text, Name + 'Text'); -end; - -procedure TTheme.ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string); -begin - if ThemeBackground.Tex <> '' then - ThemeIni.WriteString(Name, 'Tex', ThemeBackground.Tex) - else begin - ThemeIni.EraseSection(Name); - end; -end; - -procedure TTheme.ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string); -begin - ThemeIni.WriteInteger(Name, 'X', ThemeStatic.X); - ThemeIni.WriteInteger(Name, 'Y', ThemeStatic.Y); - ThemeIni.WriteInteger(Name, 'W', ThemeStatic.W); - ThemeIni.WriteInteger(Name, 'H', ThemeStatic.H); - - ThemeIni.WriteString(Name, 'Tex', ThemeStatic.Tex); - ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeStatic.Typ)); - ThemeIni.WriteString(Name, 'Color', ThemeStatic.Color); - - ThemeIni.WriteFloat(Name, 'TexX1', ThemeStatic.TexX1); - ThemeIni.WriteFloat(Name, 'TexY1', ThemeStatic.TexY1); - ThemeIni.WriteFloat(Name, 'TexX2', ThemeStatic.TexX2); - ThemeIni.WriteFloat(Name, 'TexY2', ThemeStatic.TexY2); -end; - -procedure TTheme.ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string); -var - S: integer; -begin - for S := 0 to Length(ThemeStatic)-1 do - ThemeSaveStatic(ThemeStatic[S], Name + {'Static' +} IntToStr(S+1)); - - ThemeIni.EraseSection(Name + {'Static' + }IntToStr(S+1)); -end; - -procedure TTheme.ThemeSaveText(ThemeText: TThemeText; Name: string); -begin - ThemeIni.WriteInteger(Name, 'X', ThemeText.X); - ThemeIni.WriteInteger(Name, 'Y', ThemeText.Y); - - ThemeIni.WriteInteger(Name, 'Font', ThemeText.Font); - ThemeIni.WriteInteger(Name, 'Size', ThemeText.Size); - ThemeIni.WriteInteger(Name, 'Align', ThemeText.Align); - - ThemeIni.WriteString(Name, 'Text', ThemeText.Text); - ThemeIni.WriteString(Name, 'Color', ThemeText.Color); - - ThemeIni.WriteBool(Name, 'Reflection', ThemeText.Reflection); - ThemeIni.WriteFloat(Name, 'ReflectionSpacing', ThemeText.ReflectionSpacing); -end; - -procedure TTheme.ThemeSaveTexts(ThemeText: AThemeText; Name: string); -var - T: integer; -begin - for T := 0 to Length(ThemeText)-1 do - ThemeSaveText(ThemeText[T], Name + {'Text' + }IntToStr(T+1)); - - ThemeIni.EraseSection(Name + {'Text' + }IntToStr(T+1)); -end; - -procedure TTheme.ThemeSaveButton(ThemeButton: TThemeButton; Name: string); -var - T: integer; -begin - ThemeIni.WriteString(Name, 'Tex', ThemeButton.Tex); - ThemeIni.WriteInteger(Name, 'X', ThemeButton.X); - ThemeIni.WriteInteger(Name, 'Y', ThemeButton.Y); - ThemeIni.WriteInteger(Name, 'W', ThemeButton.W); - ThemeIni.WriteInteger(Name, 'H', ThemeButton.H); - ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeButton.Typ)); - ThemeIni.WriteInteger(Name, 'Texts', Length(ThemeButton.Text)); - - ThemeIni.WriteString(Name, 'Color', ThemeButton.Color); - -{ ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1); - ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1); - ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1); - ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1); - ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1); - ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1); - ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1); - ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);} - -{ C := ColorExists(ThemeIni.ReadString(Name, 'Color', '')); - if C >= 0 then begin - ThemeButton.ColR := Color[C].RGB.R; - ThemeButton.ColG := Color[C].RGB.G; - ThemeButton.ColB := Color[C].RGB.B; - end; - - C := ColorExists(ThemeIni.ReadString(Name, 'DColor', '')); - if C >= 0 then begin - ThemeButton.DColR := Color[C].RGB.R; - ThemeButton.DColG := Color[C].RGB.G; - ThemeButton.DColB := Color[C].RGB.B; - end;} - - for T := 0 to High(ThemeButton.Text) do - ThemeSaveText(ThemeButton.Text[T], Name + 'Text' + IntToStr(T+1)); -end; - -procedure TTheme.create_theme_objects(); -begin - freeandnil( Loading ); - Loading := TThemeLoading.Create; - - freeandnil( Main ); - Main := TThemeMain.Create; - - freeandnil( Name ); - Name := TThemeName.Create; - - freeandnil( Level ); - Level := TThemeLevel.Create; - - freeandnil( Song ); - Song := TThemeSong.Create; - - freeandnil( Sing ); - Sing := TThemeSing.Create; - - freeandnil( Score ); - Score := TThemeScore.Create; - - freeandnil( Top5 ); - Top5 := TThemeTop5.Create; - - freeandnil( Options ); - Options := TThemeOptions.Create; - - freeandnil( OptionsGame ); - OptionsGame := TThemeOptionsGame.Create; - - freeandnil( OptionsGraphics ); - OptionsGraphics := TThemeOptionsGraphics.Create; - - freeandnil( OptionsSound ); - OptionsSound := TThemeOptionsSound.Create; - - freeandnil( OptionsLyrics ); - OptionsLyrics := TThemeOptionsLyrics.Create; - - freeandnil( OptionsThemes ); - OptionsThemes := TThemeOptionsThemes.Create; - - freeandnil( OptionsRecord ); - OptionsRecord := TThemeOptionsRecord.Create; - - freeandnil( OptionsAdvanced ); - OptionsAdvanced := TThemeOptionsAdvanced.Create; - - - freeandnil( ErrorPopup ); - ErrorPopup := TThemeError.Create; - - freeandnil( CheckPopup ); - CheckPopup := TThemeCheck.Create; - - - freeandnil( SongMenu ); - SongMenu := TThemeSongMenu.Create; - - freeandnil( SongJumpto ); - SongJumpto := TThemeSongJumpto.Create; - - //Party Screens - freeandnil( PartyNewRound ); - PartyNewRound := TThemePartyNewRound.Create; - - freeandnil( PartyWin ); - PartyWin := TThemePartyWin.Create; - - freeandnil( PartyScore ); - PartyScore := TThemePartyScore.Create; - - freeandnil( PartyOptions ); - PartyOptions := TThemePartyOptions.Create; - - freeandnil( PartyPlayer ); - PartyPlayer := TThemePartyPlayer.Create; - - - //Stats Screens: - freeandnil( StatMain ); - StatMain := TThemeStatMain.Create; - - freeandnil( StatDetail ); - StatDetail := TThemeStatDetail.Create; - - end; - -end. diff --git a/src/Classes/UTime.pas b/src/Classes/UTime.pas deleted file mode 100644 index f8ae91c4..00000000 --- a/src/Classes/UTime.pas +++ /dev/null @@ -1,185 +0,0 @@ -unit UTime; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -type - TTime = class - public - constructor Create; - function GetTime(): real; - end; - - TRelativeTimer = class - private - AbsoluteTime: int64; // system-clock reference time for calculation of CurrentTime - RelativeTimeOffset: real; - Paused: boolean; - TriggerMode: boolean; - public - constructor Create(TriggerMode: boolean = false); - procedure Pause(); - procedure Resume(); - function GetTime(): real; - function GetAndResetTime(): real; - procedure SetTime(Time: real; Trigger: boolean = true); - procedure Reset(); - end; - -procedure CountSkipTimeSet; -procedure CountSkipTime; -procedure CountMidTime; - -var - USTime : TTime; - VideoBGTimer: TRelativeTimer; - - TimeNew : int64; - TimeOld : int64; - TimeSkip : real; - TimeMid : real; - TimeMidTemp : int64; - -implementation - -uses - sdl, - ucommon; - -const - cSDLCorrectionRatio = 1000; - -(* -BEST Option now ( after discussion with whiteshark ) seems to be to use SDL -timer functions... - -SDL_delay -SDL_GetTicks -http://www.gamedev.net/community/forums/topic.asp?topic_id=466145&whichpage=1%EE%8D%B7 -*) - - -procedure CountSkipTimeSet; -begin - TimeNew := SDL_GetTicks(); -end; - -procedure CountSkipTime; -begin - TimeOld := TimeNew; - TimeNew := SDL_GetTicks(); - TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio; -end; - -procedure CountMidTime; -begin - TimeMidTemp := SDL_GetTicks(); - TimeMid := (TimeMidTemp - TimeNew) / cSDLCorrectionRatio; -end; - -{** - * TTime - **} - -constructor TTime.Create; -begin - inherited; - CountSkipTimeSet; -end; - -function TTime.GetTime: real; -begin - Result := SDL_GetTicks() / cSDLCorrectionRatio; -end; - -{** - * TRelativeTimer - **} - -(* - * Creates a new timer. - * If TriggerMode is false (default), the timer - * will immediately begin with counting. - * If TriggerMode is true, it will wait until Get/SetTime() or Pause() is called - * for the first time. - *) -constructor TRelativeTimer.Create(TriggerMode: boolean); -begin - inherited Create(); - Self.TriggerMode := TriggerMode; - Reset(); - Paused := false; -end; - -procedure TRelativeTimer.Pause(); -begin - RelativeTimeOffset := GetTime(); - Paused := true; -end; - -procedure TRelativeTimer.Resume(); -begin - AbsoluteTime := SDL_GetTicks(); - Paused := false; -end; - -(* - * Returns the counter of the timer. - * If in TriggerMode it will return 0 and start the counter on the first call. - *) -function TRelativeTimer.GetTime: real; -begin - // initialize absolute time on first call in triggered mode - if (TriggerMode and (AbsoluteTime = 0)) then - begin - AbsoluteTime := SDL_GetTicks(); - Result := RelativeTimeOffset; - Exit; - end; - - if Paused then - Result := RelativeTimeOffset - else - Result := RelativeTimeOffset + (SDL_GetTicks() - AbsoluteTime) / cSDLCorrectionRatio; -end; - -(* - * Returns the counter of the timer and resets the counter to 0 afterwards. - * Note: In TriggerMode the counter will not be stopped as with Reset(). - *) -function TRelativeTimer.GetAndResetTime(): real; -begin - Result := GetTime(); - SetTime(0); -end; - -(* - * Sets the timer to the given time. This will trigger in TriggerMode if - * Trigger is set to true. Otherwise the counter's state will not change. - *) -procedure TRelativeTimer.SetTime(Time: real; Trigger: boolean); -begin - RelativeTimeOffset := Time; - if ((not TriggerMode) or Trigger) then - AbsoluteTime := SDL_GetTicks(); -end; - -(* - * Resets the counter of the timer to 0. - * If in TriggerMode the timer will not start counting until it is triggered again. - *) -procedure TRelativeTimer.Reset(); -begin - RelativeTimeOffset := 0; - if (TriggerMode) then - AbsoluteTime := 0 - else - AbsoluteTime := SDL_GetTicks(); -end; - -end. diff --git a/src/Classes/UVideo.pas b/src/Classes/UVideo.pas deleted file mode 100644 index 0ab1d350..00000000 --- a/src/Classes/UVideo.pas +++ /dev/null @@ -1,828 +0,0 @@ -{############################################################################## - # FFmpeg support for UltraStar deluxe # - # # - # Created by b1indy # - # based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # - # with modifications by Jay Binks # - # # - # http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html # - # http://www.nabble.com/file/p11795857/mpegpas01.zip # - # # - ##############################################################################} - -unit UVideo; - -// uncomment if you want to see the debug stuff -{.$define DebugDisplay} -{.$define DebugFrames} -{.$define VideoBenchmark} -{.$define Info} - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -// use BGR-format for accelerated colorspace conversion with swscale -{$IFDEF UseSWScale} - {$DEFINE PIXEL_FMT_BGR} -{$ENDIF} - -implementation - -uses - SDL, - textgl, - avcodec, - avformat, - avutil, - avio, - rational, - {$IFDEF UseSWScale} - swscale, - {$ENDIF} - UMediaCore_FFmpeg, - math, - gl, - glext, - SysUtils, - UCommon, - UConfig, - ULog, - UMusic, - UGraphicClasses, - UGraphic; - -const -{$IFDEF PIXEL_FMT_BGR} - PIXEL_FMT_OPENGL = GL_BGR; - PIXEL_FMT_FFMPEG = PIX_FMT_BGR24; -{$ELSE} - PIXEL_FMT_OPENGL = GL_RGB; - PIXEL_FMT_FFMPEG = PIX_FMT_RGB24; -{$ENDIF} - -type - TVideoPlayback_FFmpeg = class( TInterfacedObject, IVideoPlayback ) - private - fVideoOpened, - fVideoPaused: Boolean; - - VideoStream: PAVStream; - VideoStreamIndex : Integer; - VideoFormatContext: PAVFormatContext; - VideoCodecContext: PAVCodecContext; - VideoCodec: PAVCodec; - - AVFrame: PAVFrame; - AVFrameRGB: PAVFrame; - FrameBuffer: PByte; - - {$IFDEF UseSWScale} - SoftwareScaleContext: PSwsContext; - {$ENDIF} - - fVideoTex: GLuint; - TexWidth, TexHeight: Cardinal; - - VideoAspect: Real; - VideoTimeBase, VideoTime: Extended; - fLoopTime: Extended; - - EOF: boolean; - Loop: boolean; - - Initialized: boolean; - - procedure Reset(); - function DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; - procedure SynchronizeVideo(Frame: PAVFrame; var pts: double); - public - function GetName: String; - - function Init(): boolean; - function Finalize: boolean; - - function Open(const aFileName : string): boolean; // true if succeed - procedure Close; - - procedure Play; - procedure Pause; - procedure Stop; - - procedure SetPosition(Time: real); - function GetPosition: real; - - procedure GetFrame(Time: Extended); - procedure DrawGL(Screen: integer); - end; - -var - FFmpegCore: TMediaCore_FFmpeg; - - -// These are called whenever we allocate a frame buffer. -// We use this to store the global_pts in a frame at the time it is allocated. -function PtsGetBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame): integer; cdecl; -var - pts: Pint64; - VideoPktPts: Pint64; -begin - Result := avcodec_default_get_buffer(CodecCtx, Frame); - VideoPktPts := CodecCtx^.opaque; - if (VideoPktPts <> nil) then - begin - // Note: we must copy the pts instead of passing a pointer, because the packet - // (and with it the pts) might change before a frame is returned by av_decode_video. - pts := av_malloc(sizeof(int64)); - pts^ := VideoPktPts^; - Frame^.opaque := pts; - end; -end; - -procedure PtsReleaseBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame); cdecl; -begin - if (Frame <> nil) then - av_freep(@Frame^.opaque); - avcodec_default_release_buffer(CodecCtx, Frame); -end; - - -{*------------------------------------------------------------------------------ - * TVideoPlayback_ffmpeg - *------------------------------------------------------------------------------} - -function TVideoPlayback_FFmpeg.GetName: String; -begin - result := 'FFmpeg_Video'; -end; - -function TVideoPlayback_FFmpeg.Init(): boolean; -begin - Result := true; - - if (Initialized) then - Exit; - Initialized := true; - - FFmpegCore := TMediaCore_FFmpeg.GetInstance(); - - Reset(); - av_register_all(); - glGenTextures(1, PGLuint(@fVideoTex)); -end; - -function TVideoPlayback_FFmpeg.Finalize(): boolean; -begin - Close(); - glDeleteTextures(1, PGLuint(@fVideoTex)); - Result := true; -end; - -procedure TVideoPlayback_FFmpeg.Reset(); -begin - // close previously opened video - Close(); - - fVideoOpened := False; - fVideoPaused := False; - VideoTimeBase := 0; - VideoTime := 0; - VideoStream := nil; - VideoStreamIndex := -1; - - EOF := false; - - // TODO: do we really want this by default? - Loop := true; - fLoopTime := 0; -end; - -function TVideoPlayback_FFmpeg.Open(const aFileName : string): boolean; // true if succeed -var - errnum: Integer; - AudioStreamIndex: integer; -begin - Result := false; - - Reset(); - - errnum := av_open_input_file(VideoFormatContext, PChar(aFileName), nil, 0, nil); - if (errnum <> 0) then - begin - Log.LogError('Failed to open file "'+aFileName+'" ('+FFmpegCore.GetErrorString(errnum)+')'); - Exit; - end; - - // update video info - if (av_find_stream_info(VideoFormatContext) < 0) then - begin - Log.LogError('No stream info found', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - Log.LogInfo('VideoStreamIndex : ' + inttostr(VideoStreamIndex), 'TVideoPlayback_ffmpeg.Open'); - - // find video stream - FFmpegCore.FindStreamIDs(VideoFormatContext, VideoStreamIndex, AudioStreamIndex); - if (VideoStreamIndex < 0) then - begin - Log.LogError('No video stream found', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - - VideoStream := VideoFormatContext^.streams[VideoStreamIndex]; - VideoCodecContext := VideoStream^.codec; - - VideoCodec := avcodec_find_decoder(VideoCodecContext^.codec_id); - if (VideoCodec = nil) then - begin - Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - - // set debug options - VideoCodecContext^.debug_mv := 0; - VideoCodecContext^.debug := 0; - - // detect bug-workarounds automatically - VideoCodecContext^.workaround_bugs := FF_BUG_AUTODETECT; - // error resilience strategy (careful/compliant/agressive/very_aggressive) - //VideoCodecContext^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT; - // allow non spec compliant speedup tricks. - //VideoCodecContext^.flags2 := VideoCodecContext^.flags2 or CODEC_FLAG2_FAST; - - // Note: avcodec_open() and avcodec_close() are not thread-safe and will - // fail if called concurrently by different threads. - FFmpegCore.LockAVCodec(); - try - errnum := avcodec_open(VideoCodecContext, VideoCodec); - finally - FFmpegCore.UnlockAVCodec(); - end; - if (errnum < 0) then - begin - Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - - // register custom callbacks for pts-determination - VideoCodecContext^.get_buffer := PtsGetBuffer; - VideoCodecContext^.release_buffer := PtsReleaseBuffer; - - {$ifdef DebugDisplay} - DebugWriteln('Found a matching Codec: '+ VideoCodecContext^.Codec.Name + sLineBreak + - sLineBreak + - ' Width = '+inttostr(VideoCodecContext^.width) + - ', Height='+inttostr(VideoCodecContext^.height) + sLineBreak + - ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num) + '/' + - inttostr(VideoCodecContext^.sample_aspect_ratio.den) + sLineBreak + - ' Framerate : '+inttostr(VideoCodecContext^.time_base.num) + '/' + - inttostr(VideoCodecContext^.time_base.den)); - {$endif} - - // allocate space for decoded frame and rgb frame - AVFrame := avcodec_alloc_frame(); - AVFrameRGB := avcodec_alloc_frame(); - FrameBuffer := av_malloc(avpicture_get_size(PIXEL_FMT_FFMPEG, - VideoCodecContext^.width, VideoCodecContext^.height)); - - if ((AVFrame = nil) or (AVFrameRGB = nil) or (FrameBuffer = nil)) then - begin - Log.LogError('Failed to allocate buffers', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - - // TODO: pad data for OpenGL to GL_UNPACK_ALIGNMENT - // (otherwise video will be distorted if width/height is not a multiple of the alignment) - errnum := avpicture_fill(PAVPicture(AVFrameRGB), FrameBuffer, PIXEL_FMT_FFMPEG, - VideoCodecContext^.width, VideoCodecContext^.height); - if (errnum < 0) then - begin - Log.LogError('avpicture_fill failed: ' + FFmpegCore.GetErrorString(errnum), 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - - // calculate some information for video display - VideoAspect := av_q2d(VideoCodecContext^.sample_aspect_ratio); - if (VideoAspect = 0) then - VideoAspect := VideoCodecContext^.width / - VideoCodecContext^.height - else - VideoAspect := VideoAspect * VideoCodecContext^.width / - VideoCodecContext^.height; - - VideoTimeBase := 1/av_q2d(VideoStream^.r_frame_rate); - - // hack to get reasonable timebase (for divx and others) - if (VideoTimeBase < 0.02) then // 0.02 <-> 50 fps - begin - VideoTimeBase := av_q2d(VideoStream^.r_frame_rate); - while (VideoTimeBase > 50) do - VideoTimeBase := VideoTimeBase/10; - VideoTimeBase := 1/VideoTimeBase; - end; - - Log.LogInfo('VideoTimeBase: ' + floattostr(VideoTimeBase), 'TVideoPlayback_ffmpeg.Open'); - Log.LogInfo('Framerate: '+inttostr(floor(1/VideoTimeBase))+'fps', 'TVideoPlayback_ffmpeg.Open'); - - {$IFDEF UseSWScale} - // if available get a SWScale-context -> faster than the deprecated img_convert(). - // SWScale has accelerated support for PIX_FMT_RGB32/PIX_FMT_BGR24/PIX_FMT_BGR565/PIX_FMT_BGR555. - // Note: PIX_FMT_RGB32 is a BGR- and not an RGB-format (maybe a bug)!!! - // The BGR565-formats (GL_UNSIGNED_SHORT_5_6_5) is way too slow because of its - // bad OpenGL support. The BGR formats have MMX(2) implementations but no speed-up - // could be observed in comparison to the RGB versions. - SoftwareScaleContext := sws_getContext( - VideoCodecContext^.width, VideoCodecContext^.height, - integer(VideoCodecContext^.pix_fmt), - VideoCodecContext^.width, VideoCodecContext^.height, - integer(PIXEL_FMT_FFMPEG), - SWS_FAST_BILINEAR, nil, nil, nil); - if (SoftwareScaleContext = nil) then - begin - Log.LogError('Failed to get swscale context', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - {$ENDIF} - - TexWidth := Round(Power(2, Ceil(Log2(VideoCodecContext^.width)))); - TexHeight := Round(Power(2, Ceil(Log2(VideoCodecContext^.height)))); - - // we retrieve a texture just once with glTexImage2D and update it with glTexSubImage2D later. - // Benefits: glTexSubImage2D is faster and supports non-power-of-two widths/height. - glBindTexture(GL_TEXTURE_2D, fVideoTex); - glTexEnvi(GL_TEXTURE_2D, GL_TEXTURE_ENV_MODE, GL_REPLACE); - glTexImage2D(GL_TEXTURE_2D, 0, 3, TexWidth, TexHeight, 0, - PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, nil); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - - - fVideoOpened := True; - - Result := true; -end; - -procedure TVideoPlayback_FFmpeg.Close; -begin - if (FrameBuffer <> nil) then - av_free(FrameBuffer); - if (AVFrameRGB <> nil) then - av_free(AVFrameRGB); - if (AVFrame <> nil) then - av_free(AVFrame); - - AVFrame := nil; - AVFrameRGB := nil; - FrameBuffer := nil; - - if (VideoCodecContext <> nil) then - begin - // avcodec_close() is not thread-safe - FFmpegCore.LockAVCodec(); - try - avcodec_close(VideoCodecContext); - finally - FFmpegCore.UnlockAVCodec(); - end; - end; - - if (VideoFormatContext <> nil) then - av_close_input_file(VideoFormatContext); - - VideoCodecContext := nil; - VideoFormatContext := nil; - - fVideoOpened := False; -end; - -procedure TVideoPlayback_FFmpeg.SynchronizeVideo(Frame: PAVFrame; var pts: double); -var - FrameDelay: double; -begin - if (pts <> 0) then - begin - // if we have pts, set video clock to it - VideoTime := pts; - end else - begin - // if we aren't given a pts, set it to the clock - pts := VideoTime; - end; - // update the video clock - FrameDelay := av_q2d(VideoCodecContext^.time_base); - // if we are repeating a frame, adjust clock accordingly - FrameDelay := FrameDelay + Frame^.repeat_pict * (FrameDelay * 0.5); - VideoTime := VideoTime + FrameDelay; -end; - -function TVideoPlayback_FFmpeg.DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; -var - FrameFinished: Integer; - VideoPktPts: int64; - pbIOCtx: PByteIOContext; - errnum: integer; -begin - Result := false; - FrameFinished := 0; - - if EOF then - Exit; - - // read packets until we have a finished frame (or there are no more packets) - while (FrameFinished = 0) do - begin - errnum := av_read_frame(VideoFormatContext, AVPacket); - if (errnum < 0) then - begin - // failed to read a frame, check reason - - {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)} - pbIOCtx := VideoFormatContext^.pb; - {$ELSE} - pbIOCtx := @VideoFormatContext^.pb; - {$IFEND} - - // check for end-of-file (eof is not an error) - if (url_feof(pbIOCtx) <> 0) then - begin - EOF := true; - Exit; - end; - - // check for errors - if (url_ferror(pbIOCtx) <> 0) then - Exit; - - // url_feof() does not detect an EOF for some mov-files (e.g. deluxe.mov) - // so we have to do it this way. - if ((VideoFormatContext^.file_size <> 0) and - (pbIOCtx^.pos >= VideoFormatContext^.file_size)) then - begin - EOF := true; - Exit; - end; - - // no error -> wait for user input - SDL_Delay(100); - continue; - end; - - // if we got a packet from the video stream, then decode it - if (AVPacket.stream_index = VideoStreamIndex) then - begin - // save pts to be stored in pFrame in first call of PtsGetBuffer() - VideoPktPts := AVPacket.pts; - VideoCodecContext^.opaque := @VideoPktPts; - - // decode packet - avcodec_decode_video(VideoCodecContext, AVFrame, - frameFinished, AVPacket.data, AVPacket.size); - - // reset opaque data - VideoCodecContext^.opaque := nil; - - // update pts - if (AVPacket.dts <> AV_NOPTS_VALUE) then - begin - pts := AVPacket.dts; - end - else if ((AVFrame^.opaque <> nil) and - (Pint64(AVFrame^.opaque)^ <> AV_NOPTS_VALUE)) then - begin - pts := Pint64(AVFrame^.opaque)^; - end - else - begin - pts := 0; - end; - pts := pts * av_q2d(VideoStream^.time_base); - - // synchronize on each complete frame - if (frameFinished <> 0) then - SynchronizeVideo(AVFrame, pts); - end; - - // free the packet from av_read_frame - av_free_packet( @AVPacket ); - end; - - Result := true; -end; - -procedure TVideoPlayback_FFmpeg.GetFrame(Time: Extended); -var - AVPacket: TAVPacket; - errnum: Integer; - myTime: Extended; - TimeDifference: Extended; - DropFrameCount: Integer; - pts: double; - i: Integer; -const - FRAME_DROPCOUNT = 3; -begin - if not fVideoOpened then - Exit; - - if fVideoPaused then - Exit; - - // current time, relative to last loop (if any) - myTime := Time - fLoopTime; - // time since the last frame was returned - TimeDifference := myTime - VideoTime; - - {$IFDEF DebugDisplay} - DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak + - 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak + - 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); - {$endif} - - // check if a new frame is needed - if (VideoTime <> 0) and (TimeDifference < VideoTimeBase) then - begin - {$ifdef DebugFrames} - // frame delay debug display - GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00); - {$endif} - - {$IFDEF DebugDisplay} - DebugWriteln('not getting new frame' + sLineBreak + - 'Time: '+inttostr(floor(Time*1000)) + sLineBreak + - 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak + - 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); - {$endif} - - // we do not need a new frame now - Exit; - end; - - // update video-time to the next frame - VideoTime := VideoTime + VideoTimeBase; - TimeDifference := myTime - VideoTime; - - // check if we have to skip frames - if (TimeDifference >= FRAME_DROPCOUNT*VideoTimeBase) then - begin - {$IFDEF DebugFrames} - //frame drop debug display - GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); - {$ENDIF} - {$IFDEF DebugDisplay} - DebugWriteln('skipping frames' + sLineBreak + - 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); - {$endif} - - // update video-time - DropFrameCount := Trunc(TimeDifference / VideoTimeBase); - VideoTime := VideoTime + DropFrameCount*VideoTimeBase; - - // skip half of the frames, this is much smoother than to skip all at once - for i := 1 to DropFrameCount (*div 2*) do - DecodeFrame(AVPacket, pts); - end; - - {$IFDEF VideoBenchmark} - Log.BenchmarkStart(15); - {$ENDIF} - - if (not DecodeFrame(AVPacket, pts)) then - begin - if Loop then - begin - // Record the time we looped. This is used to keep the loops in time. otherwise they speed - SetPosition(0); - fLoopTime := Time; - end; - Exit; - end; - - // TODO: support for pan&scan - //if (AVFrame.pan_scan <> nil) then - //begin - // Writeln(Format('PanScan: %d/%d', [AVFrame.pan_scan.width, AVFrame.pan_scan.height])); - //end; - - // otherwise we convert the pixeldata from YUV to RGB - {$IFDEF UseSWScale} - errnum := sws_scale(SoftwareScaleContext, @(AVFrame.data), @(AVFrame.linesize), - 0, VideoCodecContext^.Height, - @(AVFrameRGB.data), @(AVFrameRGB.linesize)); - {$ELSE} - errnum := img_convert(PAVPicture(AVFrameRGB), PIXEL_FMT_FFMPEG, - PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, - VideoCodecContext^.width, VideoCodecContext^.height); - {$ENDIF} - - if (errnum < 0) then - begin - Log.LogError('Image conversion failed', 'TVideoPlayback_ffmpeg.GetFrame'); - Exit; - end; - - {$IFDEF VideoBenchmark} - Log.BenchmarkEnd(15); - Log.BenchmarkStart(16); - {$ENDIF} - - // TODO: data is not padded, so we will need to tell OpenGL. - // Or should we add padding with avpicture_fill? (check which one is faster) - //glPixelStorei(GL_UNPACK_ALIGNMENT, 1); - - glBindTexture(GL_TEXTURE_2D, fVideoTex); - glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, - VideoCodecContext^.width, VideoCodecContext^.height, - PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]); - - {$ifdef DebugFrames} - //frame decode debug display - GoldenRec.Spawn(200, 35, 1, 16, 0, -1, ColoredStar, $ffff00); - {$endif} - - {$IFDEF VideoBenchmark} - Log.BenchmarkEnd(16); - Log.LogBenchmark('FFmpeg', 15); - Log.LogBenchmark('Texture', 16); - {$ENDIF} -end; - -procedure TVideoPlayback_FFmpeg.DrawGL(Screen: integer); -var - TexVideoRightPos, TexVideoLowerPos: Single; - ScreenLeftPos, ScreenRightPos: Single; - ScreenUpperPos, ScreenLowerPos: Single; - ScaledVideoWidth, ScaledVideoHeight: Single; - ScreenMidPosX, ScreenMidPosY: Single; - ScreenAspect: Single; -begin - // have a nice black background to draw on (even if there were errors opening the vid) - if (Screen = 1) then - begin - glClearColor(0, 0, 0, 0); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - end; - - // exit if there's nothing to draw - if (not fVideoOpened) then - Exit; - - {$IFDEF VideoBenchmark} - Log.BenchmarkStart(15); - {$ENDIF} - - // TODO: add a SetAspectCorrectionMode() function so we can switch - // aspect correction. The screens video backgrounds look very ugly with aspect - // correction because of the white bars at the top and bottom. - - ScreenAspect := ScreenW / ScreenH; - ScaledVideoWidth := RenderW; - ScaledVideoHeight := RenderH * ScreenAspect/VideoAspect; - - // Note: Scaling the width does not look good because the video might contain - // black borders at the top already - //ScaledVideoHeight := RenderH; - //ScaledVideoWidth := RenderW * VideoAspect/ScreenAspect; - - // center the video - ScreenMidPosX := RenderW/2; - ScreenMidPosY := RenderH/2; - ScreenLeftPos := ScreenMidPosX - ScaledVideoWidth/2; - ScreenRightPos := ScreenMidPosX + ScaledVideoWidth/2; - ScreenUpperPos := ScreenMidPosY - ScaledVideoHeight/2; - ScreenLowerPos := ScreenMidPosY + ScaledVideoHeight/2; - // the video-texture contains empty borders because its width and height must be - // a power of 2. So we have to determine the texture coords of the video. - TexVideoRightPos := VideoCodecContext^.width / TexWidth; - TexVideoLowerPos := VideoCodecContext^.height / TexHeight; - - // we could use blending for brightness control, but do we need this? - glDisable(GL_BLEND); - - // TODO: disable other stuff like lightning, etc. - - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, fVideoTex); - glColor3f(1, 1, 1); - glBegin(GL_QUADS); - // upper-left coord - glTexCoord2f(0, 0); - glVertex2f(ScreenLeftPos, ScreenUpperPos); - // lower-left coord - glTexCoord2f(0, TexVideoLowerPos); - glVertex2f(ScreenLeftPos, ScreenLowerPos); - // lower-right coord - glTexCoord2f(TexVideoRightPos, TexVideoLowerPos); - glVertex2f(ScreenRightPos, ScreenLowerPos); - // upper-right coord - glTexCoord2f(TexVideoRightPos, 0); - glVertex2f(ScreenRightPos, ScreenUpperPos); - glEnd; - glDisable(GL_TEXTURE_2D); - - {$IFDEF VideoBenchmark} - Log.BenchmarkEnd(15); - Log.LogBenchmark('DrawGL', 15); - {$ENDIF} - - {$IFDEF Info} - if (fVideoSkipTime+VideoTime+VideoTimeBase < 0) then - begin - glColor4f(0.7, 1, 0.3, 1); - SetFontStyle (1); - SetFontItalic(False); - SetFontSize(9); - SetFontPos (300, 0); - glPrint('Delay due to negative VideoGap'); - glColor4f(1, 1, 1, 1); - end; - {$ENDIF} - - {$IFDEF DebugFrames} - glColor4f(0, 0, 0, 0.2); - glbegin(GL_QUADS); - glVertex2f(0, 0); - glVertex2f(0, 70); - glVertex2f(250, 70); - glVertex2f(250, 0); - glEnd; - - glColor4f(1, 1, 1, 1); - SetFontStyle (1); - SetFontItalic(False); - SetFontSize(9); - SetFontPos (5, 0); - glPrint('delaying frame'); - SetFontPos (5, 20); - glPrint('fetching frame'); - SetFontPos (5, 40); - glPrint('dropping frame'); - {$ENDIF} -end; - -procedure TVideoPlayback_FFmpeg.Play; -begin -end; - -procedure TVideoPlayback_FFmpeg.Pause; -begin - fVideoPaused := not fVideoPaused; -end; - -procedure TVideoPlayback_FFmpeg.Stop; -begin -end; - -procedure TVideoPlayback_FFmpeg.SetPosition(Time: real); -var - SeekFlags: integer; -begin - if not fVideoOpened then - Exit; - - if (Time < 0) then - Time := 0; - - // TODO: handle loop-times - //Time := Time mod VideoDuration; - - // backward seeking might fail without AVSEEK_FLAG_BACKWARD - SeekFlags := AVSEEK_FLAG_ANY; - if (Time < VideoTime) then - SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD; - - VideoTime := Time; - EOF := false; - - if (av_seek_frame(VideoFormatContext, VideoStreamIndex, Floor(Time/VideoTimeBase), SeekFlags) < 0) then - begin - Log.LogError('av_seek_frame() failed', 'TVideoPlayback_ffmpeg.SetPosition'); - Exit; - end; - - avcodec_flush_buffers(VideoCodecContext); -end; - -function TVideoPlayback_FFmpeg.GetPosition: real; -begin - // TODO: return video-position in seconds - Result := VideoTime; -end; - -initialization - MediaManager.Add(TVideoPlayback_FFmpeg.Create); - -end. diff --git a/src/Classes/UVisualizer.pas b/src/Classes/UVisualizer.pas deleted file mode 100644 index e2125201..00000000 --- a/src/Classes/UVisualizer.pas +++ /dev/null @@ -1,442 +0,0 @@ -unit UVisualizer; - -(* TODO: - * - fix video/visualizer switching - * - use GL_EXT_framebuffer_object for rendering to a separate framebuffer, - * this will prevent plugins from messing up our render-context - * (-> no stack corruption anymore, no need for Save/RestoreOpenGLState()). - * - create a generic (C-compatible) interface for visualization plugins - * - create a visualization plugin manager - * - write a plugin for projectM in C/C++ (so we need no wrapper anymore) - *) - -{* Note: - * It would be easier to create a seperate Render-Context (RC) for projectM - * and switch to it when necessary. This can be achieved by pbuffers - * (slow and platform specific) or the OpenGL FramebufferObject (FBO) extension - * (fast and plattform-independent but not supported by older graphic-cards/drivers). - * - * See http://oss.sgi.com/projects/ogl-sample/registry/EXT/framebuffer_object.txt - * - * To support as many cards as possible we will stick to the current dirty - * solution for now even if it is a pain to save/restore projectM's state due - * to bugs etc. - * - * This also restricts us to projectM. As other plug-ins might have different - * needs and bugs concerning the OpenGL state, USDX's state would probably be - * corrupted after the plug-in finshed drawing. - *} - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -{$I switches.inc} - -uses - SDL, - UGraphicClasses, - textgl, - math, - gl, - SysUtils, - UIni, - projectM, - UMusic; - -implementation - -uses - UGraphic, - UMain, - UConfig, - ULog; - -{$IF PROJECTM_VERSION < 1000000} // < 1.0 -// Initialization data used on projectM 0.9x creation. -// Since projectM 1.0 this data is passed via the config-file. -const - meshX = 32; - meshY = 24; - fps = 30; - textureSize = 512; -{$IFEND} - -type - TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization ) - private - pm: TProjectM; - ProjectMPath : string; - Initialized: boolean; - - VisualizerStarted: boolean; - VisualizerPaused: boolean; - - VisualTex: GLuint; - PCMData: TPCMData; - RndPCMcount: integer; - - projMatrix: array[0..3, 0..3] of GLdouble; - texMatrix: array[0..3, 0..3] of GLdouble; - - procedure VisualizerStart; - procedure VisualizerStop; - - procedure VisualizerTogglePause; - - function GetRandomPCMData(var data: TPCMData): Cardinal; - - procedure SaveOpenGLState(); - procedure RestoreOpenGLState(); - - public - function GetName: String; - - function Init(): boolean; - function Finalize(): boolean; - - function Open(const aFileName : string): boolean; // true if succeed - procedure Close; - - procedure Play; - procedure Pause; - procedure Stop; - - procedure SetPosition(Time: real); - function GetPosition: real; - - procedure GetFrame(Time: Extended); - procedure DrawGL(Screen: integer); - end; - - -function TVideoPlayback_ProjectM.GetName: String; -begin - Result := 'ProjectM'; -end; - -function TVideoPlayback_ProjectM.Init(): boolean; -begin - Result := true; - - if (Initialized) then - Exit; - Initialized := true; - - RndPCMcount := 0; - - ProjectMPath := ProjectM_DataDir + PathDelim; - - VisualizerStarted := False; - VisualizerPaused := False; - - {$IFDEF UseTexture} - glGenTextures(1, PglUint(@VisualTex)); - glBindTexture(GL_TEXTURE_2D, VisualTex); - - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - {$ENDIF} -end; - -function TVideoPlayback_ProjectM.Finalize(): boolean; -begin - VisualizerStop(); - {$IFDEF UseTexture} - glDeleteTextures(1, PglUint(@VisualTex)); - {$ENDIF} - Result := true; -end; - -function TVideoPlayback_ProjectM.Open(const aFileName : string): boolean; // true if succeed -begin - Result := false; -end; - -procedure TVideoPlayback_ProjectM.Close; -begin - VisualizerStop(); -end; - -procedure TVideoPlayback_ProjectM.Play; -begin - VisualizerStart(); -end; - -procedure TVideoPlayback_ProjectM.Pause; -begin - VisualizerTogglePause(); -end; - -procedure TVideoPlayback_ProjectM.Stop; -begin - VisualizerStop(); -end; - -procedure TVideoPlayback_ProjectM.SetPosition(Time: real); -begin - if assigned(pm) then - pm.RandomPreset(); -end; - -function TVideoPlayback_ProjectM.GetPosition: real; -begin - Result := 0; -end; - -{** - * Saves the current OpenGL state. - * This is necessary to prevent projectM from corrupting USDX's current - * OpenGL state. - * - * The following steps are performed: - * - All attributes are pushed to the attribute-stack - * - Projection-/Texture-matrices are saved - * - Modelview-matrix is pushed to the Modelview-stack - * - the OpenGL error-state (glGetError) is cleared - *} -procedure TVideoPlayback_ProjectM.SaveOpenGLState(); -begin - // save all OpenGL state-machine attributes - glPushAttrib(GL_ALL_ATTRIB_BITS); - - // Note: we do not use glPushMatrix() for the GL_PROJECTION and GL_TEXTURE stacks. - // OpenGL specifies the depth of those stacks to be at least 2 but projectM - // already uses 2 stack-entries so overflows might be possible on older hardware. - // In contrast to this the GL_MODELVIEW stack-size is at least 32, so we can - // use glPushMatrix() for this stack. - - // save projection-matrix - glMatrixMode(GL_PROJECTION); - glGetDoublev(GL_PROJECTION_MATRIX, @projMatrix); - {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01 - // bugfix: projection-matrix is popped without being pushed first - glPushMatrix(); - {$IFEND} - - // save texture-matrix - glMatrixMode(GL_TEXTURE); - glGetDoublev(GL_TEXTURE_MATRIX, @texMatrix); - - // save modelview-matrix - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01 - // bugfix: modelview-matrix is popped without being pushed first - glPushMatrix(); - {$IFEND} - - // reset OpenGL error-state - glGetError(); -end; - -{** - * Restores the OpenGL state saved by SaveOpenGLState() - * and resets the error-state. - *} -procedure TVideoPlayback_ProjectM.RestoreOpenGLState(); -begin - // reset OpenGL error-state - glGetError(); - - // restore projection-matrix - glMatrixMode(GL_PROJECTION); - glLoadMatrixd(@projMatrix); - - // restore texture-matrix - glMatrixMode(GL_TEXTURE); - glLoadMatrixd(@texMatrix); - - // restore modelview-matrix - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - - // restore all OpenGL state-machine attributes - glPopAttrib(); -end; - -procedure TVideoPlayback_ProjectM.VisualizerStart; -begin - if VisualizerStarted then - Exit; - - // the OpenGL state must be saved before - SaveOpenGLState(); - try - - try - {$IF PROJECTM_VERSION >= 1000000} // >= 1.0 - pm := TProjectM.Create(ProjectMPath + 'config.inp'); - {$ELSE} - pm := TProjectM.Create( - meshX, meshY, fps, textureSize, ScreenW, ScreenH, - ProjectMPath + 'presets', ProjectMPath + 'fonts'); - {$IFEND} - except on E: Exception do - begin - // Create() might fail if the config-file is not found - Log.LogError('TProjectM.Create: ' + E.Message, 'TVideoPlayback_ProjectM.VisualizerStart'); - Exit; - end; - end; - - // initialize OpenGL - pm.ResetGL(ScreenW, ScreenH); - // skip projectM default-preset - pm.RandomPreset(); - // projectM >= 1.0 uses the OpenGL FramebufferObject (FBO) extension. - // Unfortunately it does NOT reset the framebuffer-context after - // TProjectM.Create. Either glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0) for - // a manual reset or TProjectM.RenderFrame() must be called. - // We use the latter so we do not need to load the FBO extension in USDX. - pm.RenderFrame(); - - VisualizerStarted := True; - finally - RestoreOpenGLState(); - end; -end; - -procedure TVideoPlayback_ProjectM.VisualizerStop; -begin - if VisualizerStarted then - begin - VisualizerStarted := False; - FreeAndNil(pm); - end; -end; - -procedure TVideoPlayback_ProjectM.VisualizerTogglePause; -begin - VisualizerPaused := not VisualizerPaused; -end; - -procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); -var - nSamples: cardinal; - stackDepth: Integer; -begin - if not VisualizerStarted then - Exit; - - if VisualizerPaused then - Exit; - - // get audio data - nSamples := AudioPlayback.GetPCMData(PcmData); - - // generate some data if non is available - if (nSamples = 0) then - nSamples := GetRandomPCMData(PcmData); - - // send audio-data to projectM - if (nSamples > 0) then - pm.AddPCM16Data(PSmallInt(@PcmData), nSamples); - - // store OpenGL state (might be messed up otherwise) - SaveOpenGLState(); - try - // setup projectM's OpenGL state - pm.ResetGL(ScreenW, ScreenH); - - // let projectM render a frame - pm.RenderFrame(); - - {$IFDEF UseTexture} - glBindTexture(GL_TEXTURE_2D, VisualTex); - glFlush(); - glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0); - {$ENDIF} - finally - // restore USDX OpenGL state - RestoreOpenGLState(); - end; - - // discard projectM's depth buffer information (avoid overlay) - glClear(GL_DEPTH_BUFFER_BIT); -end; - -{** - * Draws the current frame to screen. - * TODO: this is not used yet. Data is directly drawn on GetFrame(). - *} -procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer); -begin - {$IFDEF UseTexture} - // have a nice black background to draw on - if (Screen = 1) then - begin - glClearColor(0, 0, 0, 0); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - end; - - // exit if there's nothing to draw - if not VisualizerStarted then - Exit; - - // setup display - glMatrixMode(GL_PROJECTION); - glPushMatrix(); - glLoadIdentity(); - gluOrtho2D(0, 1, 0, 1); - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - glLoadIdentity(); - - glEnable(GL_BLEND); - glEnable(GL_TEXTURE_2D); - glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); - glBindTexture(GL_TEXTURE_2D, VisualTex); - glColor4f(1, 1, 1, 1); - - // draw projectM frame - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(0, 0); - glTexCoord2f(1, 0); glVertex2f(1, 0); - glTexCoord2f(1, 1); glVertex2f(1, 1); - glTexCoord2f(0, 1); glVertex2f(0, 1); - glEnd(); - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - // restore state - glMatrixMode(GL_PROJECTION); - glPopMatrix(); - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - {$ENDIF} -end; - -{** - * Produces random "sound"-data in case no audio-data is available. - * Otherwise the visualization will look rather boring. - *} -function TVideoPlayback_ProjectM.GetRandomPCMData(var data: TPCMData): Cardinal; -var - i: integer; -begin - // Produce some fake PCM data - if (RndPCMcount mod 500 = 0) then - begin - FillChar(data, SizeOf(TPCMData), 0); - end - else - begin - for i := 0 to 511 do - begin - data[i][0] := Random(High(Word)+1); - data[i][1] := Random(High(Word)+1); - end; - end; - Inc(RndPCMcount); - Result := 512; -end; - - -initialization - MediaManager.Add(TVideoPlayback_ProjectM.Create); - -end. diff --git a/src/Classes/UXMLSong.pas b/src/Classes/UXMLSong.pas deleted file mode 100644 index 1a1fe6bc..00000000 --- a/src/Classes/UXMLSong.pas +++ /dev/null @@ -1,573 +0,0 @@ -unit UXMLSong; - -interface -uses Classes; - -type - TNote = record - Start: Cardinal; - Duration: Cardinal; - Tone: Integer; - NoteTyp: Byte; - Lyric: String; - end; - ANote = Array of TNote; - - TSentence = record - Singer: Byte; - Duration: Cardinal; - Notes: ANote; - end; - ASentence = Array of TSentence; - - TSongInfo = Record - ID: Cardinal; - DualChannel: Boolean; - Header: Record - Artist: String; - Title: String; - Gap: Cardinal; - BPM: Real; - Resolution: Byte; - Edition: String; - Genre: String; - Year: String; - Language: String; - end; - CountSentences: Cardinal; - Sentences: ASentence; - end; - - TParser = class - private - SSFile: TStringList; - - ParserState: Byte; - CurPosinSong: Cardinal; //Cur Beat Pos in the Song - CurDuettSinger: Byte; //Who sings this Part? - BindLyrics: Boolean; //Should the Lyrics be bind to the last Word (no Space) - FirstNote: Boolean; //Is this the First Note found? For Gap calculating - - Function ParseLine(Line: String): Boolean; - public - SongInfo: TSongInfo; - ErrorMessage: String; - Edition: String; - SingstarVersion: String; - - Settings: Record - DashReplacement: Char; - end; - - Constructor Create; - - Function ParseConfigforEdition(const Filename: String): String; - - Function ParseSongHeader(const Filename: String): Boolean; //Parse Song Header only - Function ParseSong (const Filename: String): Boolean; //Parse whole Song - end; - -const - PS_None = 0; - PS_Melody = 1; - PS_Sentence = 2; - - NT_Normal = 1; - NT_Freestyle = 0; - NT_Golden = 2; - - DS_Player1 = 1; - DS_Player2 = 2; - DS_Both = 3; - -implementation -uses SysUtils, StrUtils; - -Constructor TParser.Create; -begin - inherited Create; - ErrorMessage := ''; - - DecimalSeparator := '.'; -end; - -Function TParser.ParseSong (const Filename: String): Boolean; -var I: Integer; -begin - Result := False; - if FileExists(Filename) then - begin - SSFile := TStringList.Create; - - try - ErrorMessage := 'Can''t open melody.xml file'; - SSFile.LoadFromFile(Filename); - ErrorMessage := ''; - Result := True; - I := 0; - - SongInfo.CountSentences := 0; - CurDuettSinger := DS_Both; //Both is Singstar Standard - CurPosinSong := 0; //Start at Pos 0 - BindLyrics := True; //Dont start with Space - FirstNote := True; //First Note found should be the First Note ;) - - SongInfo.Header.Language := ''; - SongInfo.Header.Edition := Edition; - SongInfo.DualChannel := False; - - ParserState := PS_None; - - SetLength(SongInfo.Sentences, 0); - - While Result And (I < SSFile.Count) do - begin - Result := ParseLine(SSFile.Strings[I]); - - Inc(I); - end; - - finally - SSFile.Free; - end; - end; -end; - -Function TParser.ParseSongHeader (const Filename: String): Boolean; -var I: Integer; -begin - Result := False; - if FileExists(Filename) then - begin - SSFile := TStringList.Create; - SSFile.Clear; - - try - SSFile.LoadFromFile(Filename); - - If (SSFile.Count > 0) then - begin - Result := True; - I := 0; - - SongInfo.CountSentences := 0; - CurDuettSinger := DS_Both; //Both is Singstar Standard - CurPosinSong := 0; //Start at Pos 0 - BindLyrics := True; //Dont start with Space - FirstNote := True; //First Note found should be the First Note ;) - - SongInfo.ID := 0; - SongInfo.Header.Language := ''; - SongInfo.Header.Edition := Edition; - SongInfo.DualChannel := False; - ParserState := PS_None; - - While (SongInfo.ID < 4) AND Result And (I < SSFile.Count) do - begin - Result := ParseLine(SSFile.Strings[I]); - - Inc(I); - end; - end - else - ErrorMessage := 'Can''t open melody.xml file'; - - finally - SSFile.Free; - end; - end - else - ErrorMessage := 'Can''t find melody.xml file'; -end; - -Function TParser.ParseLine(Line: String): Boolean; -var - Tag: String; - Values: String; - AValues: Array of Record - Name: String; - Value: String; - end; - I, J, K: Integer; - Duration, Tone: Integer; - Lyric: String; - NoteType: Byte; - - Procedure MakeValuesArray; - var Len, Pos, State, StateChange: Integer; - begin - Len := -1; - SetLength(AValues, Len + 1); - - Pos := 1; - State := 0; - While (Pos <= Length(Values)) AND (Pos <> 0) do - begin - Case State of - - 0: begin //Search for ValueName - If (Values[Pos] <> ' ') AND (Values[Pos] <> '=') then - begin - //Found Something - State := 1; //State search for '=' - StateChange := Pos; //Save Pos of Change - Pos := PosEx('=', Values, Pos + 1); - end - else Inc(Pos); //When nothing found then go to next char - end; - - 1: begin //Search for Equal Mark - //Add New Value - Inc(Len); - SetLength(AValues, Len + 1); - - AValues[Len].Name := UpperCase(Copy(Values, StateChange, Pos - StateChange)); - - - State := 2; //Now Search for starting '"' - StateChange := Pos; //Save Pos of Change - Pos := PosEx('"', Values, Pos + 1); - end; - - 2: begin //Search for starting '"' or ' ' <- End if there was no " - If (Values[Pos] = '"') then - begin //Found starting '"' - State := 3; //Now Search for ending '"' - StateChange := Pos; //Save Pos of Change - Pos := PosEx('"', Values, Pos + 1); - end - else If (Values[Pos] = ' ') then //Found ending Space - begin - //Save Value to Array - AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1); - - //Search for next Valuename - State := 0; - StateChange := Pos; - Inc(Pos); - end; - end; - - 3: begin //Search for ending '"' - //Save Value to Array - AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1); - - //Search for next Valuename - State := 0; - StateChange := Pos; - Inc(Pos); - end; - end; - - If (State >= 2) then - begin //Save Last Value - AValues[Len].Value := Copy(Values, StateChange + 1, Length(Values) - StateChange); - end; - end; - end; -begin - Result := True; - - Line := Trim(Line); - If (Length(Line) > 0) then - begin - I := Pos('<', Line); - J := PosEx(' ', Line, I+1); - K := PosEx('>', Line, I+1); - - If (J = 0) then J := K - Else If (K < J) AND (K <> 0) then J := K; //Use nearest Tagname End indicator - Tag := UpperCase(copy(Line, I + 1, J - I - 1)); - Values := copy(Line, J + 1, K - J - 1); - - Case ParserState of - PS_None: begin//Search for Melody Tag - If (Tag = 'MELODY') then - begin - Inc(SongInfo.ID); //Inc SongID when header Information is added - MakeValuesArray; - For I := 0 to High(AValues) do - begin - If (AValues[I].Name = 'TEMPO') then - begin - SongInfo.Header.BPM := StrtoFloatDef(AValues[I].Value, 0); - If (SongInfo.Header.BPM <= 0) then - begin - Result := False; - ErrorMessage := 'Can''t read BPM from Song'; - end; - end - - Else If (AValues[I].Name = 'RESOLUTION') then - begin - AValues[I].Value := Uppercase(AValues[I].Value); - //Ultrastar Resolution is "how often a Beat is split / 4" - If (AValues[I].Value = 'HEMIDEMISEMIQUAVER') then - SongInfo.Header.Resolution := 64 div 4 - Else If (AValues[I].Value = 'DEMISEMIQUAVER') then - SongInfo.Header.Resolution := 32 div 4 - Else If (AValues[I].Value = 'SEMIQUAVER') then - SongInfo.Header.Resolution := 16 div 4 - Else If (AValues[I].Value = 'QUAVER') then - SongInfo.Header.Resolution := 8 div 4 - Else If (AValues[I].Value = 'CROTCHET') then - SongInfo.Header.Resolution := 4 div 4 - Else - begin //Can't understand teh Resolution :/ - Result := False; - ErrorMessage := 'Can''t read Resolution from Song'; - end; - end - - Else If (AValues[I].Name = 'GENRE') then - begin - SongInfo.Header.Genre := AValues[I].Value; - end - - Else If (AValues[I].Name = 'YEAR') then - begin - SongInfo.Header.Year := AValues[I].Value; - end - - Else If (AValues[I].Name = 'VERSION') then - begin - SingstarVersion := AValues[I].Value; - end; - end; - - ParserState := PS_Melody; //In Melody Tag - end; - end; - - - PS_Melody: begin //Search for Sentence, Artist/Title Info or eo Melody - If (Tag = 'SENTENCE') then - begin - ParserState := PS_Sentence; //Parse in a Sentence Tag now - - //Increase SentenceCount - Inc(SongInfo.CountSentences); - - BindLyrics := True; //Don't let Txts Begin w/ Space - - //Search for Duett Singer Info - MakeValuesArray; - For I := 0 to High(AValues) do - If (AValues[I].Name = 'SINGER') then - begin - AValues[I].Value := Uppercase(AValues[I].Value); - If (AValues[I].Value = 'SOLO 1') then - CurDuettSinger := DS_Player1 - Else If (AValues[I].Value = 'SOLO 2') then - CurDuettSinger := DS_Player2 - Else - CurDuettSinger := DS_Both; //In case of "Group" or anything that is not identified use Both - end; - end - - Else If (Tag = '!--') then - begin //Comment, this may be Artist or Title Info - I := Pos(':', Values); //Search for Delimiter - - If (I <> 0) then //If Found check for Title or Artist - begin - //Copy Title or Artist Tag to Tag String - Tag := Uppercase(Trim(Copy(Values, 1, I - 1))); - - If (Tag = 'ARTIST') then - begin - SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); - Inc(SongInfo.ID); //Inc SongID when header Information is added - end - Else If (Tag = 'TITLE') then - begin - SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); - Inc(SongInfo.ID); //Inc SongID when header Information is added - end; - end; - end - - //Parsing for weird "Die toten Hosen" Tags - Else If (Tag = '!--ARTIST:') OR (Tag = '!--ARTIST') then - begin //Comment, with Artist Info - I := Pos(':', Values); //Search for Delimiter - - Inc(SongInfo.ID); //Inc SongID when header Information is added - - SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); - end - - Else If (Tag = '!--TITLE:') OR (Tag = '!--TITLE') then - begin //Comment, with Artist Info - I := Pos(':', Values); //Search for Delimiter - - Inc(SongInfo.ID); //Inc SongID when header Information is added - - SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); - end - - Else If (Tag = '/MELODY') then - begin - ParserState := PS_None; - Exit; //Stop Parsing, Melody iTag ended - end - end; - - - PS_Sentence: begin //Search for Notes or eo Sentence - If (Tag = 'NOTE') then - begin //Found Note - //Get Values - MakeValuesArray; - - NoteType := NT_Normal; - For I := 0 to High(AValues) do - begin - If (AValues[I].Name = 'DURATION') then - begin - Duration := StrtoIntDef(AValues[I].Value, -1); - If (Duration < 0) then - begin - Result := False; - ErrorMessage := 'Can''t read duration from Note in Line: "' + Line + '"'; - Exit; - end; - end - Else If (AValues[I].Name = 'MIDINOTE') then - begin - Tone := StrtoIntDef(AValues[I].Value, 0); - end - Else If (AValues[I].Name = 'BONUS') AND (Uppercase(AValues[I].Value) = 'YES') then - begin - NoteType := NT_Golden; - end - Else If (AValues[I].Name = 'FREESTYLE') AND (Uppercase(AValues[I].Value) = 'YES') then - begin - NoteType := NT_Freestyle; - end - Else If (AValues[I].Name = 'LYRIC') then - begin - Lyric := AValues[I].Value; - - If (Length(Lyric) > 0) then - begin - If (Lyric = '-') then - Lyric[1] := Settings.DashReplacement; - - If (not BindLyrics) then - Lyric := ' ' + Lyric; - - - If (Length(Lyric) > 2) AND (Lyric[Length(Lyric)-1] = ' ') AND (Lyric[Length(Lyric)] = '-') then - begin //Between this and the next Lyric should be no space - BindLyrics := True; - SetLength(Lyric, Length(Lyric) - 2); - end - else - BindLyrics := False; //There should be a Space - end; - end; - end; - - //Add Note - I := SongInfo.CountSentences - 1; - - If (Length(Lyric) > 0) then - begin //Real note, no rest - //First Note of Sentence - If (Length(SongInfo.Sentences) < SongInfo.CountSentences) then - begin - SetLength(SongInfo.Sentences, SongInfo.CountSentences); - SetLength(SongInfo.Sentences[I].Notes, 0); - end; - - //First Note of Song -> Generate Gap - If (FirstNote) then - begin - //Calculate Gap - If (SongInfo.Header.Resolution <> 0) AND (SongInfo.Header.BPM <> 0) then - SongInfo.Header.Gap := Round(CurPosinSong / (SongInfo.Header.BPM*SongInfo.Header.Resolution) * 60000) - Else - begin - Result := False; - ErrorMessage := 'Can''t calculate Gap, no Resolution or BPM present.'; - Exit; - end; - - CurPosinSong := 0; //Start at 0, because Gap goes until here - Inc(SongInfo.ID); //Add Header Value therefore Inc - FirstNote := False; - end; - - J := Length(SongInfo.Sentences[I].Notes); - SetLength(SongInfo.Sentences[I].Notes, J + 1); - SongInfo.Sentences[I].Notes[J].Start := CurPosinSong; - SongInfo.Sentences[I].Notes[J].Duration := Duration; - SongInfo.Sentences[I].Notes[J].Tone := Tone; - SongInfo.Sentences[I].Notes[J].NoteTyp := NoteType; - SongInfo.Sentences[I].Notes[J].Lyric := Lyric; - - //Inc Pos in Song - Inc(CurPosInSong, Duration); - end - else - begin - //just change pos in Song - Inc(CurPosInSong, Duration); - end; - - - end - Else If (Tag = '/SENTENCE') then - begin //End of Sentence Tag - ParserState := PS_Melody; - - //Delete Sentence if no Note is Added - If (Length(SongInfo.Sentences) <> SongInfo.CountSentences) then - begin - SongInfo.CountSentences := Length(SongInfo.Sentences); - end; - end; - end; - end; - - end - else //Empty Line -> parsed succesful ;) - Result := true; -end; - -Function TParser.ParseConfigforEdition(const Filename: String): String; -var - txt: TStringlist; - I: Integer; - J, K: Integer; - S: String; -begin - Result := ''; - txt := TStringlist.Create; - try - txt.LoadFromFile(Filename); - - For I := 0 to txt.Count-1 do - begin - S := Trim(txt.Strings[I]); - J := Pos('', S); - - If (J <> 0) then - begin - Inc(J, 14); - K := Pos('', S); - If (K nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) - function GetPluginState(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Return PluginInfo of Plugin with Index(wParam)) - - end; - - {********************* - TtehPlugins - Class Represents the Plugins in Module Chain. - It Calls the Plugins Procs and Funcs - *********************} - TtehPlugins = class (TCoreModule) - private - PluginLoader: PPluginLoader; - public - //TCoreModule methods to inherit - constructor Create; override; - - procedure Info(const pInfo: PModuleInfo); override; - function Load: Boolean; override; - function Init: Boolean; override; - procedure DeInit; override; - end; - -const - {$IFDEF MSWINDOWS} - PluginFileExtension = '.dll'; - {$ENDIF} - {$IFDEF LINUX} - PluginFileExtension = '.so'; - {$ENDIF} - {$IFDEF DARWIN} - PluginFileExtension = '.dylib'; - {$ENDIF} - -implementation - -uses - UCore, - UPluginInterface, -{$IFDEF MSWINDOWS} - windows, -{$ELSE} - dynlibs, -{$ENDIF} - UMain, - SysUtils; - -{********************* - TPluginLoader - Implentation -*********************} - -//------------- -// function that gives some Infos about the Module to the Core -//------------- -procedure TPluginLoader.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'TPluginLoader'; - pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Searches for Plugins, loads and unloads them'; -end; - -//------------- -// Just the Constructor -//------------- -constructor TPluginLoader.Create; -begin - inherited; - - //Init PluginInterface - //Using Methods from UPluginInterface - PluginInterface.CreateHookableEvent := CreateHookableEvent; - PluginInterface.DestroyHookableEvent := DestroyHookableEvent; - PluginInterface.NotivyEventHooks := NotivyEventHooks; - PluginInterface.HookEvent := HookEvent; - PluginInterface.UnHookEvent := UnHookEvent; - PluginInterface.EventExists := EventExists; - - PluginInterface.CreateService := @CreateService; - PluginInterface.DestroyService := DestroyService; - PluginInterface.CallService := CallService; - PluginInterface.ServiceExists := ServiceExists; - - //UnSet Private Var - LoadingProcessFinished := False; -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 TPluginLoader.Load: Boolean; -begin - Result := True; - - try - //Start Searching for Plugins - BrowseDir(PluginPath); - except - Result := False; - Core.ReportError(integer(PChar('Error Browsing and Loading.')), PChar('TPluginLoader')); - end; -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 TPluginLoader.Init: Boolean; -begin - //Just set Prvate Var to true. - LoadingProcessFinished := True; - Result := True; -end; - -//------------- -//Is Called if this Module has been Inited and there is a Exit. -//Deinit is in backwards Initing Order -//------------- -procedure TPluginLoader.DeInit; -var - I: integer; -begin - //Force DeInit - //If some Plugins aren't DeInited for some Reason o0 - for I := 0 to High(Plugins) do - begin - if (Plugins[I].State < 4) then - FreePlugin(I); - end; - - //Nothing to do here. Core will remove the Hooks -end; - -//------------- -//Is Called if this Module will be unloaded and has been created -//Should be used to Free Memory -//------------- -Destructor TPluginLoader.Destroy; -begin - //Just save some Memory if it wasn't done now.. - SetLength(Plugins, 0); - inherited; -end; - -//-------------- -// Browses the Path at _Path_ for Plugins -//-------------- -procedure TPluginLoader.BrowseDir(Path: String); -var - SR: TSearchRec; -begin - //Search for other Dirs to Browse - if FindFirst(Path + '*', faDirectory, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - BrowseDir(Path + Sr.Name + PathDelim); - until FindNext(SR) <> 0; - end; - FindClose(SR); - - //Search for Plugins at Path - if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then - begin - repeat - AddPlugin(Path + SR.Name); - until FindNext(SR) <> 0; - end; - FindClose(SR); -end; - -//-------------- -// If Plugin Exists: Index of Plugin, else -1 -//-------------- -function TPluginLoader.PluginExists(Name: String): integer; -var - I: integer; -begin - Result := -1; - - if (Length(Name) <= 32 { =>Length(TUS_PluginInfo.Name)}) then - begin - for I := 0 to High(Plugins) do - if (Plugins[I].Info.Name = Name) then - begin //Found the Plugin - Result := I; - Break; - end; - end; -end; - -//-------------- -// Adds Plugin to the Array -//-------------- -procedure TPluginLoader.AddPlugin(Filename: String); -var - hLib: THandle; - PInfo: Proc_PluginInfo; - Info: TUS_PluginInfo; - PluginID: integer; -begin - if (FileExists(Filename)) then - begin //Load Libary - hLib := LoadLibrary(PChar(Filename)); - if (hLib <> 0) then - begin //Try to get Address of the Info Proc - PInfo := GetProcAddress (hLib, PChar('USPlugin_Info')); - if (@PInfo <> nil) then - begin - Info.cbSize := SizeOf(TUS_PluginInfo); - - try //Call Info Proc - PInfo(@Info); - except - Info.Name := ''; - Core.ReportError(integer(PChar('Error getting Plugin Info: ' + Filename)), PChar('TPluginLoader')); - end; - - //Is Name set ? - if (Trim(Info.Name) <> '') then - begin - PluginID := PluginExists(Info.Name); - - if (PluginID > 0) and (Plugins[PluginID].State >=4) then - PluginID := -1; - - if (PluginID = -1) then - begin - //Add new item to array - PluginID := Length(Plugins); - SetLength(Plugins, PluginID + 1); - - //Fill with Info: - Plugins[PluginID].Info := Info; - Plugins[PluginID].State := 0; - Plugins[PluginID].Path := Filename; - Plugins[PluginID].NeedsDeInit := False; - Plugins[PluginID].hLib := hLib; - - //Try to get Procs - Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); - Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); - Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); - - if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then - begin - Plugins[PluginID].State := 255; - FreeLibrary(hLib); - Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); - end; - - //Emulate loading process if this Plugin is loaded to late - if (LoadingProcessFinished) then - begin - CallLoad(PluginID); - CallInit(PluginID); - end; - end - else if (LoadingProcessFinished = False) then - begin - if (Plugins[PluginID].Info.Version < Info.Version) then - begin //Found newer Version of this Plugin - Core.ReportDebug(integer(PChar('Found a newer Version of Plugin: ' + String(Info.Name))), PChar('TPluginLoader')); - - //Unload Old Plugin - UnloadPlugin(PluginID, nil); - - //Fill with new Info - Plugins[PluginID].Info := Info; - Plugins[PluginID].State := 0; - Plugins[PluginID].Path := Filename; - Plugins[PluginID].NeedsDeInit := False; - Plugins[PluginID].hLib := hLib; - - //Try to get Procs - Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); - Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); - Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); - - if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then - begin - FreeLibrary(hLib); - Plugins[PluginID].State := 255; - Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); - end; - end - else - begin //Newer Version already loaded - FreeLibrary(hLib); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(integer(PChar('Plugin with this Name already exists: ' + String(Info.Name))), PChar('TPluginLoader')); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(integer(PChar('No name reported: ' + Filename)), PChar('TPluginLoader')); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(integer(PChar('Can''t find Info procedure: ' + Filename)), PChar('TPluginLoader')); - end; - end - else - Core.ReportError(integer(PChar('Can''t load Plugin Libary: ' + Filename)), PChar('TPluginLoader')); - end; -end; - -//-------------- -// Calls Load Func of Plugin with the given Index -//-------------- -function TPluginLoader.CallLoad(Index: Cardinal): integer; -begin - Result := -2; - if(Index < Length(Plugins)) then - begin - if (@Plugins[Index].Procs.Load <> nil) and (Plugins[Index].State = 0) then - begin - try - Result := Plugins[Index].Procs.Load(@PluginInterface); - except - Result := -3; - End; - - if (Result = 0) then - Plugins[Index].State := 1 - else - begin - FreePlugin(Index); - Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling Load function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); - end; - end; - end; -end; - -//-------------- -// Calls Init Func of Plugin with the given Index -//-------------- -function TPluginLoader.CallInit(Index: Cardinal): integer; -begin - Result := -2; - if(Index < Length(Plugins)) then - begin - if (@Plugins[Index].Procs.Init <> nil) and (Plugins[Index].State = 1) then - begin - try - Result := Plugins[Index].Procs.Init(@PluginInterface); - except - Result := -3; - End; - - if (Result = 0) then - begin - Plugins[Index].State := 2; - Plugins[Index].NeedsDeInit := True; - end - else - begin - FreePlugin(Index); - Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling Init function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); - end; - end; - end; -end; - -//-------------- -// Calls DeInit Proc of Plugin with the given Index -//-------------- -procedure TPluginLoader.CallDeInit(Index: Cardinal); -begin - if(Index < Length(Plugins)) then - begin - if (Plugins[Index].State < 4) then - begin - if (@Plugins[Index].Procs.DeInit <> nil) and (Plugins[Index].NeedsDeInit) then - try - Plugins[Index].Procs.DeInit(@PluginInterface); - except - - End; - - //Don't forget to remove Services and Subscriptions by this Plugin - Core.Hooks.DelbyOwner(-1 - Index); - - FreePlugin(Index); - end; - end; -end; - -//-------------- -// Frees all Plugin Sources (Procs and Handles) - Helper for Deiniting Functions -//-------------- -procedure TPluginLoader.FreePlugin(Index: Cardinal); -begin - Plugins[Index].State := 4; - Plugins[Index].Procs.Load := nil; - Plugins[Index].Procs.Init := nil; - Plugins[Index].Procs.DeInit := nil; - - if (Plugins[Index].hLib <> 0) then - FreeLibrary(Plugins[Index].hLib); -end; - - - -//-------------- -// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin -//-------------- -function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; -var - Index: integer; - sFile: String; -begin - Result := -1; - sFile := ''; - //lParam is ID - if (lParam = nil) then - begin - Index := wParam; - end - else - begin //lParam is PChar - try - sFile := String(PChar(lParam)); - Index := PluginExists(sFile); - if (Index < 0) And FileExists(sFile) then - begin //Is Filename - AddPlugin(sFile); - Result := Plugins[High(Plugins)].State; - end; - except - Index := -2; - end; - end; - - - if (Index >= 0) and (Index < Length(Plugins)) then - begin - AddPlugin(Plugins[Index].Path); - Result := Plugins[Index].State; - end; -end; - -//-------------- -// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin -//-------------- -function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; -var - Index: integer; - sName: String; -begin - Result := -1; - //lParam is ID - if (lParam = nil) then - begin - Index := wParam; - end - else - begin //wParam is PChar - try - sName := String(PChar(lParam)); - Index := PluginExists(sName); - except - Index := -2; - end; - end; - - - if (Index >= 0) and (Index < Length(Plugins)) then - CallDeInit(Index) -end; - -//-------------- -// if wParam = -1 then (if lParam = nil then get length of Moduleinfo Array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) -//-------------- -function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; -var I: integer; -begin - Result := 0; - if (wParam > 0) then - begin //Get Info of 1 Plugin - if (lParam <> nil) and (wParam < Length(Plugins)) then - begin - try - Result := 1; - PUS_PluginInfo(lParam)^ := Plugins[wParam].Info; - except - - End; - end; - end - else if (lParam = nil) then - begin //Get Length of Plugin (Info) Array - Result := Length(Plugins); - end - else //Write PluginInfo Array to Address in lParam - begin - try - for I := 0 to high(Plugins) do - PAUS_PluginInfo(lParam)^[I] := Plugins[I].Info; - Result := Length(Plugins); - except - Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader')); - End; - end; - -end; - -//-------------- -// if wParam = -1 then (if lParam = nil then get length of Plugin State Array. if lparam <> nil then write array of Byte to address at lparam) else (Return State of Plugin with Index(wParam)) -//-------------- -function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; -var I: integer; -begin - Result := -1; - if (wParam > 0) then - begin //Get State of 1 Plugin - if (wParam < Length(Plugins)) then - begin - Result := Plugins[wParam].State; - end; - end - else if (lParam = nil) then - begin //Get Length of Plugin (Info) Array - Result := Length(Plugins); - end - else //Write PluginInfo Array to Address in lParam - begin - try - for I := 0 to high(Plugins) do - Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; - Result := Length(Plugins); - except - Core.ReportError(integer(PChar('Could not write PluginState Array')), PChar('TPluginLoader')); - End; - end; -end; - - -{********************* - TtehPlugins - Implentation -*********************} - -//------------- -// function that gives some Infos about the Module to the Core -//------------- -procedure TtehPlugins.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'TtehPlugins'; - pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Module executing the Plugins!'; -end; - -//------------- -// Just the Constructor -//------------- -constructor TtehPlugins.Create; -begin - inherited; - PluginLoader := nil; -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 TtehPlugins.Load: Boolean; -var - i: integer; //Counter - CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute -begin - //Get Pointer to PluginLoader - PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader')); - if (PluginLoader = nil) then - begin - Result := false; - Core.ReportError(integer(PChar('Could not get Pointer to PluginLoader')), PChar('TtehPlugins')); - end - else - begin - Result := true; - - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start Loading the Plugins - for i := 0 to High(PluginLoader.Plugins) do - begin - Core.CurExecuted := -1 - i; - - try - //Unload Plugin if not correctly Executed - if (PluginLoader.CallLoad(i) <> 0) then - begin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 254; //Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin Selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end - else - begin - Core.ReportDebug(integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end; - except - //Plugin could not be loaded. - // => Show Error Message, then ShutDown Plugin - on E: Exception do - begin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 255; //Plugin causes Error - Core.ReportError(integer(PChar('Plugin causes Error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins')); - end; - end; - end; - - //Reset CurExecuted - Core.CurExecuted := CurExecutedBackup; - end; -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 TtehPlugins.Init: Boolean; -var - i: integer; //Counter - CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute -begin - Result := true; - - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start Loading the Plugins - for i := 0 to High(PluginLoader.Plugins) do - try - Core.CurExecuted := -1 - i; - - //Unload Plugin if not correctly Executed - if (PluginLoader.CallInit(i) <> 0) then - begin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 254; //Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin Selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end - else - Core.ReportDebug(integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - except - //Plugin could not be loaded. - // => Show Error Message, then ShutDown Plugin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 255; //Plugin causes Error - Core.ReportError(integer(PChar('Plugin causes Error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end; - - //Reset CurExecuted - Core.CurExecuted := CurExecutedBackup; -end; - -//------------- -//Is Called if this Module has been Inited and there is a Exit. -//Deinit is in backwards Initing Order -//------------- -procedure TtehPlugins.DeInit; -var - i: integer; //Counter - CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute -begin - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start Loop - - for i := 0 to High(PluginLoader.Plugins) do - begin - try - //DeInit Plugin - PluginLoader.CallDeInit(i); - except - end; - end; - - //Reset CurExecuted - Core.CurExecuted := CurExecutedBackup; -end; - -end. diff --git a/src/classes0/TextGL.pas b/src/classes0/TextGL.pas new file mode 100644 index 00000000..f7b3ac95 --- /dev/null +++ b/src/classes0/TextGL.pas @@ -0,0 +1,462 @@ +unit TextGL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + gl, + SDL, + UTexture, + Classes, +// SDL_ttf, + ULog; + +procedure BuildFont; // build our bitmap font +procedure KillFont; // delete the font +function glTextWidth(text: PChar): real; // returns text width +procedure glPrintLetter(letter: char); +procedure glPrint(text: pchar); // custom GL "Print" routine +procedure SetFontPos(X, Y: real); // sets X and Y +procedure SetFontZ(Z: real); // sets Z +procedure SetFontSize(Size: real); +procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc) +procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) +procedure SetFontAspectW(Aspect: real); +procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection +procedure SetFontBlend(Enable: boolean); // enables/disables blending + +//function NextPowerOfTwo(Value: integer): integer; +// Checks if the ttf exists, if yes then a SDL_ttf is returned +//function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; +// Does the renderstuff, color is in $ffeecc style +//function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal):PSDL_Surface; + +type + TTextGL = record + X: real; + Y: real; + Z: real; + Text: string; + Size: real; + ColR: real; + ColG: real; + ColB: real; + end; + + PFont = ^TFont; + TFont = record + Tex: TTexture; + Width: array[0..255] of byte; + AspectW: real; + Centered: boolean; + Outline: real; + Italic: boolean; + Reflection: boolean; + ReflectionSpacing: real; + Blend: boolean; + end; + + +var + Fonts: array of TFont; + ActFont: integer; + + +implementation + +uses + UMain, + UCommon, + SysUtils, + UGraphic; + +var + // Colours for the reflection + TempColor: array[0..3] of GLfloat; + +procedure LoadBitmapFontInfo(aID : integer; const aType, aResourceName: string); +var + stream: TStream; +begin + stream := GetResourceStream(aResourceName, aType); + if (not assigned(stream)) then + begin + Log.LogError('Unknown font['+ inttostr(aID) +': '+aType+']', 'loadfont'); + Exit; + end; + try + stream.Read(Fonts[ aID ].Width, 256); + except + Log.LogError('Error while reading font['+ inttostr(aID) +': '+aType+']', 'loadfont'); + end; + stream.Free; +end; + +// Builds bitmap fonts +procedure BuildFont; +var + Count: integer; +begin + ActFont := 0; + + SetLength(Fonts, 5); + Fonts[0].Tex := Texture.LoadTexture(true, 'Font', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[0].Tex.H := 30; + Fonts[0].AspectW := 0.9; + Fonts[0].Outline := 0; + + Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[1].Tex.H := 30; + Fonts[1].AspectW := 1; + Fonts[1].Outline := 0; + + Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[2].Tex.H := 30; + Fonts[2].AspectW := 0.95; + Fonts[2].Outline := 5; + + Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[3].Tex.H := 30; + Fonts[3].AspectW := 0.95; + Fonts[3].Outline := 4; + +{ Fonts[4].Tex := Texture.LoadTexture('FontO', TEXTURE_TYPE_TRANSPARENT, 0); // for score screen + Fonts[4].Tex.H := 30; + Fonts[4].AspectW := 0.95; + Fonts[4].Done := -1; + Fonts[4].Outline := 5;} + + // load font info + LoadBitmapFontInfo( 0, 'FNT', 'Font'); + LoadBitmapFontInfo( 1, 'FNT', 'FontB'); + LoadBitmapFontInfo( 2, 'FNT', 'FontO'); + LoadBitmapFontInfo( 3, 'FNT', 'FontO2'); + + for Count := 0 to 255 do + Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2; + + for Count := 0 to 255 do + Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2; + + for Count := 0 to 255 do + Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1; + +{ for Count := 0 to 255 do + Fonts[4].Width[Count] := Fonts[4].Width[Count] div 2 + 2;} + + // enable blending by default + for Count := 0 to High(Fonts) do + Fonts[Count].Blend := true; +end; + +// Deletes the font +procedure KillFont; +begin + // delete all characters + //glDeleteLists(..., 256); +end; + +function glTextWidth(text: pchar): real; +var + Letter: char; + i: integer; +begin + Result := 0; + for i := 0 to Length(text) -1 do + begin + Letter := Text[i]; + Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; + end; +end; + +procedure glPrintLetter(Letter: char); +var + TexX, TexY: real; + TexR, TexB: real; + TexHeight: real; + FWidth: real; + PL, PT: real; + PR, PB: real; + XItal: real; // X shift for italic type letter + ReflectionSpacing: real; // Distance of the reflection + Font: PFont; + Tex: PTexture; +begin + Font := @Fonts[ActFont]; + Tex := @Font.Tex; + + FWidth := Font.Width[Ord(Letter)]; + + Tex.W := FWidth * (Tex.H/30) * Font.AspectW; + + // set texture positions + TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Font.Outline/1024; + TexY := (ord(Letter) div 16) * 1/16 + 2/1024; + TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Font.Outline/1024; + TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; + + TexHeight := TexB - TexY; + + // set vector positions + PL := Tex.X - Font.Outline * (Tex.H/30) * Font.AspectW /2; + PT := Tex.Y; + PR := PL + Tex.W + Font.Outline * (Tex.H/30) * Font.AspectW; + PB := PT + Tex.H; + + if (not Font.Italic) then + XItal := 0 + else + XItal := 12; + + if (Font.Blend) then + begin + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + end; + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, Tex.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); + glEnd; + + // Reflection + // Yes it would make sense to put this in an extra procedure, + // but this works, doesn't take much lines, and is almost lightweight + if Font.Reflection then + begin + ReflectionSpacing := Font.ReflectionSpacing + Tex.H/2; + + glDepthRange(0, 10); + glDepthFunc(GL_LEQUAL); + glEnable(GL_DEPTH_TEST); + + glBegin(GL_QUADS); + glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); + glTexCoord2f(TexX, TexY + TexHeight/2); + glVertex3f(PL, PB + ReflectionSpacing - Tex.H/2, Tex.z); + + glColor4f(TempColor[0], TempColor[1], TempColor[2], Tex.Alpha-0.3); + glTexCoord2f(TexX, TexB ); + glVertex3f(PL + XItal, PT + ReflectionSpacing, Tex.z); + + glTexCoord2f(TexR, TexB ); + glVertex3f(PR + XItal, PT + ReflectionSpacing, Tex.z); + + glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); + glTexCoord2f(TexR, TexY + TexHeight/2); + glVertex3f(PR, PB + ReflectionSpacing - Tex.H/2, Tex.z); + glEnd; + + glDisable(GL_DEPTH_TEST); + end; // reflection + + glDisable(GL_TEXTURE_2D); + if (Font.Blend) then + glDisable(GL_BLEND); + + Tex.X := Tex.X + Tex.W; + + //write the colour back + glColor4fv(@TempColor); +end; + +// Custom GL "Print" Routine +procedure glPrint(Text: PChar); +var + Pos: integer; +begin + // if there is no text do nothing + if ((Text = nil) or (Text = '')) then + Exit; + + //Save the actual color and alpha (for reflection) + glGetFloatv(GL_CURRENT_COLOR, @TempColor); + + for Pos := 0 to Length(Text) - 1 do + begin + glPrintLetter(Text[Pos]); + end; +end; + +procedure SetFontPos(X, Y: real); +begin + Fonts[ActFont].Tex.X := X; + Fonts[ActFont].Tex.Y := Y; +end; + +procedure SetFontZ(Z: real); +begin + Fonts[ActFont].Tex.Z := Z; +end; + +procedure SetFontSize(Size: real); +begin + Fonts[ActFont].Tex.H := 30 * (Size/10); +end; + +procedure SetFontStyle(Style: integer); +begin + ActFont := Style; +end; + +procedure SetFontItalic(Enable: boolean); +begin + Fonts[ActFont].Italic := Enable; +end; + +procedure SetFontAspectW(Aspect: real); +begin + Fonts[ActFont].AspectW := Aspect; +end; + +procedure SetFontReflection(Enable: boolean; Spacing: real); +begin + Fonts[ActFont].Reflection := Enable; + Fonts[ActFont].ReflectionSpacing := Spacing; +end; + +procedure SetFontBlend(Enable: boolean); +begin + Fonts[ActFont].Blend := Enable; +end; + + + + +(* + I uncommented this, because it was some kind of after hour hack together with blindy +it's actually just a prove of concept, as it's having some flaws +- instead nice and clean ttf code should be placed here :) + +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} + +function NextPowerOfTwo(Value: integer): integer; +begin + Result:= 1; +{$IF Defined(CPUX86_64)} + asm + mov rcx, -1 + bsr rcx, Value + inc rcx + shl Result, cl + end; +{$ELSEIF Defined(CPU386) or Defined(CPUI386)} + asm + mov ecx, -1 + bsr ecx, Value + inc ecx + shl Result, cl + end; +{$ELSE} + while (Result <= Value) do + Result := 2 * Result; +{$IFEND} +end; + +function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; +begin + if (FileExists(FileName)) then + begin + Result := TTF_OpenFont( FileName, PointSize ); + end + else + begin + Log.LogStatus('ERROR Could not find font in ' + FileName , ''); + ShowMessage( 'ERROR Could not find font in ' + FileName ); + Result := nil; + end; +end; + +function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surface; +var + clr : TSDL_color; +begin + clr.r := ((Color and $ff0000) shr 16 ) div 255; + clr.g := ((Color and $ff00 ) shr 8 ) div 255; + clr.b := ( Color and $ff ) div 255 ; + + result := TTF_RenderText_Blended( font, text, cLr); +end; + +procedure printrandomtext(); +var + stext,intermediary : PSDL_surface; + clrFg, clrBG : TSDL_color; + texture : Gluint; + font : PTTF_Font; + w,h : integer; +begin + + font := LoadFont('fonts\comicbd.ttf', 42); + + clrFg.r := 255; + clrFg.g := 255; + clrFg.b := 255; + clrFg.unused := 255; + + clrBg.r := 255; + clrbg.g := 0; + clrbg.b := 255; + clrbg.unused := 0; + + sText := RenderText(font, 'katzeeeeeee', $fe198e); + //sText := TTF_RenderText_Blended( font, 'huuuuuuuuuund', clrFG); + + // Convert the rendered text to a known format + w := nextpoweroftwo(sText.w); + h := nextpoweroftwo(sText.h); + + intermediary := SDL_CreateRGBSurface(0, w, h, 32, + $000000ff, $0000ff00, $00ff0000, $ff000000); + + SDL_SetAlpha(intermediary, 0, 255); + SDL_SetAlpha(sText, 0, 255); + SDL_BlitSurface(sText, nil, intermediary, nil); + + glGenTextures(1, @texture); + + glBindTexture(GL_TEXTURE_2D, texture); + + glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels); + + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glBindTexture(GL_TEXTURE_2D, texture); + glColor4f(1, 0, 1, 1); + + glbegin(gl_quads); + glTexCoord2f(0, 0); glVertex2f(200 , 300 ); + glTexCoord2f(0, sText.h/h); glVertex2f(200 , 300 + sText.h); + glTexCoord2f(sText.w/w, sText.h/h); glVertex2f(200 + sText.w, 300 + sText.h); + glTexCoord2f(sText.w/w, 0); glVertex2f(200 + sText.w, 300 ); + glEnd; + glfinish(); + glDisable(GL_BLEND); + gldisable(gl_texture_2d); + + SDL_FreeSurface(sText); + SDL_FreeSurface(intermediary); + glDeleteTextures(1, @texture); + TTF_CloseFont(font); + +end; +*) + + +end. diff --git a/src/classes0/UAudioConverter.pas b/src/classes0/UAudioConverter.pas new file mode 100644 index 00000000..5647f27b --- /dev/null +++ b/src/classes0/UAudioConverter.pas @@ -0,0 +1,458 @@ +unit UAudioConverter; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UMusic, + ULog, + ctypes, + {$IFDEF UseSRCResample} + samplerate, + {$ENDIF} + {$IFDEF UseFFmpegResample} + avcodec, + {$ENDIF} + UMediaCore_SDL, + sdl, + SysUtils, + Math; + +type + {* + * Notes: + * - 44.1kHz to 48kHz conversion or vice versa is not supported + * by SDL 1.2 (will be introduced in 1.3). + * No conversion takes place in this cases. + * This is because SDL just converts differences in powers of 2. + * So the result might not be that accurate. + * This IS audible (voice to high/low) and it needs good synchronization + * with the video or the lyrics timer. + * - float<->int16 conversion is not supported (will be part of 1.3) and + * SDL (<1.3) is not capable of handling floats at all. + * -> Using FFmpeg or libsamplerate for resampling is preferred. + * Use SDL for channel and format conversion only. + *} + TAudioConverter_SDL = class(TAudioConverter) + private + cvt: TSDL_AudioCVT; + public + function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; + destructor Destroy(); override; + + function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; + function GetOutputBufferSize(InputSize: integer): integer; override; + function GetRatio(): double; override; + end; + + {$IFDEF UseFFmpegResample} + // Note: FFmpeg seems to be using "kaiser windowed sinc" for resampling, so + // the quality should be good. + TAudioConverter_FFmpeg = class(TAudioConverter) + private + // TODO: use SDL for multi-channel->stereo and format conversion + ResampleContext: PReSampleContext; + Ratio: double; + public + function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; + destructor Destroy(); override; + + function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; + function GetOutputBufferSize(InputSize: integer): integer; override; + function GetRatio(): double; override; + end; + {$ENDIF} + + {$IFDEF UseSRCResample} + TAudioConverter_SRC = class(TAudioConverter) + private + ConverterState: PSRC_STATE; + ConversionData: SRC_DATA; + FormatConverter: TAudioConverter; + public + function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; + destructor Destroy(); override; + + function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; + function GetOutputBufferSize(InputSize: integer): integer; override; + function GetRatio(): double; override; + end; + + // Note: SRC (=libsamplerate) provides several converters with different quality + // speed trade-offs. The SINC-types are slow but offer best quality. + // The SRC_SINC_* converters are too slow for realtime conversion, + // (SRC_SINC_FASTEST is approx. ten times slower than SRC_LINEAR) resulting + // in audible clicks and pops. + // SRC_LINEAR is very fast and should have a better quality than SRC_ZERO_ORDER_HOLD + // because it interpolates the samples. Normal "non-audiophile" users should not + // be able to hear a difference between the SINC_* ones and LINEAR. Especially + // if people sing along with the song. + // But FFmpeg might offer a better quality/speed ratio than SRC_LINEAR. + const + SRC_CONVERTER_TYPE = SRC_LINEAR; + {$ENDIF} + +implementation + +function TAudioConverter_SDL.Init(srcFormatInfo: TAudioFormatInfo; dstFormatInfo: TAudioFormatInfo): boolean; +var + srcFormat: UInt16; + dstFormat: UInt16; +begin + inherited Init(SrcFormatInfo, DstFormatInfo); + + Result := false; + + if (not ConvertAudioFormatToSDL(srcFormatInfo.Format, srcFormat) or + not ConvertAudioFormatToSDL(dstFormatInfo.Format, dstFormat)) then + begin + Log.LogError('Audio-format not supported by SDL', 'TSoftMixerPlaybackStream.InitFormatConversion'); + Exit; + end; + + if (SDL_BuildAudioCVT(@cvt, + srcFormat, srcFormatInfo.Channels, Round(srcFormatInfo.SampleRate), + dstFormat, dstFormatInfo.Channels, Round(dstFormatInfo.SampleRate)) = -1) then + begin + Log.LogError(SDL_GetError(), 'TSoftMixerPlaybackStream.InitFormatConversion'); + Exit; + end; + + Result := true; +end; + +destructor TAudioConverter_SDL.Destroy(); +begin + // nothing to be done here + inherited; +end; + +(* + * Returns the size of the output buffer. This might be bigger than the actual + * size of resampled audio data. + *) +function TAudioConverter_SDL.GetOutputBufferSize(InputSize: integer): integer; +begin + // Note: len_ratio must not be used here. Even if the len_ratio is 1.0, len_mult might be 2. + // Example: 44.1kHz/mono to 22.05kHz/stereo -> len_ratio=1, len_mult=2 + Result := InputSize * cvt.len_mult; +end; + +function TAudioConverter_SDL.GetRatio(): double; +begin + Result := cvt.len_ratio; +end; + +function TAudioConverter_SDL.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; +begin + Result := -1; + + if (InputSize <= 0) then + begin + // avoid div-by-zero problems + if (InputSize = 0) then + Result := 0; + Exit; + end; + + // OutputBuffer is always bigger than or equal to InputBuffer + Move(InputBuffer[0], OutputBuffer[0], InputSize); + cvt.buf := PUint8(OutputBuffer); + cvt.len := InputSize; + if (SDL_ConvertAudio(@cvt) = -1) then + Exit; + + Result := cvt.len_cvt; +end; + + +{$IFDEF UseFFmpegResample} + +function TAudioConverter_FFmpeg.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; +begin + inherited Init(SrcFormatInfo, DstFormatInfo); + + Result := false; + + // Note: ffmpeg does not support resampling for more than 2 input channels + + if (srcFormatInfo.Format <> asfS16) then + begin + Log.LogError('Unsupported format', 'TAudioConverter_FFmpeg.Init'); + Exit; + end; + + // TODO: use SDL here + if (srcFormatInfo.Format <> dstFormatInfo.Format) then + begin + Log.LogError('Incompatible formats', 'TAudioConverter_FFmpeg.Init'); + Exit; + end; + + ResampleContext := audio_resample_init( + dstFormatInfo.Channels, srcFormatInfo.Channels, + Round(dstFormatInfo.SampleRate), Round(srcFormatInfo.SampleRate)); + if (ResampleContext = nil) then + begin + Log.LogError('audio_resample_init() failed', 'TAudioConverter_FFmpeg.Init'); + Exit; + end; + + // calculate ratio + Ratio := (dstFormatInfo.Channels / srcFormatInfo.Channels) * + (dstFormatInfo.SampleRate / srcFormatInfo.SampleRate); + + Result := true; +end; + +destructor TAudioConverter_FFmpeg.Destroy(); +begin + if (ResampleContext <> nil) then + audio_resample_close(ResampleContext); + inherited; +end; + +function TAudioConverter_FFmpeg.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; +var + InputSampleCount: integer; + OutputSampleCount: integer; +begin + Result := -1; + + if (InputSize <= 0) then + begin + // avoid div-by-zero in audio_resample() + if (InputSize = 0) then + Result := 0; + Exit; + end; + + InputSampleCount := InputSize div SrcFormatInfo.FrameSize; + OutputSampleCount := audio_resample( + ResampleContext, PSmallInt(OutputBuffer), PSmallInt(InputBuffer), + InputSampleCount); + if (OutputSampleCount = -1) then + begin + Log.LogError('audio_resample() failed', 'TAudioConverter_FFmpeg.Convert'); + Exit; + end; + Result := OutputSampleCount * DstFormatInfo.FrameSize; +end; + +function TAudioConverter_FFmpeg.GetOutputBufferSize(InputSize: integer): integer; +begin + Result := Ceil(InputSize * GetRatio()); +end; + +function TAudioConverter_FFmpeg.GetRatio(): double; +begin + Result := Ratio; +end; + +{$ENDIF} + + +{$IFDEF UseSRCResample} + +function TAudioConverter_SRC.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; +var + error: integer; + TempSrcFormatInfo: TAudioFormatInfo; + TempDstFormatInfo: TAudioFormatInfo; +begin + inherited Init(SrcFormatInfo, DstFormatInfo); + + Result := false; + + FormatConverter := nil; + + // SRC does not handle channel or format conversion + if ((SrcFormatInfo.Channels <> DstFormatInfo.Channels) or + not (SrcFormatInfo.Format in [asfS16, asfFloat])) then + begin + // SDL can not convert to float, so we have to convert to SInt16 first + TempSrcFormatInfo := TAudioFormatInfo.Create( + SrcFormatInfo.Channels, SrcFormatInfo.SampleRate, SrcFormatInfo.Format); + TempDstFormatInfo := TAudioFormatInfo.Create( + DstFormatInfo.Channels, SrcFormatInfo.SampleRate, asfS16); + + // init format/channel conversion + FormatConverter := TAudioConverter_SDL.Create(); + if (not FormatConverter.Init(TempSrcFormatInfo, TempDstFormatInfo)) then + begin + Log.LogError('Unsupported input format', 'TAudioConverter_SRC.Init'); + FormatConverter.Free; + // exit after the format-info is freed + end; + + // this info was copied so we do not need it anymore + TempSrcFormatInfo.Free; + TempDstFormatInfo.Free; + + // leave if the format is not supported + if (not assigned(FormatConverter)) then + Exit; + + // adjust our copy of the input audio-format for SRC conversion + Self.SrcFormatInfo.Channels := DstFormatInfo.Channels; + Self.SrcFormatInfo.Format := asfS16; + end; + + if ((DstFormatInfo.Format <> asfS16) and + (DstFormatInfo.Format <> asfFloat)) then + begin + Log.LogError('Unsupported output format', 'TAudioConverter_SRC.Init'); + Exit; + end; + + ConversionData.src_ratio := DstFormatInfo.SampleRate / SrcFormatInfo.SampleRate; + if (src_is_valid_ratio(ConversionData.src_ratio) = 0) then + begin + Log.LogError('Invalid samplerate ratio', 'TAudioConverter_SRC.Init'); + Exit; + end; + + ConverterState := src_new(SRC_CONVERTER_TYPE, DstFormatInfo.Channels, @error); + if (ConverterState = nil) then + begin + Log.LogError('src_new() failed: ' + src_strerror(error), 'TAudioConverter_SRC.Init'); + Exit; + end; + + Result := true; +end; + +destructor TAudioConverter_SRC.Destroy(); +begin + if (ConverterState <> nil) then + src_delete(ConverterState); + FormatConverter.Free; + inherited; +end; + +function TAudioConverter_SRC.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; +var + FloatInputBuffer: PSingle; + FloatOutputBuffer: PSingle; + TempBuffer: PChar; + TempSize: integer; + NumSamples: integer; + OutputSize: integer; + error: integer; +begin + Result := -1; + + TempBuffer := nil; + + // format conversion with external converter (to correct number of channels and format) + if (assigned(FormatConverter)) then + begin + TempSize := FormatConverter.GetOutputBufferSize(InputSize); + GetMem(TempBuffer, TempSize); + InputSize := FormatConverter.Convert(InputBuffer, TempBuffer, InputSize); + InputBuffer := TempBuffer; + end; + + if (InputSize <= 0) then + begin + // avoid div-by-zero problems + if (InputSize = 0) then + Result := 0; + if (TempBuffer <> nil) then + FreeMem(TempBuffer); + Exit; + end; + + if (SrcFormatInfo.Format = asfFloat) then + begin + FloatInputBuffer := PSingle(InputBuffer); + end else begin + NumSamples := InputSize div AudioSampleSize[SrcFormatInfo.Format]; + GetMem(FloatInputBuffer, NumSamples * SizeOf(Single)); + src_short_to_float_array(PCshort(InputBuffer), PCfloat(FloatInputBuffer), NumSamples); + end; + + // calculate approx. output size + OutputSize := Ceil(InputSize * ConversionData.src_ratio); + + if (DstFormatInfo.Format = asfFloat) then + begin + FloatOutputBuffer := PSingle(OutputBuffer); + end else begin + NumSamples := OutputSize div AudioSampleSize[DstFormatInfo.Format]; + GetMem(FloatOutputBuffer, NumSamples * SizeOf(Single)); + end; + + with ConversionData do + begin + data_in := PCFloat(FloatInputBuffer); + input_frames := InputSize div SrcFormatInfo.FrameSize; + data_out := PCFloat(FloatOutputBuffer); + output_frames := OutputSize div DstFormatInfo.FrameSize; + // TODO: set this to 1 at end of file-playback + end_of_input := 0; + end; + + error := src_process(ConverterState, @ConversionData); + if (error <> 0) then + begin + Log.LogError(src_strerror(error), 'TAudioConverter_SRC.Convert'); + if (SrcFormatInfo.Format <> asfFloat) then + FreeMem(FloatInputBuffer); + if (DstFormatInfo.Format <> asfFloat) then + FreeMem(FloatOutputBuffer); + if (TempBuffer <> nil) then + FreeMem(TempBuffer); + Exit; + end; + + if (SrcFormatInfo.Format <> asfFloat) then + FreeMem(FloatInputBuffer); + + if (DstFormatInfo.Format <> asfFloat) then + begin + NumSamples := ConversionData.output_frames_gen * DstFormatInfo.Channels; + src_float_to_short_array(PCfloat(FloatOutputBuffer), PCshort(OutputBuffer), NumSamples); + FreeMem(FloatOutputBuffer); + end; + + // free format conversion buffer if used + if (TempBuffer <> nil) then + FreeMem(TempBuffer); + + if (assigned(FormatConverter)) then + InputSize := ConversionData.input_frames_used * FormatConverter.SrcFormatInfo.FrameSize + else + InputSize := ConversionData.input_frames_used * SrcFormatInfo.FrameSize; + + // set result to output size according to SRC + Result := ConversionData.output_frames_gen * DstFormatInfo.FrameSize; +end; + +function TAudioConverter_SRC.GetOutputBufferSize(InputSize: integer): integer; +begin + Result := Ceil(InputSize * GetRatio()); +end; + +function TAudioConverter_SRC.GetRatio(): double; +begin + // if we need additional channel/format conversion, use this ratio + if (assigned(FormatConverter)) then + Result := FormatConverter.GetRatio() + else + Result := 1.0; + + // now the SRC ratio (Note: the format might change from SInt16 to float) + Result := Result * + ConversionData.src_ratio * + (DstFormatInfo.FrameSize / SrcFormatInfo.FrameSize); +end; + +{$ENDIF} + +end. \ No newline at end of file diff --git a/src/classes0/UAudioCore_Bass.pas b/src/classes0/UAudioCore_Bass.pas new file mode 100644 index 00000000..beb2db16 --- /dev/null +++ b/src/classes0/UAudioCore_Bass.pas @@ -0,0 +1,123 @@ +unit UAudioCore_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes, + SysUtils, + UMusic, + bass; // (Note: DWORD is defined here) + +type + TAudioCore_Bass = class + public + constructor Create(); + class function GetInstance(): TAudioCore_Bass; + function ErrorGetString(): string; overload; + function ErrorGetString(errCode: integer): string; overload; + function ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean; + function ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean; + end; + +implementation + +uses + UMain, + ULog; + +var + Instance: TAudioCore_Bass; + +constructor TAudioCore_Bass.Create(); +begin + inherited; +end; + +class function TAudioCore_Bass.GetInstance(): TAudioCore_Bass; +begin + if (not Assigned(Instance)) then + Instance := TAudioCore_Bass.Create(); + Result := Instance; +end; + +function TAudioCore_Bass.ErrorGetString(): string; +begin + Result := ErrorGetString(BASS_ErrorGetCode()); +end; + +function TAudioCore_Bass.ErrorGetString(errCode: integer): string; +begin + case errCode of + BASS_OK: result := 'No error'; + BASS_ERROR_MEM: result := 'Insufficient memory'; + BASS_ERROR_FILEOPEN: result := 'File could not be opened'; + BASS_ERROR_DRIVER: result := 'Device driver not available'; + BASS_ERROR_BUFLOST: result := 'Buffer lost'; + BASS_ERROR_HANDLE: result := 'Invalid Handle'; + BASS_ERROR_FORMAT: result := 'Sample-Format not supported'; + BASS_ERROR_POSITION: result := 'Illegal position'; + BASS_ERROR_INIT: result := 'BASS_Init has not been successfully called'; + BASS_ERROR_START: result := 'Paused/stopped'; + BASS_ERROR_ALREADY: result := 'Already created/used'; + BASS_ERROR_NOCHAN: result := 'No free channels'; + BASS_ERROR_ILLTYPE: result := 'Type is invalid'; + BASS_ERROR_ILLPARAM: result := 'Illegal parameter'; + BASS_ERROR_NO3D: result := 'No 3D support'; + BASS_ERROR_NOEAX: result := 'No EAX support'; + BASS_ERROR_DEVICE: result := 'Invalid device number'; + BASS_ERROR_NOPLAY: result := 'Channel not playing'; + BASS_ERROR_FREQ: result := 'Freq out of range'; + BASS_ERROR_NOTFILE: result := 'Not a file stream'; + BASS_ERROR_NOHW: result := 'No hardware support'; + BASS_ERROR_EMPTY: result := 'Is empty'; + BASS_ERROR_NONET: result := 'Network unavailable'; + BASS_ERROR_CREATE: result := 'Creation error'; + BASS_ERROR_NOFX: result := 'DX8 effects unavailable'; + BASS_ERROR_NOTAVAIL: result := 'Not available'; + BASS_ERROR_DECODE: result := 'Is a decoding channel'; + BASS_ERROR_DX: result := 'Insufficient version of DirectX'; + BASS_ERROR_TIMEOUT: result := 'Timeout'; + BASS_ERROR_FILEFORM: result := 'File-Format not recognised/supported'; + BASS_ERROR_SPEAKER: result := 'Requested speaker(s) not support'; + BASS_ERROR_VERSION: result := 'Version error'; + BASS_ERROR_CODEC: result := 'Codec not available/supported'; + BASS_ERROR_ENDED: result := 'The channel/file has ended'; + BASS_ERROR_UNKNOWN: result := 'Unknown error'; + else result := 'Unknown error'; + end; +end; + +function TAudioCore_Bass.ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean; +begin + case Format of + asfS16: Flags := 0; + asfFloat: Flags := BASS_SAMPLE_FLOAT; + asfU8: Flags := BASS_SAMPLE_8BITS; + else begin + Result := false; + Exit; + end; + end; + + Result := true; +end; + +function TAudioCore_Bass.ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean; +begin + if ((Flags and BASS_SAMPLE_FLOAT) <> 0) then + Format := asfFloat + else if ((Flags and BASS_SAMPLE_8BITS) <> 0) then + Format := asfU8 + else + Format := asfS16; + + Result := true; +end; + +end. diff --git a/src/classes0/UAudioCore_Portaudio.pas b/src/classes0/UAudioCore_Portaudio.pas new file mode 100644 index 00000000..bcc8a001 --- /dev/null +++ b/src/classes0/UAudioCore_Portaudio.pas @@ -0,0 +1,257 @@ +unit UAudioCore_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I ../switches.inc} + + +uses + Classes, + SysUtils, + portaudio; + +type + TAudioCore_Portaudio = class + public + constructor Create(); + class function GetInstance(): TAudioCore_Portaudio; + function GetPreferredApiIndex(): TPaHostApiIndex; + function TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean; + end; + +implementation + +uses + ULog; + +{* + * The default API used by Portaudio is the least common denominator + * and might lack efficiency. In addition it might not even work. + * We use an array named ApiPreferenceOrder with which we define the order of + * preferred APIs to use. The first API-type in the list is tried first. + * If it is not available the next one is tried and so on ... + * If none of the preferred APIs was found the default API (detected by + * portaudio) is used. + * + * Pascal does not permit zero-length static arrays, so you must use paDefaultApi + * as an array's only member if you do not have any preferences. + * You can also append paDefaultApi to a non-zero length preferences array but + * this is optional because the default API is always used as a fallback. + *} +const + paDefaultApi = -1; +const + ApiPreferenceOrder: +{$IF Defined(MSWINDOWS)} + // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment + // Note2: Windows Default-API is MME, but DirectSound is faster + array[0..0] of TPaHostApiTypeId = ( paDirectSound ); +{$ELSEIF Defined(LINUX)} + // Note: Portmixer has no mixer support for JACK at the moment + array[0..2] of TPaHostApiTypeId = ( paALSA, paJACK, paOSS ); +{$ELSEIF Defined(DARWIN)} + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); // paCoreAudio +{$ELSE} + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); +{$IFEND} + + +{ TAudioInput_Portaudio } + +var + Instance: TAudioCore_Portaudio; + +constructor TAudioCore_Portaudio.Create(); +begin + inherited; +end; + +class function TAudioCore_Portaudio.GetInstance(): TAudioCore_Portaudio; +begin + if not assigned(Instance) then + Instance := TAudioCore_Portaudio.Create(); + Result := Instance; +end; + +function TAudioCore_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex; +var + i: integer; + apiIndex: TPaHostApiIndex; + apiInfo: PPaHostApiInfo; +begin + result := -1; + + // select preferred sound-API + for i:= 0 to High(ApiPreferenceOrder) do + begin + if(ApiPreferenceOrder[i] <> paDefaultApi) then + begin + // check if API is available + apiIndex := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]); + if(apiIndex >= 0) then + begin + // we found an API but we must check if it works + // (on linux portaudio might detect OSS but does not provide + // any devices if ALSA is enabled) + apiInfo := Pa_GetHostApiInfo(apiIndex); + if (apiInfo^.deviceCount > 0) then + begin + Result := apiIndex; + break; + end; + end; + end; + end; + + // None of the preferred APIs is available -> use default + if(result < 0) then + begin + result := Pa_GetDefaultHostApi(); + end; +end; + +{* + * Portaudio test callback used by TestDevice(). + *} +function TestCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; +begin + // this callback is called only once + result := paAbort; +end; + +(* + * Tests if the callback works. Some devices can be opened without + * an error but the callback is never called. Calling Pa_StopStream() on such + * a stream freezes USDX then. Probably because the callback-thread is deadlocked + * due to some bug in portaudio. The blocking Pa_ReadStream() and Pa_WriteStream() + * block forever too and though can't be used for testing. + * + * To avoid freezing Pa_AbortStream (or Pa_CloseStream which calls Pa_AbortStream) + * can be used to force the stream to stop. But for some reason this stops debugging + * in gdb with a "no process found" message. + * + * Because freezing devices are non-working devices we test the devices here to + * be able to exclude them from the device-selection list. + * + * Portaudio does not provide any test to check this error case (probably because + * it should not even occur). So we have to open the device, start the stream and + * check if the callback is called (the stream is stopped if the callback is called + * for the first time, so we can poll until the stream is stopped). + * + * Another error that occurs is that some devices (even the default device) might + * work at the beginning but stop after a few calls (maybe 50) of the callback. + * For me this problem occurs with the default output-device. The "dmix" or "front" + * device must be selected instead. Another problem is that (due to a bug in + * portaudio or ALSA) the "front" device is not detected every time portaudio + * is started. Sometimes it needs two or more restarts. + * + * There is no reasonable way to test for these errors. For the first error-case + * we could test if the callback is called 50 times but this can take a second + * for each device and it can fail in the 51st or even 100th callback call then. + * + * The second error-case cannot be tested at all. How should we now that one + * device is missing if portaudio is not even able to detect it. + * We could start and terminate Portaudio for several times and see if the device + * count changes but this is ugly. + * + * Conclusion: We are not able to autodetect a working device with + * portaudio (at least not with the newest v19_20071207) at the moment. + * So we have to provide the possibility to manually select an output device + * in the UltraStar options if we want to use portaudio instead of SDL. + *) +function TAudioCore_Portaudio.TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean; +var + stream: PPaStream; + err: TPaError; + cbWorks: boolean; + cbPolls: integer; + i: integer; +const + altSampleRates: array[0..1] of Double = (44100, 48000); // alternative sample-rates +begin + Result := false; + + if (sampleRate <= 0) then + sampleRate := 44100; + + // check if device supports our input-format + err := Pa_IsFormatSupported(inParams, outParams, sampleRate); + if(err <> paNoError) then + begin + // we cannot fix the error -> exit + if (err <> paInvalidSampleRate) then + Exit; + + // try alternative sample-rates to the detected one + sampleRate := 0; + for i := 0 to High(altSampleRates) do + begin + // do not check the detected sample-rate twice + if (altSampleRates[i] = sampleRate) then + continue; + // check alternative + err := Pa_IsFormatSupported(inParams, outParams, altSampleRates[i]); + if (err = paNoError) then + begin + // sample-rate works + sampleRate := altSampleRates[i]; + break; + end; + end; + // no working sample-rate found + if (sampleRate = 0) then + Exit; + end; + + // FIXME: for some reason gdb stops after a call of Pa_AbortStream() + // which is implicitely called by Pa_CloseStream(). + // gdb's stops with the message: "ptrace: no process found". + // Probably because the callback-thread is killed what confuses gdb. + {$IF Defined(Debug) and Defined(Linux)} + cbWorks := true; + {$ELSE} + // open device for testing + err := Pa_OpenStream(stream, inParams, outParams, sampleRate, + paFramesPerBufferUnspecified, + paNoFlag, @TestCallback, nil); + if(err <> paNoError) then + begin + exit; + end; + + // start the callback + err := Pa_StartStream(stream); + if(err <> paNoError) then + begin + Pa_CloseStream(stream); + exit; + end; + + cbWorks := false; + // check if the callback was called (poll for max. 200ms) + for cbPolls := 1 to 20 do + begin + // if the test-callback was called it should be aborted now + if (Pa_IsStreamActive(stream) = 0) then + begin + cbWorks := true; + break; + end; + // not yet aborted, wait and try (poll) again + Pa_Sleep(10); + end; + + // finally abort the stream + Pa_CloseStream(stream); + {$IFEND} + + Result := cbWorks; +end; + +end. diff --git a/src/classes0/UAudioDecoder_Bass.pas b/src/classes0/UAudioDecoder_Bass.pas new file mode 100644 index 00000000..dba1fde4 --- /dev/null +++ b/src/classes0/UAudioDecoder_Bass.pas @@ -0,0 +1,242 @@ +unit UAudioDecoder_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +implementation + +uses + Classes, + SysUtils, + UMain, + UMusic, + UAudioCore_Bass, + ULog, + bass; + +type + TBassDecodeStream = class(TAudioDecodeStream) + private + Handle: HSTREAM; + FormatInfo : TAudioFormatInfo; + Error: boolean; + public + constructor Create(Handle: HSTREAM); + destructor Destroy(); override; + + procedure Close(); override; + + function GetLength(): real; override; + function GetAudioFormatInfo(): TAudioFormatInfo; override; + function GetPosition: real; override; + procedure SetPosition(Time: real); override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function IsEOF(): boolean; override; + function IsError(): boolean; override; + + function ReadData(Buffer: PChar; BufSize: integer): integer; override; + end; + +type + TAudioDecoder_Bass = class( TInterfacedObject, IAudioDecoder ) + public + function GetName: string; + + function InitializeDecoder(): boolean; + function FinalizeDecoder(): boolean; + function Open(const Filename: string): TAudioDecodeStream; + end; + +var + BassCore: TAudioCore_Bass; + + +{ TBassDecodeStream } + +constructor TBassDecodeStream.Create(Handle: HSTREAM); +var + ChannelInfo: BASS_CHANNELINFO; + Format: TAudioSampleFormat; +begin + inherited Create(); + Self.Handle := Handle; + + // setup format info + if (not BASS_ChannelGetInfo(Handle, ChannelInfo)) then + begin + raise Exception.Create('Failed to open decode-stream'); + end; + BassCore.ConvertBASSFlagsToAudioFormat(ChannelInfo.flags, Format); + FormatInfo := TAudioFormatInfo.Create(ChannelInfo.chans, ChannelInfo.freq, format); + + Error := false; +end; + +destructor TBassDecodeStream.Destroy(); +begin + Close(); + inherited; +end; + +procedure TBassDecodeStream.Close(); +begin + if (Handle <> 0) then + begin + BASS_StreamFree(Handle); + Handle := 0; + end; + PerformOnClose(); + FreeAndNil(FormatInfo); + Error := false; +end; + +function TBassDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + Result := FormatInfo; +end; + +function TBassDecodeStream.GetLength(): real; +var + bytes: QWORD; +begin + bytes := BASS_ChannelGetLength(Handle, BASS_POS_BYTE); + Result := BASS_ChannelBytes2Seconds(Handle, bytes); +end; + +function TBassDecodeStream.GetPosition: real; +var + bytes: QWORD; +begin + bytes := BASS_ChannelGetPosition(Handle, BASS_POS_BYTE); + Result := BASS_ChannelBytes2Seconds(Handle, bytes); +end; + +procedure TBassDecodeStream.SetPosition(Time: real); +var + bytes: QWORD; +begin + bytes := BASS_ChannelSeconds2Bytes(Handle, Time); + BASS_ChannelSetPosition(Handle, bytes, BASS_POS_BYTE); +end; + +function TBassDecodeStream.GetLoop(): boolean; +var + flags: DWORD; +begin + // retrieve channel flags + flags := BASS_ChannelFlags(Handle, 0, 0); + if (flags = DWORD(-1)) then + begin + Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.GetLoop'); + Result := false; + Exit; + end; + Result := (flags and BASS_SAMPLE_LOOP) <> 0; +end; + +procedure TBassDecodeStream.SetLoop(Enabled: boolean); +var + flags: DWORD; +begin + // set/unset loop-flag + if (Enabled) then + flags := BASS_SAMPLE_LOOP + else + flags := 0; + + // set new flag-bits + if (BASS_ChannelFlags(Handle, flags, BASS_SAMPLE_LOOP) = DWORD(-1)) then + begin + Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.SetLoop'); + Exit; + end; +end; + +function TBassDecodeStream.IsEOF(): boolean; +begin + Result := (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_STOPPED); +end; + +function TBassDecodeStream.IsError(): boolean; +begin + Result := Error; +end; + +function TBassDecodeStream.ReadData(Buffer: PChar; BufSize: integer): integer; +begin + Result := BASS_ChannelGetData(Handle, Buffer, BufSize); + // check error state (do not handle EOF as error) + if ((Result = -1) and (BASS_ErrorGetCode() <> BASS_ERROR_ENDED)) then + Error := true + else + Error := false; +end; + + +{ TAudioDecoder_Bass } + +function TAudioDecoder_Bass.GetName: String; +begin + result := 'BASS_Decoder'; +end; + +function TAudioDecoder_Bass.InitializeDecoder(): boolean; +begin + BassCore := TAudioCore_Bass.GetInstance(); + Result := true; +end; + +function TAudioDecoder_Bass.FinalizeDecoder(): boolean; +begin + Result := true; +end; + +function TAudioDecoder_Bass.Open(const Filename: string): TAudioDecodeStream; +var + Stream: HSTREAM; + ChannelInfo: BASS_CHANNELINFO; + FileExt: string; +begin + Result := nil; + + // check if BASS was initialized + // in case the decoder is not used with BASS playback, init the NO_SOUND device + if ((integer(BASS_GetDevice) = -1) and (BASS_ErrorGetCode() = BASS_ERROR_INIT)) then + BASS_Init(0, 44100, 0, 0, nil); + + // TODO: use BASS_STREAM_PRESCAN for accurate seeking in VBR-files? + // disadvantage: seeking will slow down. + Stream := BASS_StreamCreateFile(False, PChar(Filename), 0, 0, BASS_STREAM_DECODE); + if (Stream = 0) then + begin + //Log.LogError(BassCore.ErrorGetString(), 'TAudioDecoder_Bass.Open'); + Exit; + end; + + // check if BASS opened some erroneously recognized file-formats + if BASS_ChannelGetInfo(Stream, channelInfo) then + begin + fileExt := ExtractFileExt(Filename); + // BASS opens FLV-files (maybe others too) although it cannot handle them. + // Setting BASS_CONFIG_VERIFY to the max. value (100000) does not help. + if ((fileExt = '.flv') and (channelInfo.ctype = BASS_CTYPE_STREAM_MP1)) then + begin + BASS_StreamFree(Stream); + Exit; + end; + end; + + Result := TBassDecodeStream.Create(Stream); +end; + + +initialization + MediaManager.Add(TAudioDecoder_Bass.Create); + +end. diff --git a/src/classes0/UAudioDecoder_FFmpeg.pas b/src/classes0/UAudioDecoder_FFmpeg.pas new file mode 100644 index 00000000..d9b4c93c --- /dev/null +++ b/src/classes0/UAudioDecoder_FFmpeg.pas @@ -0,0 +1,1114 @@ +unit UAudioDecoder_FFmpeg; + +(******************************************************************************* + * + * This unit is primarily based upon - + * http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + * + * and tutorial03.c + * + * http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html + * + *******************************************************************************) + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +// show FFmpeg specific debug output +{.$DEFINE DebugFFmpegDecode} + +// FFmpeg is very verbose and shows a bunch of errors. +// Those errors (they can be considered as warnings by us) can be ignored +// as they do not give any useful information. +// There is no solution to fix this except for turning them off. +{.$DEFINE EnableFFmpegErrorOutput} + +implementation + +uses + Classes, + SysUtils, + Math, + UMusic, + UIni, + UMain, + avcodec, + avformat, + avutil, + avio, + mathematics, // used for av_rescale_q + rational, + UMediaCore_FFmpeg, + SDL, + ULog, + UCommon, + UConfig; + +const + MAX_AUDIOQ_SIZE = (5 * 16 * 1024); + +const + // TODO: The factor 3/2 might not be necessary as we do not need extra + // space for synchronizing as in the tutorial. + AUDIO_BUFFER_SIZE = (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3) div 2; + +type + TFFmpegDecodeStream = class(TAudioDecodeStream) + private + StateLock: PSDL_Mutex; + + EOFState: boolean; // end-of-stream flag (locked by StateLock) + ErrorState: boolean; // error flag (locked by StateLock) + + QuitRequest: boolean; // (locked by StateLock) + ParserIdleCond: PSDL_Cond; + + // parser pause/resume data + ParserLocked: boolean; + ParserPauseRequestCount: integer; + ParserUnlockedCond: PSDL_Cond; + ParserResumeCond: PSDL_Cond; + + SeekRequest: boolean; // (locked by StateLock) + SeekFlags: integer; // (locked by StateLock) + SeekPos: double; // stream position to seek for (in secs) (locked by StateLock) + SeekFlush: boolean; // true if the buffers should be flushed after seeking (locked by StateLock) + SeekFinishedCond: PSDL_Cond; + + Loop: boolean; // (locked by StateLock) + + ParseThread: PSDL_Thread; + PacketQueue: TPacketQueue; + + FormatInfo: TAudioFormatInfo; + + // FFmpeg specific data + FormatCtx: PAVFormatContext; + CodecCtx: PAVCodecContext; + Codec: PAVCodec; + + AudioStreamIndex: integer; + AudioStream: PAVStream; + AudioStreamPos: double; // stream position in seconds (locked by DecoderLock) + + // decoder pause/resume data + DecoderLocked: boolean; + DecoderPauseRequestCount: integer; + DecoderUnlockedCond: PSDL_Cond; + DecoderResumeCond: PSDL_Cond; + + // state-vars for DecodeFrame (locked by DecoderLock) + AudioPaket: TAVPacket; + AudioPaketData: PChar; + AudioPaketSize: integer; + AudioPaketSilence: integer; // number of bytes of silence to return + + // state-vars for AudioCallback (locked by DecoderLock) + AudioBufferPos: integer; + AudioBufferSize: integer; + AudioBuffer: PChar; + + Filename: string; + + procedure SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean); + procedure SetEOF(State: boolean); {$IFDEF HasInline}inline;{$ENDIF} + procedure SetError(State: boolean); {$IFDEF HasInline}inline;{$ENDIF} + function IsSeeking(): boolean; + function IsQuit(): boolean; + + procedure Reset(); + + procedure Parse(); + function ParseLoop(): boolean; + procedure PauseParser(); + procedure ResumeParser(); + + function DecodeFrame(Buffer: PChar; BufferSize: integer): integer; + procedure FlushCodecBuffers(); + procedure PauseDecoder(); + procedure ResumeDecoder(); + public + constructor Create(); + destructor Destroy(); override; + + function Open(const Filename: string): boolean; + procedure Close(); override; + + function GetLength(): real; override; + function GetAudioFormatInfo(): TAudioFormatInfo; override; + function GetPosition: real; override; + procedure SetPosition(Time: real); override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function IsEOF(): boolean; override; + function IsError(): boolean; override; + + function ReadData(Buffer: PChar; BufferSize: integer): integer; override; + end; + +type + TAudioDecoder_FFmpeg = class( TInterfacedObject, IAudioDecoder ) + public + function GetName: string; + + function InitializeDecoder(): boolean; + function FinalizeDecoder(): boolean; + function Open(const Filename: string): TAudioDecodeStream; + end; + +var + FFmpegCore: TMediaCore_FFmpeg; + +function ParseThreadMain(Data: Pointer): integer; cdecl; forward; + + +{ TFFmpegDecodeStream } + +constructor TFFmpegDecodeStream.Create(); +begin + inherited Create(); + + StateLock := SDL_CreateMutex(); + ParserUnlockedCond := SDL_CreateCond(); + ParserResumeCond := SDL_CreateCond(); + ParserIdleCond := SDL_CreateCond(); + SeekFinishedCond := SDL_CreateCond(); + DecoderUnlockedCond := SDL_CreateCond(); + DecoderResumeCond := SDL_CreateCond(); + + // according to the documentation of avcodec_decode_audio(2), sample-data + // should be aligned on a 16 byte boundary. Otherwise internal calls + // (e.g. to SSE or Altivec operations) might fail or lack performance on some + // CPUs. Although GetMem() in Delphi and FPC seems to use a 16 byte or higher + // alignment for buffers of this size (alignment depends on the size of the + // requested buffer), we will set the alignment explicitly as the minimum + // alignment used by Delphi and FPC is on an 8 byte boundary. + // + // Note: AudioBuffer was previously defined as a field of type TAudioBuffer + // (array[0..AUDIO_BUFFER_SIZE-1] of byte) and hence statically allocated. + // Fields of records are aligned different to memory allocated with GetMem(), + // aligning depending on the type but will be at least 2 bytes. + // AudioBuffer was not aligned to a 16 byte boundary. The {$ALIGN x} directive + // was not applicable as Delphi in contrast to FPC provides at most 8 byte + // alignment ({$ALIGN 16} is not supported) by this directive. + AudioBuffer := GetAlignedMem(AUDIO_BUFFER_SIZE, 16); + + Reset(); +end; + +procedure TFFmpegDecodeStream.Reset(); +begin + ParseThread := nil; + + EOFState := false; + ErrorState := false; + Loop := false; + QuitRequest := false; + + AudioPaketData := nil; + AudioPaketSize := 0; + AudioPaketSilence := 0; + + AudioBufferPos := 0; + AudioBufferSize := 0; + + ParserLocked := false; + ParserPauseRequestCount := 0; + DecoderLocked := false; + DecoderPauseRequestCount := 0; + + FillChar(AudioPaket, SizeOf(TAVPacket), 0); +end; + +{* + * Frees the decode-stream data. + *} +destructor TFFmpegDecodeStream.Destroy(); +begin + Close(); + + SDL_DestroyMutex(StateLock); + SDL_DestroyCond(ParserUnlockedCond); + SDL_DestroyCond(ParserResumeCond); + SDL_DestroyCond(ParserIdleCond); + SDL_DestroyCond(SeekFinishedCond); + SDL_DestroyCond(DecoderUnlockedCond); + SDL_DestroyCond(DecoderResumeCond); + + FreeAlignedMem(AudioBuffer); + + inherited; +end; + +function TFFmpegDecodeStream.Open(const Filename: string): boolean; +var + SampleFormat: TAudioSampleFormat; + AVResult: integer; +begin + Result := false; + + Close(); + Reset(); + + if (not FileExists(Filename)) then + begin + Log.LogError('Audio-file does not exist: "' + Filename + '"', 'UAudio_FFmpeg'); + Exit; + end; + + Self.Filename := Filename; + + // open audio file + if (av_open_input_file(FormatCtx, PChar(Filename), nil, 0, nil) <> 0) then + begin + Log.LogError('av_open_input_file failed: "' + Filename + '"', 'UAudio_FFmpeg'); + Exit; + end; + + // generate PTS values if they do not exist + FormatCtx^.flags := FormatCtx^.flags or AVFMT_FLAG_GENPTS; + + // retrieve stream information + if (av_find_stream_info(FormatCtx) < 0) then + begin + Log.LogError('av_find_stream_info failed: "' + Filename + '"', 'UAudio_FFmpeg'); + Close(); + Exit; + end; + + // FIXME: hack used by ffplay. Maybe should not use url_feof() to test for the end + FormatCtx^.pb.eof_reached := 0; + + {$IFDEF DebugFFmpegDecode} + dump_format(FormatCtx, 0, pchar(Filename), 0); + {$ENDIF} + + AudioStreamIndex := FFmpegCore.FindAudioStreamIndex(FormatCtx); + if (AudioStreamIndex < 0) then + begin + Log.LogError('FindAudioStreamIndex: No Audio-stream found "' + Filename + '"', 'UAudio_FFmpeg'); + Close(); + Exit; + end; + + //Log.LogStatus('AudioStreamIndex is: '+ inttostr(ffmpegStreamID), 'UAudio_FFmpeg'); + + AudioStream := FormatCtx.streams[AudioStreamIndex]; + CodecCtx := AudioStream^.codec; + + // TODO: should we use this or not? Should we allow 5.1 channel audio? + (* + {$IF LIBAVCODEC_VERSION >= 51042000} + if (CodecCtx^.channels > 0) then + CodecCtx^.request_channels := Min(2, CodecCtx^.channels) + else + CodecCtx^.request_channels := 2; + {$IFEND} + *) + + Codec := avcodec_find_decoder(CodecCtx^.codec_id); + if (Codec = nil) then + begin + Log.LogError('Unsupported codec!', 'UAudio_FFmpeg'); + CodecCtx := nil; + Close(); + Exit; + end; + + // set debug options + CodecCtx^.debug_mv := 0; + CodecCtx^.debug := 0; + + // detect bug-workarounds automatically + CodecCtx^.workaround_bugs := FF_BUG_AUTODETECT; + // error resilience strategy (careful/compliant/agressive/very_aggressive) + //CodecCtx^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT; + // allow non spec compliant speedup tricks. + //CodecCtx^.flags2 := CodecCtx^.flags2 or CODEC_FLAG2_FAST; + + // Note: avcodec_open() and avcodec_close() are not thread-safe and will + // fail if called concurrently by different threads. + FFmpegCore.LockAVCodec(); + try + AVResult := avcodec_open(CodecCtx, Codec); + finally + FFmpegCore.UnlockAVCodec(); + end; + if (AVResult < 0) then + begin + Log.LogError('avcodec_open failed!', 'UAudio_FFmpeg'); + Close(); + Exit; + end; + + // now initialize the audio-format + + if (not FFmpegCore.ConvertFFmpegToAudioFormat(CodecCtx^.sample_fmt, SampleFormat)) then + begin + // try standard format + SampleFormat := asfS16; + end; + + FormatInfo := TAudioFormatInfo.Create( + CodecCtx^.channels, + CodecCtx^.sample_rate, + SampleFormat + ); + + + PacketQueue := TPacketQueue.Create(); + + // finally start the decode thread + ParseThread := SDL_CreateThread(@ParseThreadMain, Self); + + Result := true; +end; + +procedure TFFmpegDecodeStream.Close(); +var + ThreadResult: integer; +begin + // wake threads waiting for packet-queue data + // Note: normally, there are no waiting threads. If there were waiting + // ones, they would block the audio-callback thread. + if (assigned(PacketQueue)) then + PacketQueue.Abort(); + + // send quit request (to parse-thread etc) + SDL_mutexP(StateLock); + QuitRequest := true; + SDL_CondBroadcast(ParserIdleCond); + SDL_mutexV(StateLock); + + // abort parse-thread + if (ParseThread <> nil) then + begin + // and wait until it terminates + SDL_WaitThread(ParseThread, ThreadResult); + ParseThread := nil; + end; + + // Close the codec + if (CodecCtx <> nil) then + begin + // avcodec_close() is not thread-safe + FFmpegCore.LockAVCodec(); + try + avcodec_close(CodecCtx); + finally + FFmpegCore.UnlockAVCodec(); + end; + CodecCtx := nil; + end; + + // Close the video file + if (FormatCtx <> nil) then + begin + av_close_input_file(FormatCtx); + FormatCtx := nil; + end; + + PerformOnClose(); + + FreeAndNil(PacketQueue); + FreeAndNil(FormatInfo); +end; + +function TFFmpegDecodeStream.GetLength(): real; +begin + // do not forget to consider the start_time value here + Result := (FormatCtx^.start_time + FormatCtx^.duration) / AV_TIME_BASE; +end; + +function TFFmpegDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + Result := FormatInfo; +end; + +function TFFmpegDecodeStream.IsEOF(): boolean; +begin + SDL_mutexP(StateLock); + Result := EOFState; + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.SetEOF(State: boolean); +begin + SDL_mutexP(StateLock); + EOFState := State; + SDL_mutexV(StateLock); +end; + +function TFFmpegDecodeStream.IsError(): boolean; +begin + SDL_mutexP(StateLock); + Result := ErrorState; + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.SetError(State: boolean); +begin + SDL_mutexP(StateLock); + ErrorState := State; + SDL_mutexV(StateLock); +end; + +function TFFmpegDecodeStream.IsSeeking(): boolean; +begin + SDL_mutexP(StateLock); + Result := SeekRequest; + SDL_mutexV(StateLock); +end; + +function TFFmpegDecodeStream.IsQuit(): boolean; +begin + SDL_mutexP(StateLock); + Result := QuitRequest; + SDL_mutexV(StateLock); +end; + +function TFFmpegDecodeStream.GetPosition(): real; +var + BufferSizeSec: double; +begin + PauseDecoder(); + + // ReadData() does not return all of the buffer retrieved by DecodeFrame(). + // Determine the size of the unused part of the decode-buffer. + BufferSizeSec := (AudioBufferSize - AudioBufferPos) / + FormatInfo.BytesPerSec; + + // subtract the size of unused buffer-data from the audio clock. + Result := AudioStreamPos - BufferSizeSec; + + ResumeDecoder(); +end; + +procedure TFFmpegDecodeStream.SetPosition(Time: real); +begin + SetPositionIntern(Time, true, true); +end; + +function TFFmpegDecodeStream.GetLoop(): boolean; +begin + SDL_mutexP(StateLock); + Result := Loop; + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.SetLoop(Enabled: boolean); +begin + SDL_mutexP(StateLock); + Loop := Enabled; + SDL_mutexV(StateLock); +end; + + +(******************************************** + * Parser section + ********************************************) + +procedure TFFmpegDecodeStream.PauseParser(); +begin + if (SDL_ThreadID() = ParseThread.threadid) then + Exit; + + SDL_mutexP(StateLock); + Inc(ParserPauseRequestCount); + while (ParserLocked) do + SDL_CondWait(ParserUnlockedCond, StateLock); + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.ResumeParser(); +begin + if (SDL_ThreadID() = ParseThread.threadid) then + Exit; + + SDL_mutexP(StateLock); + Dec(ParserPauseRequestCount); + SDL_CondSignal(ParserResumeCond); + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean); +begin + // - Pause the parser first to prevent it from putting obsolete packages + // into the queue after the queue was flushed and before seeking is done. + // Otherwise we will hear fragments of old data, if the stream was seeked + // in stopped mode and resumed afterwards (applies to non-blocking mode only). + // - Pause the decoder to avoid race-condition that might occur otherwise. + // - Last lock the state lock because we are manipulating some shared state-vars. + PauseParser(); + PauseDecoder(); + SDL_mutexP(StateLock); + + // configure seek parameters + SeekPos := Time; + SeekFlush := Flush; + SeekFlags := AVSEEK_FLAG_ANY; + SeekRequest := true; + + // Note: the BACKWARD-flag seeks to the first position <= the position + // searched for. Otherwise e.g. position 0 might not be seeked correct. + // For some reason ffmpeg sometimes doesn't use position 0 but the key-frame + // following. In streams with few key-frames (like many flv-files) the next + // key-frame after 0 might be 5secs ahead. + if (Time < AudioStreamPos) then + SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD; + + EOFState := false; + ErrorState := false; + + // send a reuse signal in case the parser was stopped (e.g. because of an EOF) + SDL_CondSignal(ParserIdleCond); + + SDL_mutexV(StateLock); + ResumeDecoder(); + ResumeParser(); + + // in blocking mode, wait until seeking is done + if (Blocking) then + begin + SDL_mutexP(StateLock); + while (SeekRequest) do + SDL_CondWait(SeekFinishedCond, StateLock); + SDL_mutexV(StateLock); + end; +end; + +function ParseThreadMain(Data: Pointer): integer; cdecl; +var + Stream: TFFmpegDecodeStream; +begin + Stream := TFFmpegDecodeStream(Data); + if (Stream <> nil) then + Stream.Parse(); + Result := 0; +end; + +procedure TFFmpegDecodeStream.Parse(); +begin + // reuse thread as long as the stream is not terminated + while (ParseLoop()) do + begin + // wait for reuse or destruction of stream + SDL_mutexP(StateLock); + while (not (SeekRequest or QuitRequest)) do + SDL_CondWait(ParserIdleCond, StateLock); + SDL_mutexV(StateLock); + end; +end; + +(** + * Parser main loop. + * Will not return until parsing of the stream is finished. + * Reasons for the parser to return are: + * - the end-of-file is reached + * - an error occured + * - the stream was quited (received a quit-request) + * Returns true if the stream can be resumed or false if the stream has to + * be terminated. + *) +function TFFmpegDecodeStream.ParseLoop(): boolean; +var + Packet: TAVPacket; + StatusPacket: PAVPacket; + SeekTarget: int64; + ByteIOCtx: PByteIOContext; + ErrorCode: integer; + StartSilence: double; // duration of silence at start of stream + StartSilencePtr: PDouble; // pointer for the EMPTY status packet + + // Note: pthreads wakes threads waiting on a mutex in the order of their + // priority and not in FIFO order. SDL does not provide any option to + // control priorities. This might (and already did) starve threads waiting + // on the mutex (e.g. SetPosition) making usdx look like it was froozen. + // Instead of simply locking the critical section we set a ParserLocked flag + // instead and give priority to the threads requesting the parser to pause. + procedure LockParser(); + begin + SDL_mutexP(StateLock); + while (ParserPauseRequestCount > 0) do + SDL_CondWait(ParserResumeCond, StateLock); + ParserLocked := true; + SDL_mutexV(StateLock); + end; + + procedure UnlockParser(); + begin + SDL_mutexP(StateLock); + ParserLocked := false; + SDL_CondBroadcast(ParserUnlockedCond); + SDL_mutexV(StateLock); + end; + +begin + Result := true; + + while (true) do + begin + LockParser(); + try + + if (IsQuit()) then + begin + Result := false; + Exit; + end; + + // handle seek-request (Note: no need to lock SeekRequest here) + if (SeekRequest) then + begin + // first try: seek on the audio stream + SeekTarget := Round(SeekPos / av_q2d(AudioStream^.time_base)); + StartSilence := 0; + if (SeekTarget < AudioStream^.start_time) then + StartSilence := (AudioStream^.start_time - SeekTarget) * av_q2d(AudioStream^.time_base); + ErrorCode := av_seek_frame(FormatCtx, AudioStreamIndex, SeekTarget, SeekFlags); + + if (ErrorCode < 0) then + begin + // second try: seek on the default stream (necessary for flv-videos and some ogg-files) + SeekTarget := Round(SeekPos * AV_TIME_BASE); + StartSilence := 0; + if (SeekTarget < FormatCtx^.start_time) then + StartSilence := (FormatCtx^.start_time - SeekTarget) / AV_TIME_BASE; + ErrorCode := av_seek_frame(FormatCtx, -1, SeekTarget, SeekFlags); + end; + + // pause decoder and lock state (keep the lock-order to avoid deadlocks). + // Note that the decoder does not block in the packet-queue in seeking state, + // so locking the decoder here does not cause a dead-lock. + PauseDecoder(); + SDL_mutexP(StateLock); + try + if (ErrorCode < 0) then + begin + // seeking failed + ErrorState := true; + Log.LogStatus('Seek Error in "'+FormatCtx^.filename+'"', 'UAudioDecoder_FFmpeg'); + end + else + begin + if (SeekFlush) then + begin + // flush queue (we will send a Flush-Packet when seeking is finished) + PacketQueue.Flush(); + + // flush the decode buffers + AudioBufferSize := 0; + AudioBufferPos := 0; + AudioPaketSize := 0; + AudioPaketSilence := 0; + FlushCodecBuffers(); + + // Set preliminary stream position. The position will be set to + // the correct value as soon as the first packet is decoded. + AudioStreamPos := SeekPos; + end + else + begin + // request avcodec buffer flush + PacketQueue.PutStatus(PKT_STATUS_FLAG_FLUSH, nil); + end; + + // fill the gap between position 0 and start_time with silence + // but not if we are in loop mode + if ((StartSilence > 0) and (not Loop)) then + begin + GetMem(StartSilencePtr, SizeOf(StartSilence)); + StartSilencePtr^ := StartSilence; + PacketQueue.PutStatus(PKT_STATUS_FLAG_EMPTY, StartSilencePtr); + end; + end; + + SeekRequest := false; + SDL_CondBroadcast(SeekFinishedCond); + finally + SDL_mutexV(StateLock); + ResumeDecoder(); + end; + end; + + if (PacketQueue.GetSize() > MAX_AUDIOQ_SIZE) then + begin + SDL_Delay(10); + Continue; + end; + + if (av_read_frame(FormatCtx, Packet) < 0) then + begin + // failed to read a frame, check reason + {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)} + ByteIOCtx := FormatCtx^.pb; + {$ELSE} + ByteIOCtx := @FormatCtx^.pb; + {$IFEND} + + // check for end-of-file (eof is not an error) + if (url_feof(ByteIOCtx) <> 0) then + begin + if (GetLoop()) then + begin + // rewind stream (but do not flush) + SetPositionIntern(0, false, false); + Continue; + end + else + begin + // signal end-of-file + PacketQueue.PutStatus(PKT_STATUS_FLAG_EOF, nil); + Exit; + end; + end; + + // check for errors + if (url_ferror(ByteIOCtx) <> 0) then + begin + // an error occured -> abort and wait for repositioning or termination + PacketQueue.PutStatus(PKT_STATUS_FLAG_ERROR, nil); + Exit; + end; + + // no error -> wait for user input + SDL_Delay(100); + Continue; + end; + + if (Packet.stream_index = AudioStreamIndex) then + PacketQueue.Put(@Packet) + else + av_free_packet(@Packet); + + finally + UnlockParser(); + end; + end; +end; + + +(******************************************** + * Decoder section + ********************************************) + +procedure TFFmpegDecodeStream.PauseDecoder(); +begin + SDL_mutexP(StateLock); + Inc(DecoderPauseRequestCount); + while (DecoderLocked) do + SDL_CondWait(DecoderUnlockedCond, StateLock); + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.ResumeDecoder(); +begin + SDL_mutexP(StateLock); + Dec(DecoderPauseRequestCount); + SDL_CondSignal(DecoderResumeCond); + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.FlushCodecBuffers(); +begin + // if no flush operation is specified, avcodec_flush_buffers will not do anything. + if (@CodecCtx.codec.flush <> nil) then + begin + // flush buffers used by avcodec_decode_audio, etc. + avcodec_flush_buffers(CodecCtx); + end + else + begin + // we need a Workaround to avoid plopping noise with ogg-vorbis and + // mp3 (in older versions of FFmpeg). + // We will just reopen the codec. + FFmpegCore.LockAVCodec(); + try + avcodec_close(CodecCtx); + avcodec_open(CodecCtx, Codec); + finally + FFmpegCore.UnlockAVCodec(); + end; + end; +end; + +function TFFmpegDecodeStream.DecodeFrame(Buffer: PChar; BufferSize: integer): integer; +var + PaketDecodedSize: integer; // size of packet data used for decoding + DataSize: integer; // size of output data decoded by FFmpeg + BlockQueue: boolean; + SilenceDuration: double; + {$IFDEF DebugFFmpegDecode} + TmpPos: double; + {$ENDIF} +begin + Result := -1; + + if (EOF) then + Exit; + + while(true) do + begin + // for titles with start_time > 0 we have to generate silence + // until we reach the pts of the first data packet. + if (AudioPaketSilence > 0) then + begin + DataSize := Min(AudioPaketSilence, BufferSize); + FillChar(Buffer[0], DataSize, 0); + Dec(AudioPaketSilence, DataSize); + AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec; + Result := DataSize; + Exit; + end; + + // read packet data + while (AudioPaketSize > 0) do + begin + DataSize := BufferSize; + + {$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0 + PaketDecodedSize := avcodec_decode_audio2(CodecCtx, PSmallint(Buffer), + DataSize, AudioPaketData, AudioPaketSize); + {$ELSE} + PaketDecodedSize := avcodec_decode_audio(CodecCtx, PSmallint(Buffer), + DataSize, AudioPaketData, AudioPaketSize); + {$IFEND} + + if(PaketDecodedSize < 0) then + begin + // if error, skip frame + {$IFDEF DebugFFmpegDecode} + DebugWriteln('Skip audio frame'); + {$ENDIF} + AudioPaketSize := 0; + Break; + end; + + Inc(AudioPaketData, PaketDecodedSize); + Dec(AudioPaketSize, PaketDecodedSize); + + // check if avcodec_decode_audio returned data, otherwise fetch more frames + if (DataSize <= 0) then + Continue; + + // update stream position by the amount of fetched data + AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec; + + // we have data, return it and come back for more later + Result := DataSize; + Exit; + end; + + // free old packet data + if (AudioPaket.data <> nil) then + av_free_packet(@AudioPaket); + + // do not block queue on seeking (to avoid deadlocks on the DecoderLock) + if (IsSeeking()) then + BlockQueue := false + else + BlockQueue := true; + + // request a new packet and block if none available. + // If this fails, the queue was aborted. + if (PacketQueue.Get(AudioPaket, BlockQueue) <= 0) then + Exit; + + // handle Status-packet + if (PChar(AudioPaket.data) = STATUS_PACKET) then + begin + AudioPaket.data := nil; + AudioPaketData := nil; + AudioPaketSize := 0; + + case (AudioPaket.flags) of + PKT_STATUS_FLAG_FLUSH: + begin + // just used if SetPositionIntern was called without the flush flag. + FlushCodecBuffers; + end; + PKT_STATUS_FLAG_EOF: // end-of-file + begin + // ignore EOF while seeking + if (not IsSeeking()) then + SetEOF(true); + // buffer contains no data -> result = -1 + Exit; + end; + PKT_STATUS_FLAG_ERROR: + begin + SetError(true); + Log.LogStatus('I/O Error', 'TFFmpegDecodeStream.DecodeFrame'); + Exit; + end; + PKT_STATUS_FLAG_EMPTY: + begin + SilenceDuration := PDouble(PacketQueue.GetStatusInfo(AudioPaket))^; + AudioPaketSilence := Round(SilenceDuration * FormatInfo.SampleRate) * FormatInfo.FrameSize; + PacketQueue.FreeStatusInfo(AudioPaket); + end + else + begin + Log.LogStatus('Unknown status', 'TFFmpegDecodeStream.DecodeFrame'); + end; + end; + + Continue; + end; + + AudioPaketData := PChar(AudioPaket.data); + AudioPaketSize := AudioPaket.size; + + // if available, update the stream position to the presentation time of this package + if(AudioPaket.pts <> AV_NOPTS_VALUE) then + begin + {$IFDEF DebugFFmpegDecode} + TmpPos := AudioStreamPos; + {$ENDIF} + AudioStreamPos := av_q2d(AudioStream^.time_base) * AudioPaket.pts; + {$IFDEF DebugFFmpegDecode} + DebugWriteln('Timestamp: ' + floattostrf(AudioStreamPos, ffFixed, 15, 3) + ' ' + + '(Calc: ' + floattostrf(TmpPos, ffFixed, 15, 3) + '), ' + + 'Diff: ' + floattostrf(AudioStreamPos-TmpPos, ffFixed, 15, 3)); + {$ENDIF} + end; + end; +end; + +function TFFmpegDecodeStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +var + CopyByteCount: integer; // number of bytes to copy + RemainByteCount: integer; // number of bytes left (remain) to read + BufferPos: integer; + + // prioritize pause requests + procedure LockDecoder(); + begin + SDL_mutexP(StateLock); + while (DecoderPauseRequestCount > 0) do + SDL_CondWait(DecoderResumeCond, StateLock); + DecoderLocked := true; + SDL_mutexV(StateLock); + end; + + procedure UnlockDecoder(); + begin + SDL_mutexP(StateLock); + DecoderLocked := false; + SDL_CondBroadcast(DecoderUnlockedCond); + SDL_mutexV(StateLock); + end; + +begin + Result := -1; + + // set number of bytes to copy to the output buffer + BufferPos := 0; + + LockDecoder(); + try + // leave if end-of-file is reached + if (EOF) then + Exit; + + // copy data to output buffer + while (BufferPos < BufferSize) do + begin + // check if we need more data + if (AudioBufferPos >= AudioBufferSize) then + begin + AudioBufferPos := 0; + + // we have already sent all our data; get more + AudioBufferSize := DecodeFrame(AudioBuffer, AUDIO_BUFFER_SIZE); + + // check for errors or EOF + if(AudioBufferSize < 0) then + begin + Result := BufferPos; + Exit; + end; + end; + + // calc number of new bytes in the decode-buffer + CopyByteCount := AudioBufferSize - AudioBufferPos; + // resize copy-count if more bytes available than needed (remaining bytes are used the next time) + RemainByteCount := BufferSize - BufferPos; + if (CopyByteCount > RemainByteCount) then + CopyByteCount := RemainByteCount; + + Move(AudioBuffer[AudioBufferPos], Buffer[BufferPos], CopyByteCount); + + Inc(BufferPos, CopyByteCount); + Inc(AudioBufferPos, CopyByteCount); + end; + finally + UnlockDecoder(); + end; + + Result := BufferSize; +end; + + +{ TAudioDecoder_FFmpeg } + +function TAudioDecoder_FFmpeg.GetName: String; +begin + Result := 'FFmpeg_Decoder'; +end; + +function TAudioDecoder_FFmpeg.InitializeDecoder: boolean; +begin + //Log.LogStatus('InitializeDecoder', 'UAudioDecoder_FFmpeg'); + FFmpegCore := TMediaCore_FFmpeg.GetInstance(); + av_register_all(); + + // Do not show uninformative error messages by default. + // FFmpeg prints all error-infos on the console by default what + // is very confusing as the playback of the files is correct. + // We consider these errors to be internal to FFMpeg. They can be fixed + // by the FFmpeg guys only and do not provide any useful information in + // respect to USDX. + {$IFNDEF EnableFFmpegErrorOutput} + {$IF LIBAVUTIL_VERSION_MAJOR >= 50} + av_log_set_level(AV_LOG_FATAL); + {$ELSE} + // FATAL and ERROR share one log-level, so we have to use QUIET + av_log_set_level(AV_LOG_QUIET); + {$IFEND} + {$ENDIF} + + Result := true; +end; + +function TAudioDecoder_FFmpeg.FinalizeDecoder(): boolean; +begin + Result := true; +end; + +function TAudioDecoder_FFmpeg.Open(const Filename: string): TAudioDecodeStream; +var + Stream: TFFmpegDecodeStream; +begin + Result := nil; + + Stream := TFFmpegDecodeStream.Create(); + if (not Stream.Open(Filename)) then + begin + Stream.Free; + Exit; + end; + + Result := Stream; +end; + + +initialization + MediaManager.Add(TAudioDecoder_FFmpeg.Create); + +end. diff --git a/src/classes0/UAudioInput_Bass.pas b/src/classes0/UAudioInput_Bass.pas new file mode 100644 index 00000000..65a4704d --- /dev/null +++ b/src/classes0/UAudioInput_Bass.pas @@ -0,0 +1,481 @@ +unit UAudioInput_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + URecord, + UMusic; + +implementation + +uses + UMain, + UIni, + ULog, + UAudioCore_Bass, + UCommon, // (Note: for MakeLong on non-windows platforms) + {$IFDEF MSWINDOWS} + Windows, // (Note: for MakeLong) + {$ENDIF} + bass; // (Note: DWORD is redefined here -> insert after Windows-unit) + +type + TAudioInput_Bass = class(TAudioInputBase) + private + function EnumDevices(): boolean; + public + function GetName: String; override; + function InitializeRecord: boolean; override; + function FinalizeRecord: boolean; override; + end; + + TBassInputDevice = class(TAudioInputDevice) + private + RecordStream: HSTREAM; + BassDeviceID: DWORD; // DeviceID used by BASS + SingleIn: boolean; + + function SetInputSource(SourceIndex: integer): boolean; + function GetInputSource(): integer; + public + function Open(): boolean; + function Close(): boolean; + function Start(): boolean; override; + function Stop(): boolean; override; + + function GetVolume(): single; override; + procedure SetVolume(Volume: single); override; + end; + +var + BassCore: TAudioCore_Bass; + + +{ Global } + +{* + * Bass input capture callback. + * Params: + * stream - BASS input stream + * buffer - buffer of captured samples + * len - size of buffer in bytes + * user - players associated with left/right channels + *} +function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; + len: Cardinal; inputDevice: Pointer): boolean; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} +begin + AudioInputProcessor.HandleMicrophoneData(buffer, len, inputDevice); + Result := true; +end; + + +{ TBassInputDevice } + +function TBassInputDevice.GetInputSource(): integer; +var + SourceCnt: integer; + i: integer; + flags: DWORD; +begin + // get input-source config (subtract virtual device to get BASS indices) + SourceCnt := Length(Source)-1; + + // find source + Result := -1; + for i := 0 to SourceCnt-1 do + begin + // get input settings + flags := BASS_RecordGetInput(i, PSingle(nil)^); + if (flags = DWORD(-1)) then + begin + Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource'); + Exit; + end; + + // check if current source is selected + if ((flags and BASS_INPUT_OFF) = 0) then + begin + // selected source found + Result := i; + Exit; + end; + end; +end; + +function TBassInputDevice.SetInputSource(SourceIndex: integer): boolean; +var + SourceCnt: integer; + i: integer; + flags: DWORD; +begin + Result := false; + + // check for invalid source index + if (SourceIndex < 0) then + Exit; + + // get input-source config (subtract virtual device to get BASS indices) + SourceCnt := Length(Source)-1; + + // turn on selected source (turns off the others for single-in devices) + if (not BASS_RecordSetInput(SourceIndex, BASS_INPUT_ON, -1)) then + begin + Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start'); + Exit; + end; + + // turn off all other sources (not needed for single-in devices) + if (not SingleIn) then + begin + for i := 0 to SourceCnt-1 do + begin + if (i = SourceIndex) then + continue; + // get input settings + flags := BASS_RecordGetInput(i, PSingle(nil)^); + if (flags = DWORD(-1)) then + begin + Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource'); + Exit; + end; + // deselect source if selected + if ((flags and BASS_INPUT_OFF) = 0) then + BASS_RecordSetInput(i, BASS_INPUT_OFF, -1); + end; + end; + + Result := true; +end; + +function TBassInputDevice.Open(): boolean; +var + FormatFlags: DWORD; + SourceIndex: integer; +const + latency = 20; // 20ms callback period (= latency) +begin + Result := false; + + if (not BASS_RecordInit(BassDeviceID)) then + begin + Log.LogError('BASS_RecordInit['+Name+']: ' + + BassCore.ErrorGetString(), 'TBassInputDevice.Open'); + Exit; + end; + + if (not BassCore.ConvertAudioFormatToBASSFlags(AudioFormat.Format, FormatFlags)) then + begin + Log.LogError('Unhandled sample-format', 'TBassInputDevice.Open'); + Exit; + end; + + // start capturing in paused state + RecordStream := BASS_RecordStart(Round(AudioFormat.SampleRate), AudioFormat.Channels, + MakeLong(FormatFlags or BASS_RECORD_PAUSE, latency), + @MicrophoneCallback, Self); + if (RecordStream = 0) then + begin + Log.LogError('BASS_RecordStart: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Open'); + BASS_RecordFree; + Exit; + end; + + // save current source selection and select new source + SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; + if (SourceIndex = -1) then + begin + // nothing to do if default source is used + SourceRestore := -1; + end + else + begin + // store current source-index and select new source + SourceRestore := GetInputSource(); + SetInputSource(SourceIndex); + end; + + Result := true; +end; + +{* Start input-capturing on this device. *} +function TBassInputDevice.Start(): boolean; +begin + Result := false; + + // recording already started -> stop first + if (RecordStream <> 0) then + Stop(); + + // TODO: Do not open the device here (takes too much time). + if not Open() then + Exit; + + if (not BASS_ChannelPlay(RecordStream, true)) then + begin + Log.LogError('BASS_ChannelPlay: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start'); + Exit; + end; + + Result := true; +end; + +{* Stop input-capturing on this device. *} +function TBassInputDevice.Stop(): boolean; +begin + Result := false; + + if (RecordStream = 0) then + Exit; + if (not BASS_RecordSetDevice(BassDeviceID)) then + Exit; + + if (not BASS_ChannelStop(RecordStream)) then + begin + Log.LogError('BASS_ChannelStop: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Stop'); + end; + + // TODO: Do not close the device here (takes too much time). + Result := Close(); +end; + +function TBassInputDevice.Close(): boolean; +begin + // restore source selection + if (SourceRestore >= 0) then + begin + SetInputSource(SourceRestore); + end; + + // free data + if (not BASS_RecordFree()) then + begin + Log.LogError('BASS_RecordFree: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Close'); + Result := false; + end + else + begin + Result := true; + end; + + RecordStream := 0; +end; + +function TBassInputDevice.GetVolume(): single; +var + SourceIndex: integer; + lVolume: Single; +begin + Result := 0; + + SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; + if (SourceIndex = -1) then + begin + // if default source used find selected source + SourceIndex := GetInputSource(); + if (SourceIndex = -1) then + Exit; + end; + + if (BASS_RecordGetInput(SourceIndex, lVolume) = DWORD(-1)) then + begin + Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.GetVolume'); + Exit; + end; + Result := lVolume; +end; + +procedure TBassInputDevice.SetVolume(Volume: single); +var + SourceIndex: integer; +begin + SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; + if (SourceIndex = -1) then + begin + // if default source used find selected source + SourceIndex := GetInputSource(); + if (SourceIndex = -1) then + Exit; + end; + + // clip volume to valid range + if (Volume > 1.0) then + Volume := 1.0 + else if (Volume < 0) then + Volume := 0; + + if (not BASS_RecordSetInput(SourceIndex, 0, Volume)) then + begin + Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.SetVolume'); + end; +end; + + +{ TAudioInput_Bass } + +function TAudioInput_Bass.GetName: String; +begin + result := 'BASS_Input'; +end; + +function TAudioInput_Bass.EnumDevices(): boolean; +var + Descr: PChar; + SourceName: PChar; + Flags: integer; + BassDeviceID: integer; + BassDevice: TBassInputDevice; + DeviceIndex: integer; + DeviceInfo: BASS_DEVICEINFO; + SourceIndex: integer; + RecordInfo: BASS_RECORDINFO; + SelectedSourceIndex: integer; +begin + result := false; + + DeviceIndex := 0; + BassDeviceID := 0; + SetLength(AudioInputProcessor.DeviceList, 0); + + // checks for recording devices and puts them into an array + while true do + begin + if (not BASS_RecordGetDeviceInfo(BassDeviceID, DeviceInfo)) then + break; + + // try to initialize the device + if not BASS_RecordInit(BassDeviceID) then + begin + Log.LogStatus('Failed to initialize BASS Capture-Device['+inttostr(BassDeviceID)+']', + 'TAudioInput_Bass.InitializeRecord'); + end + else + begin + SetLength(AudioInputProcessor.DeviceList, DeviceIndex+1); + + // TODO: free object on termination + BassDevice := TBassInputDevice.Create(); + AudioInputProcessor.DeviceList[DeviceIndex] := BassDevice; + + Descr := DeviceInfo.name; + + BassDevice.BassDeviceID := BassDeviceID; + BassDevice.Name := UnifyDeviceName(Descr, DeviceIndex); + + // zero info-struct as some fields might not be set (e.g. freq is just set on Vista and MacOSX) + FillChar(RecordInfo, SizeOf(RecordInfo), 0); + // retrieve recording device info + BASS_RecordGetInfo(RecordInfo); + + // check if BASS has capture-freq. info + if (RecordInfo.freq > 0) then + begin + // use current input sample rate (available only on Windows Vista and OSX). + // Recording at this rate will give the best quality and performance, as no resampling is required. + // FIXME: does BASS use LSB/MSB or system integer values for 16bit? + BassDevice.AudioFormat := TAudioFormatInfo.Create(2, RecordInfo.freq, asfS16) + end + else + begin + // BASS does not provide an explizit input channel count (except BASS_RECORDINFO.formats) + // but it doesn't fail if we use stereo input on a mono device + // -> use stereo by default + BassDevice.AudioFormat := TAudioFormatInfo.Create(2, 44100, asfS16) + end; + + // get info if multiple input-sources can be selected at once + BassDevice.SingleIn := RecordInfo.singlein; + + // init list for capture buffers per channel + SetLength(BassDevice.CaptureChannel, BassDevice.AudioFormat.Channels); + + BassDevice.MicSource := -1; + BassDevice.SourceRestore := -1; + + // add a virtual default source (will not change mixer-settings) + SetLength(BassDevice.Source, 1); + BassDevice.Source[0].Name := DEFAULT_SOURCE_NAME; + + // add real input sources + SourceIndex := 1; + + // process each input + while true do + begin + SourceName := BASS_RecordGetInputName(SourceIndex-1); + + {$IFDEF DARWIN} + // Under MacOSX the SingStar Mics have an empty InputName. + // So, we have to add a hard coded Workaround for this problem + // FIXME: - Do we need this anymore? Doesn't the (new) default source already solve this problem? + // - Normally a nil return value of BASS_RecordGetInputName() means end-of-list, so maybe + // BASS is not able to detect any mic-sources (the default source will work then). + // - Does BASS_RecordGetInfo() return true or false? If it returns true in this case + // we could use this value to check if the device exists. + // Please check that, eddie. + // If it returns false, then the source is not detected and it does not make sense to add a second + // fake device here. + // What about BASS_RecordGetInput()? Does it return a value <> -1? + // - Does it even work at all with this fake source-index, now that input switching works? + // This info was not used before (sources were never switched), so it did not matter what source-index was used. + // But now BASS_RecordSetInput() will probably fail. + if ((SourceName = nil) and (SourceIndex = 1) and (Pos('USBMIC Serial#', Descr) > 0)) then + SourceName := 'Microphone' + {$ENDIF} + + if (SourceName = nil) then + break; + + SetLength(BassDevice.Source, Length(BassDevice.Source)+1); + BassDevice.Source[SourceIndex].Name := SourceName; + + // get input-source info + Flags := BASS_RecordGetInput(SourceIndex, PSingle(nil)^); + if (Flags <> -1) then + begin + // is the current source a mic-source? + if ((Flags and BASS_INPUT_TYPE_MIC) <> 0) then + BassDevice.MicSource := SourceIndex; + end; + + Inc(SourceIndex); + end; + + // FIXME: this call hangs in FPC (windows) every 2nd time USDX is called. + // Maybe because the sound-device was not released properly? + BASS_RecordFree; + + Inc(DeviceIndex); + end; + + Inc(BassDeviceID); + end; + + result := true; +end; + +function TAudioInput_Bass.InitializeRecord(): boolean; +begin + BassCore := TAudioCore_Bass.GetInstance(); + Result := EnumDevices(); +end; + +function TAudioInput_Bass.FinalizeRecord(): boolean; +begin + CaptureStop; + Result := inherited FinalizeRecord; +end; + + +initialization + MediaManager.Add(TAudioInput_Bass.Create); + +end. diff --git a/src/classes0/UAudioInput_Portaudio.pas b/src/classes0/UAudioInput_Portaudio.pas new file mode 100644 index 00000000..9a1c3e99 --- /dev/null +++ b/src/classes0/UAudioInput_Portaudio.pas @@ -0,0 +1,474 @@ +unit UAudioInput_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I ../switches.inc} + + +uses + Classes, + SysUtils, + UMusic; + +implementation + +uses + {$IFDEF UsePortmixer} + portmixer, + {$ENDIF} + portaudio, + UAudioCore_Portaudio, + URecord, + UIni, + ULog, + UMain; + +type + TAudioInput_Portaudio = class(TAudioInputBase) + private + AudioCore: TAudioCore_Portaudio; + function EnumDevices(): boolean; + public + function GetName: String; override; + function InitializeRecord: boolean; override; + function FinalizeRecord: boolean; override; + end; + + TPortaudioInputDevice = class(TAudioInputDevice) + private + RecordStream: PPaStream; + {$IFDEF UsePortmixer} + Mixer: PPxMixer; + {$ENDIF} + PaDeviceIndex: TPaDeviceIndex; + public + function Open(): boolean; + function Close(): boolean; + function Start(): boolean; override; + function Stop(): boolean; override; + + function GetVolume(): single; override; + procedure SetVolume(Volume: single); override; + end; + +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; forward; + +function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; forward; + + +{ TPortaudioInputDevice } + +function TPortaudioInputDevice.Open(): boolean; +var + Error: TPaError; + inputParams: TPaStreamParameters; + deviceInfo: PPaDeviceInfo; + SourceIndex: integer; +begin + Result := false; + + // get input latency info + deviceInfo := Pa_GetDeviceInfo(PaDeviceIndex); + + // set input stream parameters + with inputParams do + begin + device := PaDeviceIndex; + channelCount := AudioFormat.Channels; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + //Log.LogStatus(deviceInfo^.name, 'Portaudio'); + //Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); + + // open input stream + Error := Pa_OpenStream(RecordStream, @inputParams, nil, + AudioFormat.SampleRate, + paFramesPerBufferUnspecified, paNoFlag, + @MicrophoneCallback, Pointer(Self)); + if(Error <> paNoError) then + begin + Log.LogError('Error opening stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open'); + Exit; + end; + + {$IFDEF UsePortmixer} + // open default mixer + Mixer := Px_OpenMixer(RecordStream, 0); + if (Mixer = nil) then + begin + Log.LogError('Error opening mixer: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open'); + end + else + begin + // save current source selection and select new source + SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; + if (SourceIndex = -1) then + begin + // nothing to do if default source is used + SourceRestore := -1; + end + else + begin + // store current source-index and select new source + SourceRestore := Px_GetCurrentInputSource(Mixer); // -1 in error case + Px_SetCurrentInputSource(Mixer, SourceIndex); + end; + end; + {$ENDIF} + + Result := true; +end; + +function TPortaudioInputDevice.Start(): boolean; +var + Error: TPaError; +begin + Result := false; + + // recording already started -> stop first + if (RecordStream <> nil) then + Stop(); + + // TODO: Do not open the device here (takes too much time). + if (not Open()) then + Exit; + + // start capture + Error := Pa_StartStream(RecordStream); + if(Error <> paNoError) then + begin + Log.LogError('Error starting stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Start'); + Close(); + RecordStream := nil; + Exit; + end; + + Result := true; +end; + +function TPortaudioInputDevice.Stop(): boolean; +var + Error: TPaError; +begin + Result := false; + + if (RecordStream = nil) then + Exit; + + // Note: do NOT call Pa_StopStream here! + // It gets stuck on devices with non-working callback as Pa_StopStream + // waits until all buffers have been handled (which never occurs in that case). + Error := Pa_AbortStream(RecordStream); + if (Error <> paNoError) then + begin + Log.LogError('Pa_AbortStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Stop'); + end; + + Result := Close(); +end; + +function TPortaudioInputDevice.Close(): boolean; +var + Error: TPaError; +begin + {$IFDEF UsePortmixer} + if (Mixer <> nil) then + begin + // restore source selection + if (SourceRestore >= 0) then + begin + Px_SetCurrentInputSource(Mixer, SourceRestore); + end; + + // close mixer + Px_CloseMixer(Mixer); + Mixer := nil; + end; + {$ENDIF} + + Error := Pa_CloseStream(RecordStream); + if (Error <> paNoError) then + begin + Log.LogError('Pa_CloseStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Close'); + Result := false; + end + else + begin + Result := true; + end; + + RecordStream := nil; +end; + +function TPortaudioInputDevice.GetVolume(): single; +begin + Result := 0; + {$IFDEF UsePortmixer} + if (Mixer <> nil) then + Result := Px_GetInputVolume(Mixer); + {$ENDIF} +end; + +procedure TPortaudioInputDevice.SetVolume(Volume: single); +begin + {$IFDEF UsePortmixer} + if (Mixer <> nil) then + begin + // clip to valid range + if (Volume > 1.0) then + Volume := 1.0 + else if (Volume < 0) then + Volume := 0; + Px_SetInputVolume(Mixer, Volume); + end; + {$ENDIF} +end; + + +{ TAudioInput_Portaudio } + +function TAudioInput_Portaudio.GetName: String; +begin + result := 'Portaudio'; +end; + +function TAudioInput_Portaudio.EnumDevices(): boolean; +var + i: integer; + paApiIndex: TPaHostApiIndex; + paApiInfo: PPaHostApiInfo; + deviceName: string; + deviceIndex: TPaDeviceIndex; + deviceInfo: PPaDeviceInfo; + channelCnt: integer; + SC: integer; // soundcard + err: TPaError; + errMsg: string; + paDevice: TPortaudioInputDevice; + inputParams: TPaStreamParameters; + stream: PPaStream; + streamInfo: PPaStreamInfo; + sampleRate: double; + latency: TPaTime; + {$IFDEF UsePortmixer} + mixer: PPxMixer; + sourceCnt: integer; + sourceIndex: integer; + sourceName: string; + {$ENDIF} + cbPolls: integer; + cbWorks: boolean; +begin + Result := false; + + // choose the best available Audio-API + paApiIndex := AudioCore.GetPreferredApiIndex(); + if(paApiIndex = -1) then + begin + Log.LogError('No working Audio-API found', 'TAudioInput_Portaudio.EnumDevices'); + Exit; + end; + + paApiInfo := Pa_GetHostApiInfo(paApiIndex); + + SC := 0; + + // init array-size to max. input-devices count + SetLength(AudioInputProcessor.DeviceList, paApiInfo^.deviceCount); + for i:= 0 to High(AudioInputProcessor.DeviceList) do + begin + // convert API-specific device-index to global index + deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i); + deviceInfo := Pa_GetDeviceInfo(deviceIndex); + + channelCnt := deviceInfo^.maxInputChannels; + + // current device is no input device -> skip + if (channelCnt <= 0) then + continue; + + // portaudio returns a channel-count of 128 for some devices + // (e.g. the "default"-device), so we have to detect those + // fantasy channel counts. + if (channelCnt > 8) then + channelCnt := 2; + + paDevice := TPortaudioInputDevice.Create(); + AudioInputProcessor.DeviceList[SC] := paDevice; + + // retrieve device-name + deviceName := deviceInfo^.name; + paDevice.Name := deviceName; + paDevice.PaDeviceIndex := deviceIndex; + + sampleRate := deviceInfo^.defaultSampleRate; + + // on vista and xp the defaultLowInputLatency may be set to 0 but it works. + // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?) + latency := deviceInfo^.defaultLowInputLatency; + + // setup desired input parameters + // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might + // not be set correctly in OSS) + with inputParams do + begin + device := deviceIndex; + channelCount := channelCnt; + sampleFormat := paInt16; + suggestedLatency := latency; + hostApiSpecificStreamInfo := nil; + end; + + // check souncard and adjust sample-rate + if (not AudioCore.TestDevice(@inputParams, nil, sampleRate)) then + begin + // ignore device if it does not work + Log.LogError('Device "'+paDevice.Name+'" does not work', + 'TAudioInput_Portaudio.EnumDevices'); + paDevice.Free(); + continue; + end; + + // open device for further info + err := Pa_OpenStream(stream, @inputParams, nil, sampleRate, + paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil); + if(err <> paNoError) then + begin + // unable to open device -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')', + 'TAudioInput_Portaudio.EnumDevices'); + paDevice.Free(); + continue; + end; + + // adjust sample-rate (might be changed by portaudio) + streamInfo := Pa_GetStreamInfo(stream); + if (streamInfo <> nil) then + begin + if (sampleRate <> streamInfo^.sampleRate) then + begin + Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) + + ' to ' + FloatToStr(streamInfo^.sampleRate), + 'TAudioInput_Portaudio.InitializeRecord'); + sampleRate := streamInfo^.sampleRate; + end; + end; + + // create audio-format info and resize capture-buffer array + paDevice.AudioFormat := TAudioFormatInfo.Create( + channelCnt, + sampleRate, + asfS16 + ); + SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels); + + Log.LogStatus('InputDevice "'+paDevice.Name+'"@' + + IntToStr(paDevice.AudioFormat.Channels)+'x'+ + FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+ + FloatTostr(inputParams.suggestedLatency)+'sec)' , + 'Portaudio.EnumDevices'); + + // portaudio does not provide a source-type check + paDevice.MicSource := -1; + paDevice.SourceRestore := -1; + + // add a virtual default source (will not change mixer-settings) + SetLength(paDevice.Source, 1); + paDevice.Source[0].Name := DEFAULT_SOURCE_NAME; + + {$IFDEF UsePortmixer} + // use default mixer + mixer := Px_OpenMixer(stream, 0); + + // get input count + sourceCnt := Px_GetNumInputSources(mixer); + SetLength(paDevice.Source, sourceCnt+1); + + // get input names + for sourceIndex := 1 to sourceCnt do + begin + sourceName := Px_GetInputSourceName(mixer, sourceIndex-1); + paDevice.Source[sourceIndex].Name := sourceName; + end; + + Px_CloseMixer(mixer); + {$ENDIF} + + // close test-stream + Pa_CloseStream(stream); + + Inc(SC); + end; + + // adjust size to actual input-device count + SetLength(AudioInputProcessor.DeviceList, SC); + + Log.LogStatus('#Input-Devices: ' + inttostr(SC), 'Portaudio'); + + Result := true; +end; + +function TAudioInput_Portaudio.InitializeRecord(): boolean; +var + err: TPaError; +begin + AudioCore := TAudioCore_Portaudio.GetInstance(); + + // initialize portaudio + err := Pa_Initialize(); + if(err <> paNoError) then + begin + Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord'); + Result := false; + Exit; + end; + + Result := EnumDevices(); +end; + +function TAudioInput_Portaudio.FinalizeRecord: boolean; +begin + CaptureStop; + Pa_Terminate(); + Result := inherited FinalizeRecord(); +end; + +{* + * Portaudio input capture callback. + *} +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; +begin + AudioInputProcessor.HandleMicrophoneData(input, frameCount*4, inputDevice); + result := paContinue; +end; + +{* + * Portaudio test capture callback. + *} +function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; +begin + // this callback is called only once + result := paAbort; +end; + + +initialization + MediaManager.add(TAudioInput_Portaudio.Create); + +end. diff --git a/src/classes0/UAudioPlaybackBase.pas b/src/classes0/UAudioPlaybackBase.pas new file mode 100644 index 00000000..2337d43f --- /dev/null +++ b/src/classes0/UAudioPlaybackBase.pas @@ -0,0 +1,292 @@ +unit UAudioPlaybackBase; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UMusic; + +type + TAudioPlaybackBase = class(TInterfacedObject, IAudioPlayback) + protected + OutputDeviceList: TAudioOutputDeviceList; + MusicStream: TAudioPlaybackStream; + function CreatePlaybackStream(): TAudioPlaybackStream; virtual; abstract; + procedure ClearOutputDeviceList(); + function GetLatency(): double; virtual; abstract; + + // open sound or music stream (used by Open() and OpenSound()) + function OpenStream(const Filename: string): TAudioPlaybackStream; + function OpenDecodeStream(const Filename: string): TAudioDecodeStream; + public + function GetName: string; virtual; abstract; + + function Open(const Filename: string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + procedure FadeIn(Time: real; TargetVolume: single); + + procedure SetSyncSource(SyncSource: TSyncSource); + + procedure SetPosition(Time: real); + function GetPosition: real; + + function InitializePlayback: boolean; virtual; abstract; + function FinalizePlayback: boolean; virtual; + + //function SetOutputDevice(Device: TAudioOutputDevice): boolean; + function GetOutputDeviceList(): TAudioOutputDeviceList; + + procedure SetAppVolume(Volume: single); virtual; abstract; + procedure SetVolume(Volume: single); + procedure SetLoop(Enabled: boolean); + + procedure Rewind; + function Finished: boolean; + function Length: real; + + // Sounds + function OpenSound(const Filename: string): TAudioPlaybackStream; + procedure PlaySound(Stream: TAudioPlaybackStream); + procedure StopSound(Stream: TAudioPlaybackStream); + + // Equalizer + procedure GetFFTData(var Data: TFFTData); + + // Interface for Visualizer + function GetPCMData(var Data: TPCMData): Cardinal; + + function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; virtual; abstract; + end; + + +implementation + +uses + ULog, + SysUtils; + +{ TAudioPlaybackBase } + +function TAudioPlaybackBase.FinalizePlayback: boolean; +begin + FreeAndNil(MusicStream); + ClearOutputDeviceList(); + Result := true; +end; + +function TAudioPlaybackBase.Open(const Filename: string): boolean; +begin + // free old MusicStream + MusicStream.Free; + + MusicStream := OpenStream(Filename); + if not assigned(MusicStream) then + begin + Result := false; + Exit; + end; + + //MusicStream.AddSoundEffect(TVoiceRemoval.Create()); + + Result := true; +end; + +procedure TAudioPlaybackBase.Close; +begin + FreeAndNil(MusicStream); +end; + +function TAudioPlaybackBase.OpenDecodeStream(const Filename: String): TAudioDecodeStream; +var + i: integer; +begin + for i := 0 to AudioDecoders.Count-1 do + begin + Result := IAudioDecoder(AudioDecoders[i]).Open(Filename); + if (assigned(Result)) then + begin + Log.LogInfo('Using decoder ' + IAudioDecoder(AudioDecoders[i]).GetName() + + ' for "' + Filename + '"', 'TAudioPlaybackBase.OpenDecodeStream'); + Exit; + end; + end; + Result := nil; +end; + +procedure OnClosePlaybackStream(Stream: TAudioProcessingStream); +var + PlaybackStream: TAudioPlaybackStream; + SourceStream: TAudioSourceStream; +begin + PlaybackStream := TAudioPlaybackStream(Stream); + SourceStream := PlaybackStream.GetSourceStream(); + SourceStream.Free; +end; + +function TAudioPlaybackBase.OpenStream(const Filename: string): TAudioPlaybackStream; +var + PlaybackStream: TAudioPlaybackStream; + DecodeStream: TAudioDecodeStream; +begin + Result := nil; + + //Log.LogStatus('Loading Sound: "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream'); + + DecodeStream := OpenDecodeStream(Filename); + if (not assigned(DecodeStream)) then + begin + Log.LogStatus('Could not open "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream'); + Exit; + end; + + // create a matching playback-stream for the decoder + PlaybackStream := CreatePlaybackStream(); + if (not PlaybackStream.Open(DecodeStream)) then + begin + FreeAndNil(PlaybackStream); + FreeAndNil(DecodeStream); + Exit; + end; + + PlaybackStream.AddOnCloseHandler(OnClosePlaybackStream); + + Result := PlaybackStream; +end; + +procedure TAudioPlaybackBase.Play; +begin + if assigned(MusicStream) then + MusicStream.Play(); +end; + +procedure TAudioPlaybackBase.Pause; +begin + if assigned(MusicStream) then + MusicStream.Pause(); +end; + +procedure TAudioPlaybackBase.Stop; +begin + if assigned(MusicStream) then + MusicStream.Stop(); +end; + +function TAudioPlaybackBase.Length: real; +begin + if assigned(MusicStream) then + Result := MusicStream.Length + else + Result := 0; +end; + +function TAudioPlaybackBase.GetPosition: real; +begin + if assigned(MusicStream) then + Result := MusicStream.Position + else + Result := 0; +end; + +procedure TAudioPlaybackBase.SetPosition(Time: real); +begin + if assigned(MusicStream) then + MusicStream.Position := Time; +end; + +procedure TAudioPlaybackBase.SetSyncSource(SyncSource: TSyncSource); +begin + if assigned(MusicStream) then + MusicStream.SetSyncSource(SyncSource); +end; + +procedure TAudioPlaybackBase.Rewind; +begin + SetPosition(0); +end; + +function TAudioPlaybackBase.Finished: boolean; +begin + if assigned(MusicStream) then + Result := (MusicStream.Status = ssStopped) + else + Result := true; +end; + +procedure TAudioPlaybackBase.SetVolume(Volume: single); +begin + if assigned(MusicStream) then + MusicStream.Volume := Volume; +end; + +procedure TAudioPlaybackBase.FadeIn(Time: real; TargetVolume: single); +begin + if assigned(MusicStream) then + MusicStream.FadeIn(Time, TargetVolume); +end; + +procedure TAudioPlaybackBase.SetLoop(Enabled: boolean); +begin + if assigned(MusicStream) then + MusicStream.Loop := Enabled; +end; + +// Equalizer +procedure TAudioPlaybackBase.GetFFTData(var data: TFFTData); +begin + if assigned(MusicStream) then + MusicStream.GetFFTData(data); +end; + +{* + * Copies interleaved PCM SInt16 stereo samples into data. + * Returns the number of frames + *} +function TAudioPlaybackBase.GetPCMData(var data: TPCMData): Cardinal; +begin + if assigned(MusicStream) then + Result := MusicStream.GetPCMData(data) + else + Result := 0; +end; + +function TAudioPlaybackBase.OpenSound(const Filename: string): TAudioPlaybackStream; +begin + Result := OpenStream(Filename); +end; + +procedure TAudioPlaybackBase.PlaySound(stream: TAudioPlaybackStream); +begin + if assigned(stream) then + stream.Play(); +end; + +procedure TAudioPlaybackBase.StopSound(stream: TAudioPlaybackStream); +begin + if assigned(stream) then + stream.Stop(); +end; + +procedure TAudioPlaybackBase.ClearOutputDeviceList(); +var + DeviceIndex: integer; +begin + for DeviceIndex := 0 to High(OutputDeviceList) do + OutputDeviceList[DeviceIndex].Free(); + SetLength(OutputDeviceList, 0); +end; + +function TAudioPlaybackBase.GetOutputDeviceList(): TAudioOutputDeviceList; +begin + Result := OutputDeviceList; +end; + +end. diff --git a/src/classes0/UAudioPlayback_Bass.pas b/src/classes0/UAudioPlayback_Bass.pas new file mode 100644 index 00000000..41a91173 --- /dev/null +++ b/src/classes0/UAudioPlayback_Bass.pas @@ -0,0 +1,731 @@ +unit UAudioPlayback_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +implementation + +uses + Classes, + SysUtils, + Math, + UIni, + UMain, + UMusic, + UAudioPlaybackBase, + UAudioCore_Bass, + ULog, + sdl, + bass; + +type + PHDSP = ^HDSP; + +type + TBassPlaybackStream = class(TAudioPlaybackStream) + private + Handle: HSTREAM; + NeedsRewind: boolean; + PausedSeek: boolean; // true if a seek was performed in pause state + + procedure Reset(); + function IsEOF(): boolean; + protected + function GetLatency(): double; override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function GetLength(): real; override; + function GetStatus(): TStreamStatus; override; + function GetVolume(): single; override; + procedure SetVolume(Volume: single); override; + function GetPosition: real; override; + procedure SetPosition(Time: real); override; + public + constructor Create(); + destructor Destroy(); override; + + function Open(SourceStream: TAudioSourceStream): boolean; override; + procedure Close(); override; + + procedure Play(); override; + procedure Pause(); override; + procedure Stop(); override; + procedure FadeIn(Time: real; TargetVolume: single); override; + + procedure AddSoundEffect(Effect: TSoundEffect); override; + procedure RemoveSoundEffect(Effect: TSoundEffect); override; + + procedure GetFFTData(var Data: TFFTData); override; + function GetPCMData(var Data: TPCMData): Cardinal; override; + + function GetAudioFormatInfo(): TAudioFormatInfo; override; + + function ReadData(Buffer: PChar; BufferSize: integer): integer; + + property EOF: boolean READ IsEOF; + end; + +const + MAX_VOICE_DELAY = 0.020; // 20ms + +type + TBassVoiceStream = class(TAudioVoiceStream) + private + Handle: HSTREAM; + public + function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override; + procedure Close(); override; + + procedure WriteData(Buffer: PChar; BufferSize: integer); override; + function ReadData(Buffer: PChar; BufferSize: integer): integer; override; + function IsEOF(): boolean; override; + function IsError(): boolean; override; + end; + +type + TAudioPlayback_Bass = class(TAudioPlaybackBase) + private + function EnumDevices(): boolean; + protected + function GetLatency(): double; override; + function CreatePlaybackStream(): TAudioPlaybackStream; override; + public + function GetName: String; override; + function InitializePlayback(): boolean; override; + function FinalizePlayback: boolean; override; + procedure SetAppVolume(Volume: single); override; + function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override; + end; + + TBassOutputDevice = class(TAudioOutputDevice) + private + BassDeviceID: DWORD; // DeviceID used by BASS + end; + +var + BassCore: TAudioCore_Bass; + + +{ TBassPlaybackStream } + +function PlaybackStreamHandler(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; +{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} +var + PlaybackStream: TBassPlaybackStream; + BytesRead: integer; +begin + PlaybackStream := TBassPlaybackStream(user); + if (not assigned (PlaybackStream)) then + begin + Result := BASS_STREAMPROC_END; + Exit; + end; + + BytesRead := PlaybackStream.ReadData(buffer, length); + // check for errors + if (BytesRead < 0) then + Result := BASS_STREAMPROC_END + // check for EOF + else if (PlaybackStream.EOF) then + Result := BytesRead or BASS_STREAMPROC_END + // no error/EOF + else + Result := BytesRead; +end; + +function TBassPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +var + AdjustedSize: integer; + RequestedSourceSize, SourceSize: integer; + SkipCount: integer; + SourceFormatInfo: TAudioFormatInfo; + FrameSize: integer; + PadFrame: PChar; + //Info: BASS_INFO; + //Latency: double; +begin + Result := -1; + + if (not assigned(SourceStream)) then + Exit; + + // sanity check + if (BufferSize = 0) then + begin + Result := 0; + Exit; + end; + + SourceFormatInfo := SourceStream.GetAudioFormatInfo(); + FrameSize := SourceFormatInfo.FrameSize; + + // check how much data to fetch to be in synch + AdjustedSize := Synchronize(BufferSize, SourceFormatInfo); + + // skip data if we are too far behind + SkipCount := AdjustedSize - BufferSize; + while (SkipCount > 0) do + begin + RequestedSourceSize := Min(SkipCount, BufferSize); + SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize); + // if an error or EOF occured stop skipping and handle error/EOF with the next ReadData() + if (SourceSize <= 0) then + break; + Dec(SkipCount, SourceSize); + end; + + // get source data (e.g. from a decoder) + RequestedSourceSize := Min(AdjustedSize, BufferSize); + SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize); + if (SourceSize < 0) then + Exit; + + // set preliminary result + Result := SourceSize; + + // if we are to far ahead, fill output-buffer with last frame of source data + // Note that AdjustedSize is used instead of SourceSize as the SourceSize might + // be less than expected because of errors etc. + if (AdjustedSize < BufferSize) then + begin + // use either the last frame for padding or fill with zero + if (SourceSize >= FrameSize) then + PadFrame := @Buffer[SourceSize-FrameSize] + else + PadFrame := nil; + + FillBufferWithFrame(@Buffer[SourceSize], BufferSize - SourceSize, + PadFrame, FrameSize); + Result := BufferSize; + end; +end; + +constructor TBassPlaybackStream.Create(); +begin + inherited; + Reset(); +end; + +destructor TBassPlaybackStream.Destroy(); +begin + Close(); + inherited; +end; + +function TBassPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean; +var + FormatInfo: TAudioFormatInfo; + FormatFlags: DWORD; +begin + Result := false; + + // close previous stream and reset state + Reset(); + + // sanity check if stream is valid + if not assigned(SourceStream) then + Exit; + + Self.SourceStream := SourceStream; + FormatInfo := SourceStream.GetAudioFormatInfo(); + if (not BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, FormatFlags)) then + begin + Log.LogError('Unhandled sample-format', 'TBassPlaybackStream.Open'); + Exit; + end; + + // create matching playback stream + Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), FormatInfo.Channels, formatFlags, + @PlaybackStreamHandler, Self); + if (Handle = 0) then + begin + Log.LogError('BASS_StreamCreate failed: ' + BassCore.ErrorGetString(BASS_ErrorGetCode()), + 'TBassPlaybackStream.Open'); + Exit; + end; + + Result := true; +end; + +procedure TBassPlaybackStream.Close(); +begin + // stop and free stream + if (Handle <> 0) then + begin + Bass_StreamFree(Handle); + Handle := 0; + end; + + // Note: PerformOnClose must be called before SourceStream is invalidated + PerformOnClose(); + // unset source-stream + SourceStream := nil; +end; + +procedure TBassPlaybackStream.Reset(); +begin + Close(); + NeedsRewind := false; + PausedSeek := false; +end; + +procedure TBassPlaybackStream.Play(); +var + NeedsFlush: boolean; +begin + if (not assigned(SourceStream)) then + Exit; + + NeedsFlush := true; + + if (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_PAUSED) then + begin + // only paused (and not seeked while paused) streams are not flushed + if (not PausedSeek) then + NeedsFlush := false; + // paused streams do not need a rewind + NeedsRewind := false; + end; + + // rewind if necessary. Cases that require no rewind are: + // - stream was created and never played + // - stream was paused and is resumed now + // - stream was stopped and set to a new position already + if (NeedsRewind) then + SourceStream.Position := 0; + + NeedsRewind := true; + PausedSeek := false; + + // start playing and flush buffers on rewind + BASS_ChannelPlay(Handle, NeedsFlush); +end; + +procedure TBassPlaybackStream.FadeIn(Time: real; TargetVolume: single); +begin + // start stream + Play(); + // start fade-in: slide from fadeStart- to fadeEnd-volume in FadeInTime + BASS_ChannelSlideAttribute(Handle, BASS_ATTRIB_VOL, TargetVolume, Trunc(Time * 1000)); +end; + +procedure TBassPlaybackStream.Pause(); +begin + BASS_ChannelPause(Handle); +end; + +procedure TBassPlaybackStream.Stop(); +begin + BASS_ChannelStop(Handle); +end; + +function TBassPlaybackStream.IsEOF(): boolean; +begin + if (assigned(SourceStream)) then + Result := SourceStream.EOF + else + Result := true; +end; + +function TBassPlaybackStream.GetLatency(): double; +begin + // TODO: should we consider output latency for synching (needs BASS_DEVICE_LATENCY)? + //if (BASS_GetInfo(Info)) then + // Latency := Info.latency / 1000 + //else + // Latency := 0; + Result := 0; +end; + +function TBassPlaybackStream.GetVolume(): single; +var + lVolume: single; +begin + if (not BASS_ChannelGetAttribute(Handle, BASS_ATTRIB_VOL, lVolume)) then + begin + Log.LogError('BASS_ChannelGetAttribute: ' + BassCore.ErrorGetString(), + 'TBassPlaybackStream.GetVolume'); + Result := 0; + Exit; + end; + Result := Round(lVolume); +end; + +procedure TBassPlaybackStream.SetVolume(Volume: single); +begin + // clamp volume + if Volume < 0 then + Volume := 0; + if Volume > 1.0 then + Volume := 1.0; + // set volume + BASS_ChannelSetAttribute(Handle, BASS_ATTRIB_VOL, Volume); +end; + +function TBassPlaybackStream.GetPosition: real; +var + BufferPosByte: QWORD; + BufferPosSec: double; +begin + if assigned(SourceStream) then + begin + BufferPosByte := BASS_ChannelGetData(Handle, nil, BASS_DATA_AVAILABLE); + BufferPosSec := BASS_ChannelBytes2Seconds(Handle, BufferPosByte); + // decrease the decoding position by the amount buffered (and hence not played) + // in the BASS playback stream. + Result := SourceStream.Position - BufferPosSec; + end + else + begin + Result := -1; + end; +end; + +procedure TBassPlaybackStream.SetPosition(Time: real); +var + ChannelState: DWORD; +begin + if assigned(SourceStream) then + begin + ChannelState := BASS_ChannelIsActive(Handle); + if (ChannelState = BASS_ACTIVE_STOPPED) then + begin + // if the stream is stopped, do not rewind when the stream is played next time + NeedsRewind := false + end + else if (ChannelState = BASS_ACTIVE_PAUSED) then + begin + // buffers must be flushed if in paused state but there is no + // BASS_ChannelFlush() function so we have to use BASS_ChannelPlay() called in Play(). + PausedSeek := true; + end; + + // set new position + SourceStream.Position := Time; + end; +end; + +function TBassPlaybackStream.GetLength(): real; +begin + if assigned(SourceStream) then + Result := SourceStream.Length + else + Result := -1; +end; + +function TBassPlaybackStream.GetStatus(): TStreamStatus; +var + State: DWORD; +begin + State := BASS_ChannelIsActive(Handle); + case State of + BASS_ACTIVE_PLAYING, + BASS_ACTIVE_STALLED: + Result := ssPlaying; + BASS_ACTIVE_PAUSED: + Result := ssPaused; + BASS_ACTIVE_STOPPED: + Result := ssStopped; + else + begin + Log.LogError('Unknown status', 'TBassPlaybackStream.GetStatus'); + Result := ssStopped; + end; + end; +end; + +function TBassPlaybackStream.GetLoop(): boolean; +begin + if assigned(SourceStream) then + Result := SourceStream.Loop + else + Result := false; +end; + +procedure TBassPlaybackStream.SetLoop(Enabled: boolean); +begin + if assigned(SourceStream) then + SourceStream.Loop := Enabled; +end; + +procedure DSPProcHandler(handle: HDSP; channel: DWORD; buffer: Pointer; length: DWORD; user: Pointer); +{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} +var + Effect: TSoundEffect; +begin + Effect := TSoundEffect(user); + if assigned(Effect) then + Effect.Callback(buffer, length); +end; + +procedure TBassPlaybackStream.AddSoundEffect(Effect: TSoundEffect); +var + DspHandle: HDSP; +begin + if assigned(Effect.engineData) then + begin + Log.LogError('TSoundEffect.engineData already set', 'TBassPlaybackStream.AddSoundEffect'); + Exit; + end; + + DspHandle := BASS_ChannelSetDSP(Handle, @DSPProcHandler, Effect, 0); + if (DspHandle = 0) then + begin + Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.AddSoundEffect'); + Exit; + end; + + GetMem(Effect.EngineData, SizeOf(HDSP)); + PHDSP(Effect.EngineData)^ := DspHandle; +end; + +procedure TBassPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect); +begin + if not assigned(Effect.EngineData) then + begin + Log.LogError('TSoundEffect.engineData invalid', 'TBassPlaybackStream.RemoveSoundEffect'); + Exit; + end; + + if not BASS_ChannelRemoveDSP(Handle, PHDSP(Effect.EngineData)^) then + begin + Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.RemoveSoundEffect'); + Exit; + end; + + FreeMem(Effect.EngineData); + Effect.EngineData := nil; +end; + +procedure TBassPlaybackStream.GetFFTData(var Data: TFFTData); +begin + // get FFT channel data (Mono, FFT512 -> 256 values) + BASS_ChannelGetData(Handle, @Data, BASS_DATA_FFT512); +end; + +{* + * Copies interleaved PCM SInt16 stereo samples into data. + * Returns the number of frames + *} +function TBassPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal; +var + Info: BASS_CHANNELINFO; + nBytes: DWORD; +begin + Result := 0; + + FillChar(Data, SizeOf(TPCMData), 0); + + // no support for non-stereo files at the moment + BASS_ChannelGetInfo(Handle, Info); + if (Info.chans <> 2) then + Exit; + + nBytes := BASS_ChannelGetData(Handle, @Data, SizeOf(TPCMData)); + if(nBytes <= 0) then + Result := 0 + else + Result := nBytes div SizeOf(TPCMStereoSample); +end; + +function TBassPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + if assigned(SourceStream) then + Result := SourceStream.GetAudioFormatInfo() + else + Result := nil; +end; + + +{ TBassVoiceStream } + +function TBassVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; +var + Flags: DWORD; +begin + Result := false; + + Close(); + + if (not inherited Open(ChannelMap, FormatInfo)) then + Exit; + + // get channel flags + BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, Flags); + + (* + // distribute the mics equally to both speakers + if ((ChannelMap and CHANNELMAP_LEFT) <> 0) then + Flags := Flags or BASS_SPEAKER_FRONTLEFT; + if ((ChannelMap and CHANNELMAP_RIGHT) <> 0) then + Flags := Flags or BASS_SPEAKER_FRONTRIGHT; + *) + + // create the channel + Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), 1, Flags, STREAMPROC_PUSH, nil); + + // start the channel + BASS_ChannelPlay(Handle, true); + + Result := true; +end; + +procedure TBassVoiceStream.Close(); +begin + if (Handle <> 0) then + begin + BASS_ChannelStop(Handle); + BASS_StreamFree(Handle); + end; + inherited Close(); +end; + +procedure TBassVoiceStream.WriteData(Buffer: PChar; BufferSize: integer); +var QueueSize: DWORD; +begin + if ((Handle <> 0) and (BufferSize > 0)) then + begin + // query the queue size (normally 0) + QueueSize := BASS_StreamPutData(Handle, nil, 0); + // flush the buffer if the delay would be too high + if (QueueSize > MAX_VOICE_DELAY * FormatInfo.BytesPerSec) then + BASS_ChannelPlay(Handle, true); + // send new data to playback buffer + BASS_StreamPutData(Handle, Buffer, BufferSize); + end; +end; + +// Note: we do not need the read-function for the BASS implementation +function TBassVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +begin + Result := -1; +end; + +function TBassVoiceStream.IsEOF(): boolean; +begin + Result := false; +end; + +function TBassVoiceStream.IsError(): boolean; +begin + Result := false; +end; + + +{ TAudioPlayback_Bass } + +function TAudioPlayback_Bass.GetName: String; +begin + Result := 'BASS_Playback'; +end; + +function TAudioPlayback_Bass.EnumDevices(): boolean; +var + BassDeviceID: DWORD; + DeviceIndex: integer; + Device: TBassOutputDevice; + DeviceInfo: BASS_DEVICEINFO; +begin + Result := true; + + ClearOutputDeviceList(); + + // skip "no sound"-device (ID = 0) + BassDeviceID := 1; + + while (true) do + begin + // check for device + if (not BASS_GetDeviceInfo(BassDeviceID, DeviceInfo)) then + Break; + + // set device info + Device := TBassOutputDevice.Create(); + Device.Name := DeviceInfo.name; + Device.BassDeviceID := BassDeviceID; + + // add device to list + SetLength(OutputDeviceList, BassDeviceID); + OutputDeviceList[BassDeviceID-1] := Device; + + Inc(BassDeviceID); + end; +end; + +function TAudioPlayback_Bass.InitializePlayback(): boolean; +begin + result := false; + + BassCore := TAudioCore_Bass.GetInstance(); + + EnumDevices(); + + //Log.BenchmarkStart(4); + //Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + // TODO: use BASS_DEVICE_LATENCY to determine the latency + if not BASS_Init(-1, 44100, 0, 0, nil) then + begin + Log.LogError('Could not initialize BASS', 'TAudioPlayback_Bass.InitializePlayback'); + Exit; + end; + + //Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer + //BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); + //BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + + result := true; +end; + +function TAudioPlayback_Bass.FinalizePlayback(): boolean; +begin + Close; + BASS_Free; + inherited FinalizePlayback(); + Result := true; +end; + +function TAudioPlayback_Bass.CreatePlaybackStream(): TAudioPlaybackStream; +begin + Result := TBassPlaybackStream.Create(); +end; + +procedure TAudioPlayback_Bass.SetAppVolume(Volume: single); +begin + // set volume for this application (ranges from 0..10000 since BASS 2.4) + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Round(Volume*10000)); +end; + +function TAudioPlayback_Bass.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; +var + VoiceStream: TAudioVoiceStream; +begin + Result := nil; + + VoiceStream := TBassVoiceStream.Create(); + if (not VoiceStream.Open(ChannelMap, FormatInfo)) then + begin + VoiceStream.Free; + Exit; + end; + + Result := VoiceStream; +end; + +function TAudioPlayback_Bass.GetLatency(): double; +begin + Result := 0; +end; + + +initialization + MediaManager.Add(TAudioPlayback_Bass.Create); + +end. diff --git a/src/classes0/UAudioPlayback_Portaudio.pas b/src/classes0/UAudioPlayback_Portaudio.pas new file mode 100644 index 00000000..c3717ba6 --- /dev/null +++ b/src/classes0/UAudioPlayback_Portaudio.pas @@ -0,0 +1,361 @@ +unit UAudioPlayback_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + UMusic; + +implementation + +uses + portaudio, + UAudioCore_Portaudio, + UAudioPlayback_SoftMixer, + ULog, + UIni, + UMain; + +type + TAudioPlayback_Portaudio = class(TAudioPlayback_SoftMixer) + private + paStream: PPaStream; + AudioCore: TAudioCore_Portaudio; + Latency: double; + function OpenDevice(deviceIndex: TPaDeviceIndex): boolean; + function EnumDevices(): boolean; + protected + function InitializeAudioPlaybackEngine(): boolean; override; + function StartAudioPlaybackEngine(): boolean; override; + procedure StopAudioPlaybackEngine(); override; + function FinalizeAudioPlaybackEngine(): boolean; override; + function GetLatency(): double; override; + public + function GetName: String; override; + end; + + TPortaudioOutputDevice = class(TAudioOutputDevice) + private + PaDeviceIndex: TPaDeviceIndex; + end; + + +{ TAudioPlayback_Portaudio } + +function PortaudioAudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; +var + Engine: TAudioPlayback_Portaudio; +begin + Engine := TAudioPlayback_Portaudio(userData); + // update latency + Engine.Latency := timeInfo.outputBufferDacTime - timeInfo.currentTime; + // call superclass callback + Engine.AudioCallback(output, frameCount * Engine.FormatInfo.FrameSize); + Result := paContinue; +end; + +function TAudioPlayback_Portaudio.GetName: String; +begin + Result := 'Portaudio_Playback'; +end; + +function TAudioPlayback_Portaudio.OpenDevice(deviceIndex: TPaDeviceIndex): boolean; +var + DeviceInfo : PPaDeviceInfo; + SampleRate : double; + OutParams : TPaStreamParameters; + StreamInfo : PPaStreamInfo; + err : TPaError; +begin + Result := false; + + DeviceInfo := Pa_GetDeviceInfo(deviceIndex); + + Log.LogInfo('Audio-Output Device: ' + DeviceInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice'); + + SampleRate := DeviceInfo^.defaultSampleRate; + + with OutParams do + begin + device := deviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := DeviceInfo^.defaultLowOutputLatency; + hostApiSpecificStreamInfo := nil; + end; + + // check souncard and adjust sample-rate + if not AudioCore.TestDevice(nil, @OutParams, SampleRate) then + begin + Log.LogStatus('TestDevice failed!', 'TAudioPlayback_Portaudio.OpenDevice'); + Exit; + end; + + // open output stream + err := Pa_OpenStream(paStream, nil, @OutParams, SampleRate, + paFramesPerBufferUnspecified, + paNoFlag, @PortaudioAudioCallback, Self); + if(err <> paNoError) then + begin + Log.LogStatus(Pa_GetErrorText(err), 'TAudioPlayback_Portaudio.OpenDevice'); + paStream := nil; + Exit; + end; + + // get estimated latency (will be updated with real latency in the callback) + StreamInfo := Pa_GetStreamInfo(paStream); + if (StreamInfo <> nil) then + Latency := StreamInfo^.outputLatency + else + Latency := 0; + + FormatInfo := TAudioFormatInfo.Create( + OutParams.channelCount, + SampleRate, + asfS16 // FIXME: is paInt16 system-dependant or -independant? + ); + + Result := true; +end; + +function TAudioPlayback_Portaudio.EnumDevices(): boolean; +var + i: integer; + paApiIndex: TPaHostApiIndex; + paApiInfo: PPaHostApiInfo; + deviceName: string; + deviceIndex: TPaDeviceIndex; + deviceInfo: PPaDeviceInfo; + channelCnt: integer; + SC: integer; // soundcard + err: TPaError; + errMsg: string; + paDevice: TPortaudioOutputDevice; + outputParams: TPaStreamParameters; + stream: PPaStream; + streamInfo: PPaStreamInfo; + sampleRate: double; + latency: TPaTime; + cbPolls: integer; + cbWorks: boolean; +begin + Result := false; + +(* + // choose the best available Audio-API + paApiIndex := AudioCore.GetPreferredApiIndex(); + if(paApiIndex = -1) then + begin + Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.EnumDevices'); + Exit; + end; + + paApiInfo := Pa_GetHostApiInfo(paApiIndex); + + SC := 0; + + // init array-size to max. output-devices count + SetLength(OutputDeviceList, paApiInfo^.deviceCount); + for i:= 0 to High(OutputDeviceList) do + begin + // convert API-specific device-index to global index + deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i); + deviceInfo := Pa_GetDeviceInfo(deviceIndex); + + channelCnt := deviceInfo^.maxOutputChannels; + + // current device is no output device -> skip + if (channelCnt <= 0) then + continue; + + // portaudio returns a channel-count of 128 for some devices + // (e.g. the "default"-device), so we have to detect those + // fantasy channel counts. + if (channelCnt > 8) then + channelCnt := 2; + + paDevice := TPortaudioOutputDevice.Create(); + OutputDeviceList[SC] := paDevice; + + // retrieve device-name + deviceName := deviceInfo^.name; + paDevice.Name := deviceName; + paDevice.PaDeviceIndex := deviceIndex; + + if (deviceInfo^.defaultSampleRate > 0) then + sampleRate := deviceInfo^.defaultSampleRate + else + sampleRate := 44100; + + // on vista and xp the defaultLowInputLatency may be set to 0 but it works. + // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?) + latency := deviceInfo^.defaultLowInputLatency; + + // setup desired output parameters + // TODO: retry with input-latency set to 20ms (defaultLowOutputLatency might + // not be set correctly in OSS) + with outputParams do + begin + device := deviceIndex; + channelCount := channelCnt; + sampleFormat := paInt16; + suggestedLatency := latency; + hostApiSpecificStreamInfo := nil; + end; + + // check if mic-callback works (might not be called on some devices) + if (not TAudioCore_Portaudio.TestDevice(nil, @outputParams, sampleRate)) then + begin + // ignore device if callback did not work + Log.LogError('Device "'+paDevice.Name+'" does not respond', + 'TAudioPlayback_Portaudio.InitializeRecord'); + paDevice.Free(); + continue; + end; + + // open device for further info + err := Pa_OpenStream(stream, nil, @outputParams, sampleRate, + paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil); + if(err <> paNoError) then + begin + // unable to open device -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')', + 'TAudioPlayback_Portaudio.InitializeRecord'); + paDevice.Free(); + continue; + end; + + // adjust sample-rate (might be changed by portaudio) + streamInfo := Pa_GetStreamInfo(stream); + if (streamInfo <> nil) then + begin + if (sampleRate <> streamInfo^.sampleRate) then + begin + Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) + + ' to ' + FloatToStr(streamInfo^.sampleRate), + 'TAudioInput_Portaudio.InitializeRecord'); + sampleRate := streamInfo^.sampleRate; + end; + end; + + // create audio-format info and resize capture-buffer array + paDevice.AudioFormat := TAudioFormatInfo.Create( + channelCnt, + sampleRate, + asfS16 + ); + SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels); + + Log.LogStatus('OutputDevice "'+paDevice.Name+'"@' + + IntToStr(paDevice.AudioFormat.Channels)+'x'+ + FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+ + FloatTostr(outputParams.suggestedLatency)+'sec)' , + 'TAudioInput_Portaudio.InitializeRecord'); + + // close test-stream + Pa_CloseStream(stream); + + Inc(SC); + end; + + // adjust size to actual input-device count + SetLength(OutputDeviceList, SC); + + Log.LogStatus('#Output-Devices: ' + inttostr(SC), 'Portaudio'); +*) + + Result := true; +end; + +function TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine(): boolean; +var + paApiIndex : TPaHostApiIndex; + paApiInfo : PPaHostApiInfo; + paOutDevice : TPaDeviceIndex; + err: TPaError; +begin + Result := false; + + AudioCore := TAudioCore_Portaudio.GetInstance(); + + // initialize portaudio + err := Pa_Initialize(); + if(err <> paNoError) then + begin + Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord'); + Exit; + end; + + paApiIndex := AudioCore.GetPreferredApiIndex(); + if(paApiIndex = -1) then + begin + Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine'); + Exit; + end; + + EnumDevices(); + + paApiInfo := Pa_GetHostApiInfo(paApiIndex); + Log.LogInfo('Audio-Output API-Type: ' + paApiInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice'); + + paOutDevice := paApiInfo^.defaultOutputDevice; + if (not OpenDevice(paOutDevice)) then + begin + Exit; + end; + + Result := true; +end; + +function TAudioPlayback_Portaudio.StartAudioPlaybackEngine(): boolean; +var + err: TPaError; +begin + Result := false; + + if (paStream = nil) then + Exit; + + err := Pa_StartStream(paStream); + if(err <> paNoError) then + begin + Log.LogStatus('Pa_StartStream: '+Pa_GetErrorText(err), 'UAudioPlayback_Portaudio'); + Exit; + end; + + Result := true; +end; + +procedure TAudioPlayback_Portaudio.StopAudioPlaybackEngine(); +begin + if (paStream <> nil) then + Pa_StopStream(paStream); +end; + +function TAudioPlayback_Portaudio.FinalizeAudioPlaybackEngine(): boolean; +begin + Pa_Terminate(); + Result := true; +end; + +function TAudioPlayback_Portaudio.GetLatency(): double; +begin + Result := Latency; +end; + + +initialization + MediaManager.Add(TAudioPlayback_Portaudio.Create); + +end. diff --git a/src/classes0/UAudioPlayback_SDL.pas b/src/classes0/UAudioPlayback_SDL.pas new file mode 100644 index 00000000..deef91e8 --- /dev/null +++ b/src/classes0/UAudioPlayback_SDL.pas @@ -0,0 +1,160 @@ +unit UAudioPlayback_SDL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + UMusic; + +implementation + +uses + sdl, + UAudioPlayback_SoftMixer, + ULog, + UIni, + UMain; + +type + TAudioPlayback_SDL = class(TAudioPlayback_SoftMixer) + private + Latency: double; + function EnumDevices(): boolean; + protected + function InitializeAudioPlaybackEngine(): boolean; override; + function StartAudioPlaybackEngine(): boolean; override; + procedure StopAudioPlaybackEngine(); override; + function FinalizeAudioPlaybackEngine(): boolean; override; + function GetLatency(): double; override; + public + function GetName: String; override; + procedure MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); override; + end; + + +{ TAudioPlayback_SDL } + +procedure SDLAudioCallback(userdata: Pointer; stream: PChar; len: integer); cdecl; +var + Engine: TAudioPlayback_SDL; +begin + Engine := TAudioPlayback_SDL(userdata); + Engine.AudioCallback(stream, len); +end; + +function TAudioPlayback_SDL.GetName: String; +begin + Result := 'SDL_Playback'; +end; + +function TAudioPlayback_SDL.EnumDevices(): boolean; +begin + // Note: SDL does not provide Device-Selection capabilities (will be introduced in 1.3) + ClearOutputDeviceList(); + SetLength(OutputDeviceList, 1); + OutputDeviceList[0] := TAudioOutputDevice.Create(); + OutputDeviceList[0].Name := '[SDL Default-Device]'; + Result := true; +end; + +function TAudioPlayback_SDL.InitializeAudioPlaybackEngine(): boolean; +var + DesiredAudioSpec, ObtainedAudioSpec: TSDL_AudioSpec; + SampleBufferSize: integer; +begin + Result := false; + + EnumDevices(); + + if (SDL_InitSubSystem(SDL_INIT_AUDIO) = -1) then + begin + Log.LogError('SDL_InitSubSystem failed!', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); + Exit; + end; + + SampleBufferSize := IAudioOutputBufferSizeVals[Ini.AudioOutputBufferSizeIndex]; + if (SampleBufferSize <= 0) then + begin + // Automatic setting default + // FIXME: too much glitches with 1024 samples + SampleBufferSize := 2048; //1024; + end; + + FillChar(DesiredAudioSpec, SizeOf(DesiredAudioSpec), 0); + with DesiredAudioSpec do + begin + freq := 44100; + format := AUDIO_S16SYS; + channels := 2; + samples := SampleBufferSize; + callback := @SDLAudioCallback; + userdata := Self; + end; + + // Note: always use the "obtained" parameter, otherwise SDL might try to convert + // the samples itself if the desired format is not available. This might lead + // to problems if for example ALSA does not support 44100Hz and proposes 48000Hz. + // Without the obtained parameter, SDL would try to convert 44.1kHz to 48kHz with + // its crappy (non working) converter resulting in a wrong (too high) pitch. + if(SDL_OpenAudio(@DesiredAudioSpec, @ObtainedAudioSpec) = -1) then + begin + Log.LogStatus('SDL_OpenAudio: ' + SDL_GetError(), 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); + Exit; + end; + + FormatInfo := TAudioFormatInfo.Create( + ObtainedAudioSpec.channels, + ObtainedAudioSpec.freq, + asfS16 + ); + + // Note: SDL does not provide info of the internal buffer state. + // So we use the average buffer-size. + Latency := (ObtainedAudioSpec.samples/2) / FormatInfo.SampleRate; + + Log.LogStatus('Opened audio device', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); + + Result := true; +end; + +function TAudioPlayback_SDL.StartAudioPlaybackEngine(): boolean; +begin + SDL_PauseAudio(0); + Result := true; +end; + +procedure TAudioPlayback_SDL.StopAudioPlaybackEngine(); +begin + SDL_PauseAudio(1); +end; + +function TAudioPlayback_SDL.FinalizeAudioPlaybackEngine(): boolean; +begin + SDL_CloseAudio(); + SDL_QuitSubSystem(SDL_INIT_AUDIO); + Result := true; +end; + +function TAudioPlayback_SDL.GetLatency(): double; +begin + Result := Latency; +end; + +procedure TAudioPlayback_SDL.MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); +begin + SDL_MixAudio(PUInt8(dst), PUInt8(src), size, Round(volume * SDL_MIX_MAXVOLUME)); +end; + + +initialization + MediaManager.add(TAudioPlayback_SDL.Create); + +end. diff --git a/src/classes0/UAudioPlayback_SoftMixer.pas b/src/classes0/UAudioPlayback_SoftMixer.pas new file mode 100644 index 00000000..6ddae980 --- /dev/null +++ b/src/classes0/UAudioPlayback_SoftMixer.pas @@ -0,0 +1,1132 @@ +unit UAudioPlayback_SoftMixer; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + sdl, + URingBuffer, + UMusic, + UAudioPlaybackBase; + +type + TAudioPlayback_SoftMixer = class; + + TGenericPlaybackStream = class(TAudioPlaybackStream) + private + Engine: TAudioPlayback_SoftMixer; + + SampleBuffer: PChar; + SampleBufferSize: integer; + SampleBufferCount: integer; // number of available bytes in SampleBuffer + SampleBufferPos: cardinal; + + SourceBuffer: PChar; + SourceBufferSize: integer; + SourceBufferCount: integer; // number of available bytes in SourceBuffer + + Converter: TAudioConverter; + Status: TStreamStatus; + InternalLock: PSDL_Mutex; + SoundEffects: TList; + fVolume: single; + + FadeInStartTime, FadeInTime: cardinal; + FadeInStartVolume, FadeInTargetVolume: single; + + NeedsRewind: boolean; + + procedure Reset(); + + procedure ApplySoundEffects(Buffer: PChar; BufferSize: integer); + function InitFormatConversion(): boolean; + procedure FlushBuffers(); + + procedure LockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF} + procedure UnlockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF} + protected + function GetLatency(): double; override; + function GetStatus(): TStreamStatus; override; + function GetVolume(): single; override; + procedure SetVolume(Volume: single); override; + function GetLength(): real; override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function GetPosition: real; override; + procedure SetPosition(Time: real); override; + public + constructor Create(Engine: TAudioPlayback_SoftMixer); + destructor Destroy(); override; + + function Open(SourceStream: TAudioSourceStream): boolean; override; + procedure Close(); override; + + procedure Play(); override; + procedure Pause(); override; + procedure Stop(); override; + procedure FadeIn(Time: real; TargetVolume: single); override; + + function GetAudioFormatInfo(): TAudioFormatInfo; override; + + function ReadData(Buffer: PChar; BufferSize: integer): integer; + + function GetPCMData(var Data: TPCMData): Cardinal; override; + procedure GetFFTData(var Data: TFFTData); override; + + procedure AddSoundEffect(Effect: TSoundEffect); override; + procedure RemoveSoundEffect(Effect: TSoundEffect); override; + end; + + TAudioMixerStream = class + private + Engine: TAudioPlayback_SoftMixer; + + ActiveStreams: TList; + MixerBuffer: PChar; + InternalLock: PSDL_Mutex; + + AppVolume: single; + + procedure Lock(); {$IFDEF HasInline}inline;{$ENDIF} + procedure Unlock(); {$IFDEF HasInline}inline;{$ENDIF} + + function GetVolume(): single; + procedure SetVolume(Volume: single); + public + constructor Create(Engine: TAudioPlayback_SoftMixer); + destructor Destroy(); override; + procedure AddStream(Stream: TAudioPlaybackStream); + procedure RemoveStream(Stream: TAudioPlaybackStream); + function ReadData(Buffer: PChar; BufferSize: integer): integer; + + property Volume: single read GetVolume write SetVolume; + end; + + TAudioPlayback_SoftMixer = class(TAudioPlaybackBase) + private + MixerStream: TAudioMixerStream; + protected + FormatInfo: TAudioFormatInfo; + + function InitializeAudioPlaybackEngine(): boolean; virtual; abstract; + function StartAudioPlaybackEngine(): boolean; virtual; abstract; + procedure StopAudioPlaybackEngine(); virtual; abstract; + function FinalizeAudioPlaybackEngine(): boolean; virtual; abstract; + procedure AudioCallback(Buffer: PChar; Size: integer); {$IFDEF HasInline}inline;{$ENDIF} + + function CreatePlaybackStream(): TAudioPlaybackStream; override; + public + function GetName: String; override; abstract; + function InitializePlayback(): boolean; override; + function FinalizePlayback: boolean; override; + + procedure SetAppVolume(Volume: single); override; + + function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override; + + function GetMixer(): TAudioMixerStream; {$IFDEF HasInline}inline;{$ENDIF} + function GetAudioFormatInfo(): TAudioFormatInfo; + + procedure MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); virtual; + end; + +type + TGenericVoiceStream = class(TAudioVoiceStream) + private + VoiceBuffer: TRingBuffer; + BufferLock: PSDL_Mutex; + PlaybackStream: TGenericPlaybackStream; + Engine: TAudioPlayback_SoftMixer; + public + constructor Create(Engine: TAudioPlayback_SoftMixer); + + function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override; + procedure Close(); override; + procedure WriteData(Buffer: PChar; BufferSize: integer); override; + function ReadData(Buffer: PChar; BufferSize: integer): integer; override; + function IsEOF(): boolean; override; + function IsError(): boolean; override; + end; + +const + SOURCE_BUFFER_FRAMES = 4096; + +const + MAX_VOICE_DELAY = 0.500; // 20ms + +implementation + +uses + Math, + ULog, + UIni, + UFFT, + UAudioConverter, + UMain; + +{ TAudioMixerStream } + +constructor TAudioMixerStream.Create(Engine: TAudioPlayback_SoftMixer); +begin + inherited Create(); + + Self.Engine := Engine; + + ActiveStreams := TList.Create; + InternalLock := SDL_CreateMutex(); + AppVolume := 1.0; +end; + +destructor TAudioMixerStream.Destroy(); +begin + if assigned(MixerBuffer) then + Freemem(MixerBuffer); + ActiveStreams.Free; + SDL_DestroyMutex(InternalLock); + inherited; +end; + +procedure TAudioMixerStream.Lock(); +begin + SDL_mutexP(InternalLock); +end; + +procedure TAudioMixerStream.Unlock(); +begin + SDL_mutexV(InternalLock); +end; + +function TAudioMixerStream.GetVolume(): single; +begin + Lock(); + Result := AppVolume; + Unlock(); +end; + +procedure TAudioMixerStream.SetVolume(Volume: single); +begin + Lock(); + AppVolume := Volume; + Unlock(); +end; + +procedure TAudioMixerStream.AddStream(Stream: TAudioPlaybackStream); +begin + if not assigned(Stream) then + Exit; + + Lock(); + // check if stream is already in list to avoid duplicates + if (ActiveStreams.IndexOf(Pointer(Stream)) = -1) then + ActiveStreams.Add(Pointer(Stream)); + Unlock(); +end; + +(* + * Sets the entry of stream in the ActiveStreams-List to nil + * but does not remove it from the list (Count is not changed!). + * Otherwise iterations over the elements might fail due to a + * changed Count-property. + * Call ActiveStreams.Pack() to remove the nil-pointers + * or check for nil-pointers when accessing ActiveStreams. + *) +procedure TAudioMixerStream.RemoveStream(Stream: TAudioPlaybackStream); +var + Index: integer; +begin + Lock(); + Index := activeStreams.IndexOf(Pointer(Stream)); + if (Index <> -1) then + begin + // remove entry but do not decrease count-property + ActiveStreams[Index] := nil; + end; + Unlock(); +end; + +function TAudioMixerStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +var + i: integer; + Size: integer; + Stream: TGenericPlaybackStream; + NeedsPacking: boolean; +begin + Result := BufferSize; + + // zero target-buffer (silence) + FillChar(Buffer^, BufferSize, 0); + + // resize mixer-buffer if necessary + ReallocMem(MixerBuffer, BufferSize); + if not assigned(MixerBuffer) then + Exit; + + Lock(); + + NeedsPacking := false; + + // mix streams to one stream + for i := 0 to ActiveStreams.Count-1 do + begin + if (ActiveStreams[i] = nil) then + begin + NeedsPacking := true; + continue; + end; + + Stream := TGenericPlaybackStream(ActiveStreams[i]); + // fetch data from current stream + Size := Stream.ReadData(MixerBuffer, BufferSize); + if (Size > 0) then + begin + // mix stream-data with mixer-buffer + // Note: use Self.appVolume instead of Self.Volume to prevent recursive locking + Engine.MixBuffers(Buffer, MixerBuffer, Size, AppVolume * Stream.Volume); + end; + end; + + // remove nil-pointers from list + if (NeedsPacking) then + begin + ActiveStreams.Pack(); + end; + + Unlock(); +end; + + +{ TGenericPlaybackStream } + +constructor TGenericPlaybackStream.Create(Engine: TAudioPlayback_SoftMixer); +begin + inherited Create(); + Self.Engine := Engine; + InternalLock := SDL_CreateMutex(); + SoundEffects := TList.Create; + Status := ssStopped; + Reset(); +end; + +destructor TGenericPlaybackStream.Destroy(); +begin + Close(); + SDL_DestroyMutex(InternalLock); + FreeAndNil(SoundEffects); + inherited; +end; + +procedure TGenericPlaybackStream.Reset(); +begin + SourceStream := nil; + + FreeAndNil(Converter); + + FreeMem(SampleBuffer); + SampleBuffer := nil; + SampleBufferPos := 0; + SampleBufferSize := 0; + SampleBufferCount := 0; + + FreeMem(SourceBuffer); + SourceBuffer := nil; + SourceBufferSize := 0; + SourceBufferCount := 0; + + NeedsRewind := false; + + fVolume := 0; + SoundEffects.Clear; + FadeInTime := 0; +end; + +function TGenericPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean; +begin + Result := false; + + Close(); + + if (not assigned(SourceStream)) then + Exit; + Self.SourceStream := SourceStream; + + if (not InitFormatConversion()) then + begin + // reset decode-stream so it will not be freed on destruction + Self.SourceStream := nil; + Exit; + end; + + SourceBufferSize := SOURCE_BUFFER_FRAMES * SourceStream.GetAudioFormatInfo().FrameSize; + GetMem(SourceBuffer, SourceBufferSize); + fVolume := 1.0; + + Result := true; +end; + +procedure TGenericPlaybackStream.Close(); +begin + // stop audio-callback on this stream + Stop(); + + // Note: PerformOnClose must be called before SourceStream is invalidated + PerformOnClose(); + // and free data + Reset(); +end; + +procedure TGenericPlaybackStream.LockSampleBuffer(); +begin + SDL_mutexP(InternalLock); +end; + +procedure TGenericPlaybackStream.UnlockSampleBuffer(); +begin + SDL_mutexV(InternalLock); +end; + +function TGenericPlaybackStream.InitFormatConversion(): boolean; +var + SrcFormatInfo: TAudioFormatInfo; + DstFormatInfo: TAudioFormatInfo; +begin + Result := false; + + SrcFormatInfo := SourceStream.GetAudioFormatInfo(); + DstFormatInfo := GetAudioFormatInfo(); + + // TODO: selection should not be done here, use a factory (TAudioConverterFactory) instead + {$IF Defined(UseFFmpegResample)} + Converter := TAudioConverter_FFmpeg.Create(); + {$ELSEIF Defined(UseSRCResample)} + Converter := TAudioConverter_SRC.Create(); + {$ELSE} + Converter := TAudioConverter_SDL.Create(); + {$IFEND} + + Result := Converter.Init(SrcFormatInfo, DstFormatInfo); +end; + +procedure TGenericPlaybackStream.Play(); +var + Mixer: TAudioMixerStream; +begin + // only paused streams are not flushed + if (Status = ssPaused) then + NeedsRewind := false; + + // rewind if necessary. Cases that require no rewind are: + // - stream was created and never played + // - stream was paused and is resumed now + // - stream was stopped and set to a new position already + if (NeedsRewind) then + SetPosition(0); + + // update status + Status := ssPlaying; + + NeedsRewind := true; + + // add this stream to the mixer + Mixer := Engine.GetMixer(); + if (Mixer <> nil) then + Mixer.AddStream(Self); +end; + +procedure TGenericPlaybackStream.FadeIn(Time: real; TargetVolume: single); +begin + FadeInTime := Trunc(Time * 1000); + FadeInStartTime := SDL_GetTicks(); + FadeInStartVolume := fVolume; + FadeInTargetVolume := TargetVolume; + Play(); +end; + +procedure TGenericPlaybackStream.Pause(); +var + Mixer: TAudioMixerStream; +begin + if (Status <> ssPlaying) then + Exit; + + Status := ssPaused; + + Mixer := Engine.GetMixer(); + if (Mixer <> nil) then + Mixer.RemoveStream(Self); +end; + +procedure TGenericPlaybackStream.Stop(); +var + Mixer: TAudioMixerStream; +begin + if (Status = ssStopped) then + Exit; + + Status := ssStopped; + + Mixer := Engine.GetMixer(); + if (Mixer <> nil) then + Mixer.RemoveStream(Self); +end; + +function TGenericPlaybackStream.GetLoop(): boolean; +begin + if assigned(SourceStream) then + Result := SourceStream.Loop + else + Result := false; +end; + +procedure TGenericPlaybackStream.SetLoop(Enabled: boolean); +begin + if assigned(SourceStream) then + SourceStream.Loop := Enabled; +end; + +function TGenericPlaybackStream.GetLength(): real; +begin + if assigned(SourceStream) then + Result := SourceStream.Length + else + Result := -1; +end; + +function TGenericPlaybackStream.GetLatency(): double; +begin + Result := Engine.GetLatency(); +end; + +function TGenericPlaybackStream.GetStatus(): TStreamStatus; +begin + Result := Status; +end; + +function TGenericPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + Result := Engine.GetAudioFormatInfo(); +end; + +procedure TGenericPlaybackStream.FlushBuffers(); +begin + SampleBufferCount := 0; + SampleBufferPos := 0; + SourceBufferCount := 0; +end; + +procedure TGenericPlaybackStream.ApplySoundEffects(Buffer: PChar; BufferSize: integer); +var + i: integer; +begin + for i := 0 to SoundEffects.Count-1 do + begin + if (SoundEffects[i] <> nil) then + begin + TSoundEffect(SoundEffects[i]).Callback(Buffer, BufferSize); + end; + end; +end; + +function TGenericPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +var + ConversionInputCount: integer; + ConversionOutputSize: integer; // max. number of converted data (= buffer size) + ConversionOutputCount: integer; // actual number of converted data + SourceSize: integer; + RequestedSourceSize: integer; + NeededSampleBufferSize: integer; + BytesNeeded, BytesAvail: integer; + SourceFormatInfo, OutputFormatInfo: TAudioFormatInfo; + SourceFrameSize, OutputFrameSize: integer; + SkipOutputCount: integer; // number of output-data bytes to skip + SkipSourceCount: integer; // number of source-data bytes to skip + FillCount: integer; // number of bytes to fill with padding data + CopyCount: integer; + PadFrame: PChar; + i: integer; +begin + Result := -1; + + // sanity check for the source-stream + if (not assigned(SourceStream)) then + Exit; + + SkipOutputCount := 0; + SkipSourceCount := 0; + FillCount := 0; + + SourceFormatInfo := SourceStream.GetAudioFormatInfo(); + SourceFrameSize := SourceFormatInfo.FrameSize; + OutputFormatInfo := GetAudioFormatInfo(); + OutputFrameSize := OutputFormatInfo.FrameSize; + + // synchronize (adjust buffer size) + BytesNeeded := Synchronize(BufferSize, OutputFormatInfo); + if (BytesNeeded > BufferSize) then + begin + SkipOutputCount := BytesNeeded - BufferSize; + BytesNeeded := BufferSize; + end + else if (BytesNeeded < BufferSize) then + begin + FillCount := BufferSize - BytesNeeded; + end; + + // lock access to sample-buffer + LockSampleBuffer(); + try + + // skip sample-buffer data + SampleBufferPos := SampleBufferPos + SkipOutputCount; + // size of available bytes in SampleBuffer after skipping + SampleBufferCount := SampleBufferCount - SampleBufferPos; + // update byte skip-count + SkipOutputCount := -SampleBufferCount; + + // now that we skipped all buffered data from the last pass, we have to skip + // data directly after fetching it from the source-stream. + if (SkipOutputCount > 0) then + begin + SampleBufferCount := 0; + // convert skip-count to source-format units and resize to a multiple of + // the source frame-size. + SkipSourceCount := Round((SkipOutputCount * OutputFormatInfo.GetRatio(SourceFormatInfo)) / + SourceFrameSize) * SourceFrameSize; + SkipOutputCount := 0; + end; + + // copy data to front of buffer + if ((SampleBufferCount > 0) and (SampleBufferPos > 0)) then + Move(SampleBuffer[SampleBufferPos], SampleBuffer[0], SampleBufferCount); + SampleBufferPos := 0; + + // resize buffer to a reasonable size + if (BufferSize > SampleBufferCount) then + begin + // Note: use BufferSize instead of BytesNeeded to minimize the need for resizing + SampleBufferSize := BufferSize; + ReallocMem(SampleBuffer, SampleBufferSize); + if (not assigned(SampleBuffer)) then + Exit; + end; + + // fill sample-buffer (fetch and convert one block of source data per loop) + while (SampleBufferCount < BytesNeeded) do + begin + // move remaining source data from the previous pass to front of buffer + if (SourceBufferCount > 0) then + begin + Move(SourceBuffer[SourceBufferSize-SourceBufferCount], + SourceBuffer[0], + SourceBufferCount); + end; + + SourceSize := SourceStream.ReadData( + @SourceBuffer[SourceBufferCount], SourceBufferSize-SourceBufferCount); + // break on error (-1) or if no data is available (0), e.g. while seeking + if (SourceSize <= 0) then + begin + // if we do not have data -> exit + if (SourceBufferCount = 0) then + begin + FlushBuffers(); + Exit; + end; + // if we have some data, stop retrieving data from the source stream + // and use the data we have so far + Break; + end; + + SourceBufferCount := SourceBufferCount + SourceSize; + + // end-of-file reached -> stop playback + if (SourceStream.EOF) then + begin + if (Loop) then + SourceStream.Position := 0 + else + Stop(); + end; + + if (SkipSourceCount > 0) then + begin + // skip data and update source buffer count + SourceBufferCount := SourceBufferCount - SkipSourceCount; + SkipSourceCount := -SourceBufferCount; + // continue with next pass if we skipped all data + if (SourceBufferCount <= 0) then + begin + SourceBufferCount := 0; + Continue; + end; + end; + + // calc buffer size (might be bigger than actual resampled byte count) + ConversionOutputSize := Converter.GetOutputBufferSize(SourceBufferCount); + NeededSampleBufferSize := SampleBufferCount + ConversionOutputSize; + + // resize buffer if necessary + if (SampleBufferSize < NeededSampleBufferSize) then + begin + SampleBufferSize := NeededSampleBufferSize; + ReallocMem(SampleBuffer, SampleBufferSize); + if (not assigned(SampleBuffer)) then + begin + FlushBuffers(); + Exit; + end; + end; + + // resample source data (Note: ConversionInputCount might be adjusted by Convert()) + ConversionInputCount := SourceBufferCount; + ConversionOutputCount := Converter.Convert( + SourceBuffer, @SampleBuffer[SampleBufferCount], ConversionInputCount); + if (ConversionOutputCount = -1) then + begin + FlushBuffers(); + Exit; + end; + + // adjust sample- and source-buffer count by the number of converted bytes + SampleBufferCount := SampleBufferCount + ConversionOutputCount; + SourceBufferCount := SourceBufferCount - ConversionInputCount; + end; + + // apply effects + ApplySoundEffects(SampleBuffer, SampleBufferCount); + + // copy data to result buffer + CopyCount := Min(BytesNeeded, SampleBufferCount); + Move(SampleBuffer[0], Buffer[BufferSize - BytesNeeded], CopyCount); + Dec(BytesNeeded, CopyCount); + SampleBufferPos := CopyCount; + + // release buffer lock + finally + UnlockSampleBuffer(); + end; + + // pad the buffer with the last frame if we are to fast + if (FillCount > 0) then + begin + if (CopyCount >= OutputFrameSize) then + PadFrame := @Buffer[CopyCount-OutputFrameSize] + else + PadFrame := nil; + FillBufferWithFrame(@Buffer[CopyCount], FillCount, + PadFrame, OutputFrameSize); + end; + + // BytesNeeded now contains the number of remaining bytes we were not able to fetch + Result := BufferSize - BytesNeeded; +end; + +function TGenericPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal; +var + ByteCount: integer; +begin + Result := 0; + + // just SInt16 stereo support for now + if ((Engine.GetAudioFormatInfo().Format <> asfS16) or + (Engine.GetAudioFormatInfo().Channels <> 2)) then + begin + Exit; + end; + + // zero memory + FillChar(Data, SizeOf(Data), 0); + + // TODO: At the moment just the first samples of the SampleBuffer + // are returned, even if there is newer data in the upper samples. + + LockSampleBuffer(); + ByteCount := Min(SizeOf(Data), SampleBufferCount); + if (ByteCount > 0) then + begin + Move(SampleBuffer[0], Data, ByteCount); + end; + UnlockSampleBuffer(); + + Result := ByteCount div SizeOf(TPCMStereoSample); +end; + +procedure TGenericPlaybackStream.GetFFTData(var Data: TFFTData); +var + i: integer; + Frames: integer; + DataIn: PSingleArray; + AudioFormat: TAudioFormatInfo; +begin + // only works with SInt16 and Float values at the moment + AudioFormat := GetAudioFormatInfo(); + + DataIn := AllocMem(FFTSize * SizeOf(Single)); + if (DataIn = nil) then + Exit; + + LockSampleBuffer(); + // TODO: We just use the first Frames frames, the others are ignored. + Frames := Min(FFTSize, SampleBufferCount div AudioFormat.FrameSize); + // use only first channel and convert data to float-values + case AudioFormat.Format of + asfS16: + begin + for i := 0 to Frames-1 do + DataIn[i] := PSmallInt(@SampleBuffer[i*AudioFormat.FrameSize])^ / -Low(SmallInt); + end; + asfFloat: + begin + for i := 0 to Frames-1 do + DataIn[i] := PSingle(@SampleBuffer[i*AudioFormat.FrameSize])^; + end; + end; + UnlockSampleBuffer(); + + WindowFunc(fwfHanning, FFTSize, DataIn); + PowerSpectrum(FFTSize, DataIn, @Data); + FreeMem(DataIn); + + // resize data to a 0..1 range + for i := 0 to High(TFFTData) do + begin + Data[i] := Sqrt(Data[i]) / 100; + end; +end; + +procedure TGenericPlaybackStream.AddSoundEffect(Effect: TSoundEffect); +begin + if (not assigned(Effect)) then + Exit; + + LockSampleBuffer(); + // check if effect is already in list to avoid duplicates + if (SoundEffects.IndexOf(Pointer(Effect)) = -1) then + SoundEffects.Add(Pointer(Effect)); + UnlockSampleBuffer(); +end; + +procedure TGenericPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect); +begin + LockSampleBuffer(); + SoundEffects.Remove(Effect); + UnlockSampleBuffer(); +end; + +function TGenericPlaybackStream.GetPosition: real; +var + BufferedTime: double; +begin + if assigned(SourceStream) then + begin + LockSampleBuffer(); + + // calc the time of source data that is buffered (in the SampleBuffer and SourceBuffer) + // but not yet outputed + BufferedTime := (SampleBufferCount - SampleBufferPos) / Engine.FormatInfo.BytesPerSec + + SourceBufferCount / SourceStream.GetAudioFormatInfo().BytesPerSec; + // and subtract it from the source position + Result := SourceStream.Position - BufferedTime; + + UnlockSampleBuffer(); + end + else + begin + Result := -1; + end; +end; + +procedure TGenericPlaybackStream.SetPosition(Time: real); +begin + if assigned(SourceStream) then + begin + LockSampleBuffer(); + + SourceStream.Position := Time; + if (Status = ssStopped) then + NeedsRewind := false; + // do not use outdated data + FlushBuffers(); + + AvgSyncDiff := -1; + + UnlockSampleBuffer(); + end; +end; + +function TGenericPlaybackStream.GetVolume(): single; +var + FadeAmount: Single; +begin + LockSampleBuffer(); + // adjust volume if fading is enabled + if (FadeInTime > 0) then + begin + FadeAmount := (SDL_GetTicks() - FadeInStartTime) / FadeInTime; + // check if fade-target is reached + if (FadeAmount >= 1) then + begin + // target reached -> stop fading + FadeInTime := 0; + fVolume := FadeInTargetVolume; + end + else + begin + // fading in progress + fVolume := FadeAmount*FadeInTargetVolume + (1-FadeAmount)*FadeInStartVolume; + end; + end; + // return current volume + Result := fVolume; + UnlockSampleBuffer(); +end; + +procedure TGenericPlaybackStream.SetVolume(Volume: single); +begin + LockSampleBuffer(); + // stop fading + FadeInTime := 0; + // clamp volume + if (Volume > 1.0) then + fVolume := 1.0 + else if (Volume < 0) then + fVolume := 0 + else + fVolume := Volume; + UnlockSampleBuffer(); +end; + + +{ TGenericVoiceStream } + +constructor TGenericVoiceStream.Create(Engine: TAudioPlayback_SoftMixer); +begin + inherited Create(); + Self.Engine := Engine; +end; + +function TGenericVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; +var + BufferSize: integer; +begin + Result := false; + + Close(); + + if (not inherited Open(ChannelMap, FormatInfo)) then + Exit; + + // Note: + // - use Self.FormatInfo instead of FormatInfo as the latter one might have a + // channel size of 2. + // - the buffer-size must be a multiple of the FrameSize + BufferSize := (Ceil(MAX_VOICE_DELAY * Self.FormatInfo.BytesPerSec) div Self.FormatInfo.FrameSize) * + Self.FormatInfo.FrameSize; + VoiceBuffer := TRingBuffer.Create(BufferSize); + + BufferLock := SDL_CreateMutex(); + + + // create a matching playback stream for the voice-stream + PlaybackStream := TGenericPlaybackStream.Create(Engine); + // link voice- and playback-stream + if (not PlaybackStream.Open(Self)) then + begin + PlaybackStream.Free; + Exit; + end; + + // start voice passthrough + PlaybackStream.Play(); + + Result := true; +end; + +procedure TGenericVoiceStream.Close(); +begin + // stop and free the playback stream + FreeAndNil(PlaybackStream); + + // free data + FreeAndNil(VoiceBuffer); + if (BufferLock <> nil) then + SDL_DestroyMutex(BufferLock); + + inherited Close(); +end; + +procedure TGenericVoiceStream.WriteData(Buffer: PChar; BufferSize: integer); +begin + // lock access to buffer + SDL_mutexP(BufferLock); + try + if (VoiceBuffer = nil) then + Exit; + VoiceBuffer.Write(Buffer, BufferSize); + finally + SDL_mutexV(BufferLock); + end; +end; + +function TGenericVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +begin + Result := -1; + + // lock access to buffer + SDL_mutexP(BufferLock); + try + if (VoiceBuffer = nil) then + Exit; + Result := VoiceBuffer.Read(Buffer, BufferSize); + finally + SDL_mutexV(BufferLock); + end; +end; + +function TGenericVoiceStream.IsEOF(): boolean; +begin + SDL_mutexP(BufferLock); + Result := (VoiceBuffer = nil); + SDL_mutexV(BufferLock); +end; + +function TGenericVoiceStream.IsError(): boolean; +begin + Result := false; +end; + + +{ TAudioPlayback_SoftMixer } + +function TAudioPlayback_SoftMixer.InitializePlayback: boolean; +begin + Result := false; + + //Log.LogStatus('InitializePlayback', 'UAudioPlayback_SoftMixer'); + + if(not InitializeAudioPlaybackEngine()) then + Exit; + + MixerStream := TAudioMixerStream.Create(Self); + + if(not StartAudioPlaybackEngine()) then + Exit; + + Result := true; +end; + +function TAudioPlayback_SoftMixer.FinalizePlayback: boolean; +begin + Close; + StopAudioPlaybackEngine(); + + FreeAndNil(MixerStream); + FreeAndNil(FormatInfo); + + FinalizeAudioPlaybackEngine(); + inherited FinalizePlayback; + Result := true; +end; + +procedure TAudioPlayback_SoftMixer.AudioCallback(Buffer: PChar; Size: integer); +begin + MixerStream.ReadData(Buffer, Size); +end; + +function TAudioPlayback_SoftMixer.GetMixer(): TAudioMixerStream; +begin + Result := MixerStream; +end; + +function TAudioPlayback_SoftMixer.GetAudioFormatInfo(): TAudioFormatInfo; +begin + Result := FormatInfo; +end; + +function TAudioPlayback_SoftMixer.CreatePlaybackStream(): TAudioPlaybackStream; +begin + Result := TGenericPlaybackStream.Create(Self); +end; + +function TAudioPlayback_SoftMixer.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; +var + VoiceStream: TGenericVoiceStream; +begin + Result := nil; + + // create a voice stream + VoiceStream := TGenericVoiceStream.Create(Self); + if (not VoiceStream.Open(ChannelMap, FormatInfo)) then + begin + VoiceStream.Free; + Exit; + end; + + Result := VoiceStream; +end; + +procedure TAudioPlayback_SoftMixer.SetAppVolume(Volume: single); +begin + // sets volume only for this application + MixerStream.Volume := Volume; +end; + +procedure TAudioPlayback_SoftMixer.MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); +var + SampleIndex: Cardinal; + SampleInt: Integer; + SampleFlt: Single; +begin + SampleIndex := 0; + case FormatInfo.Format of + asfS16: + begin + while (SampleIndex < Size) do + begin + // apply volume and sum with previous mixer value + SampleInt := PSmallInt(@DstBuffer[SampleIndex])^ + + Round(PSmallInt(@SrcBuffer[SampleIndex])^ * Volume); + // clip result + if (SampleInt > High(SmallInt)) then + SampleInt := High(SmallInt) + else if (SampleInt < Low(SmallInt)) then + SampleInt := Low(SmallInt); + // assign result + PSmallInt(@DstBuffer[SampleIndex])^ := SampleInt; + // increase index by one sample + Inc(SampleIndex, SizeOf(SmallInt)); + end; + end; + asfFloat: + begin + while (SampleIndex < Size) do + begin + // apply volume and sum with previous mixer value + SampleFlt := PSingle(@DstBuffer[SampleIndex])^ + + PSingle(@SrcBuffer[SampleIndex])^ * Volume; + // clip result + if (SampleFlt > 1.0) then + SampleFlt := 1.0 + else if (SampleFlt < -1.0) then + SampleFlt := -1.0; + // assign result + PSingle(@DstBuffer[SampleIndex])^ := SampleFlt; + // increase index by one sample + Inc(SampleIndex, SizeOf(Single)); + end; + end; + else + begin + Log.LogError('Incompatible format', 'TAudioMixerStream.MixAudio'); + end; + end; +end; + +end. diff --git a/src/classes0/UCatCovers.pas b/src/classes0/UCatCovers.pas new file mode 100644 index 00000000..d8f6cdb0 --- /dev/null +++ b/src/classes0/UCatCovers.pas @@ -0,0 +1,173 @@ +unit UCatCovers; +///////////////////////////////////////////////////////////////////////// +// UCatCovers by Whiteshark // +// Class for listing and managing the Category Covers // +///////////////////////////////////////////////////////////////////////// + +interface + +{$I switches.inc} + +uses UIni; + +type + TCatCovers = class + protected + cNames: array [0..high(ISorting)] of array of string; + cFiles: array [0..high(ISorting)] of array of string; + public + constructor Create; + procedure Load; //Load Cover aus Cover.ini and Cover Folder + procedure LoadPath(const CoversPath: string); + procedure Add(Sorting: integer; Name, Filename: string); //Add a Cover + function CoverExists(Sorting: integer; Name: string): boolean; //Returns True when a cover with the given Name exists + function GetCover(Sorting: integer; Name: string): string; //Returns the Filename of a Cover + end; + +var + CatCovers: TCatCovers; + +implementation + +uses + IniFiles, + SysUtils, + Classes, + // UFiles, + UMain, + ULog; + +constructor TCatCovers.Create; +begin + inherited; + Load; +end; + +procedure TCatCovers.Load; +var + I: integer; +begin + for I := 0 to CoverPaths.Count-1 do + LoadPath(CoverPaths[I]); +end; + +(** + * Load Cover from Cover.ini and Cover Folder + *) +procedure TCatCovers.LoadPath(const CoversPath: string); +var + Ini: TMemIniFile; + SR: TSearchRec; + List: TStringlist; + I, J: Integer; + Name, Filename, Temp: string; +begin + Ini := nil; + List := nil; + + try + Ini := TMemIniFile.Create(CoversPath + 'covers.ini'); + List := TStringlist.Create; + + //Add every Cover in Covers Ini for Every Sorting option + for I := 0 to High(ISorting) do + begin + Ini.ReadSection(ISorting[I], List); + + for J := 0 to List.Count - 1 do + Add(I, List.Strings[J], CoversPath + Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg')); + end; + finally + Ini.Free; + List.Free; + end; + + try + //Add Covers from Folder + if (FindFirst (CoversPath + '*.jpg', faAnyFile, SR) = 0) then + repeat + //Add Cover if it doesn't exist for every Section + Name := SR.Name; + Filename := CoversPath + Name; + Delete (Name, length(Name) - 3, 4); + + for I := 0 to high(ISorting) do + begin + Temp := Name; + if ((I = sTitle) or (I = sTitle2)) and (Pos ('Title', Temp) <> 0) then + Delete (Temp, Pos ('Title', Temp), 5) + else if (I = sArtist) or (I = sArtist2) and (Pos ('Artist', Temp) <> 0) then + Delete (Temp, Pos ('Artist', Temp), 6); + + if not CoverExists(I, Temp) then + Add (I, Temp, Filename); + end; + until FindNext (SR) <> 0; + finally + FindClose (SR); + end; +end; + + //Add a Cover +procedure TCatCovers.Add(Sorting: integer; Name, Filename: string); +begin + if FileExists (Filename) then //If Exists -> Add + begin + SetLength (CNames[Sorting], Length(CNames[Sorting]) + 1); + SetLength (CFiles[Sorting], Length(CNames[Sorting]) + 1); + + CNames[Sorting][high(cNames[Sorting])] := Uppercase(Name); + CFiles[Sorting][high(cNames[Sorting])] := FileName; + end; +end; + + //Returns True when a cover with the given Name exists +function TCatCovers.CoverExists(Sorting: integer; Name: string): boolean; +var + I: Integer; +begin + Result := False; + Name := Uppercase(Name); //Case Insensitiv + + for I := 0 to high(cNames[Sorting]) do + begin + if (cNames[Sorting][I] = Name) then //Found Name + begin + Result := true; + break; //Break For Loop + end; + end; +end; + + //Returns the Filename of a Cover +function TCatCovers.GetCover(Sorting: integer; Name: string): string; +var + I: Integer; +begin + Result := ''; + Name := Uppercase(Name); + + for I := 0 to high(cNames[Sorting]) do + begin + if cNames[Sorting][I] = Name then + begin + Result := cFiles[Sorting][I]; + Break; + end; + end; + + //No Cover + if (Result = '') then + begin + for I := 0 to CoverPaths.Count-1 do + begin + if (FileExists(CoverPaths[I] + 'NoCover.jpg')) then + begin + Result := CoverPaths[I] + 'NoCover.jpg'; + Break; + end; + end; + end; +end; + +end. diff --git a/src/classes0/UCommandLine.pas b/src/classes0/UCommandLine.pas new file mode 100644 index 00000000..3c56c606 --- /dev/null +++ b/src/classes0/UCommandLine.pas @@ -0,0 +1,339 @@ +unit UCommandLine; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +type + //----------- + // TCMDParams - Class Reads Infos from ParamStr and set some easy Interface Variables + //----------- + TCMDParams = class + private + sLanguage: String; + sResolution: String; + public + //Some Boolean Variables Set when Reading Infos + Debug: Boolean; + Benchmark: Boolean; + NoLog: Boolean; + FullScreen: Boolean; + Joypad: Boolean; + + //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} + Depth: Integer; + Screens: Integer; + + //Some Strings Set when Reading Infos {Length=0 Not Set} + SongPath: String; + ConfigFile: String; + ScoreFile: String; + + procedure showhelp(); + + //Pseudo Integer Values + Function GetLanguage: Integer; + Property Language: Integer read GetLanguage; + + Function GetResolution: Integer; + Property Resolution: Integer read GetResolution; + + //Some Procedures for Reading Infos + Constructor Create; + + Procedure ResetVariables; + Procedure ReadParamInfo; + end; + +var + Params: TCMDParams; + +const + cHelp = 'help'; + cDebug = 'debug'; + cMediaInterfaces = 'showinterfaces'; + cUseLocalPaths = 'localpaths'; + + +implementation + +uses SysUtils, + uPlatform; +// uINI -- Nasty requirement... ( removed with permission of blindy ) + + +//------------- +// Constructor - Create class, Reset Variables and Read Infos +//------------- +Constructor TCMDParams.Create; +begin + inherited; + + if FindCmdLineSwitch( cHelp ) or FindCmdLineSwitch( 'h' ) then + showhelp(); + + ResetVariables; + ReadParamInfo; +end; + +procedure TCMDParams.showhelp(); + + function s( aString : String ) : string; + begin + result := aString + StringofChar( ' ', 15 - length( aString ) ); + end; + +begin + + writeln( '' ); + writeln( '**************************************************************' ); + writeln( ' UltraStar Deluxe - Command line switches ' ); + writeln( '**************************************************************' ); + writeln( '' ); + writeln( ' '+s( 'Switch' ) +' : Purpose' ); + writeln( ' ----------------------------------------------------------' ); + writeln( ' '+s( cMediaInterfaces ) + #9 + ' : Show in-use media interfaces' ); + writeln( ' '+s( cUseLocalPaths ) + #9 + ' : Use relative paths' ); + writeln( ' '+s( cDebug ) + #9 + ' : Display Debugging info' ); + + + + writeln( '' ); + + platform.halt; +end; + +//------------- +// ResetVariables - Reset Class Variables +//------------- +Procedure TCMDParams.ResetVariables; +begin + Debug := False; + Benchmark := False; + NoLog := False; + FullScreen := False; + Joypad := False; + + //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} + sResolution := ''; + sLanguage := ''; + Depth := -1; + Screens := -1; + + //Some Strings Set when Reading Infos {Length=0 Not Set} + SongPath := ''; + ConfigFile := ''; + ScoreFile := ''; +end; + +//------------- +// ReadParamInfo - Read Infos from Parameters +//------------- +Procedure TCMDParams.ReadParamInfo; +var + I: Integer; + PCount: Integer; + Command: String; +begin + PCount := ParamCount; + //Log.LogError('ParamCount: ' + Inttostr(PCount)); + + + //Check all Parameters + For I := 1 to PCount do + begin + Command := Paramstr(I); + //Log.LogError('Start parsing Command: ' + Command); + //Is String Parameter ? + if (Length(Command) > 1) AND (Command[1] = '-') then + begin + //Remove - from Command + Command := Lowercase(Trim(Copy(Command, 2, Length(Command) - 1))); + //Log.LogError('Command prepared: ' + Command); + + //Check Command + + // Boolean Triggers: + if (Command = 'debug') then + Debug := True + else if (Command = 'benchmark') then + Benchmark := True + else if (Command = 'nolog') then + NoLog := True + else if (Command = 'fullscreen') then + Fullscreen := True + else if (Command = 'window') then + Fullscreen := False + else if (Command = 'joypad') then + Joypad := True + + //Integer Variables + else if (Command = 'depth') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + Command := ParamStr(I + 1); + + //Check for valid Value + If (Command = '16') then + Depth := 0 + Else If (Command = '32') then + Depth := 1; + end; + end + + else if (Command = 'screens') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + Command := ParamStr(I + 1); + + //Check for valid Value + If (Command = '1') then + Screens := 0 + Else If (Command = '2') then + Screens := 1; + end; + end + + //Pseudo Integer Values + else if (Command = 'language') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + sLanguage := Lowercase(ParamStr(I + 1)); + end; + end + + else if (Command = 'resolution') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + sResolution := Lowercase(ParamStr(I + 1)); + end; + end + + //String Values + else if (Command = 'songpath') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + SongPath := ParamStr(I + 1); + end; + end + + else if (Command = 'configfile') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + ConfigFile := ParamStr(I + 1); + + //is this a relative PAth -> then add Gamepath + if Not ((Length(ConfigFile) > 2) AND (ConfigFile[2] = ':')) then + ConfigFile := ExtractFilePath(ParamStr(0)) + Configfile; + end; + end + + else if (Command = 'scorefile') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + ScoreFile := ParamStr(I + 1); + end; + end; + + end; + + end; + +{ Log.LogError('Values: '); + + if Debug then + Log.LogError('Debug'); + + if Benchmark then + Log.LogError('Benchmark'); + + if NoLog then + Log.LogError('NoLog'); + + if Fullscreen then + Log.LogError('FullScreen'); + + if JoyStick then + Log.LogError('Joystick'); + + + Log.LogError('Screens: ' + Inttostr(Screens)); + Log.LogError('Depth: ' + Inttostr(Depth)); + + Log.LogError('Resolution: ' + Inttostr(Resolution)); + Log.LogError('Resolution: ' + Inttostr(Language)); + + Log.LogError('sResolution: ' + sResolution); + Log.LogError('sLanguage: ' + sLanguage); + + Log.LogError('ConfigFile: ' + ConfigFile); + Log.LogError('SongPath: ' + SongPath); + Log.LogError('ScoreFile: ' + ScoreFile); } + +end; + +//------------- +// GetLanguage - Get Language ID from saved String Information +//------------- +Function TCMDParams.GetLanguage: Integer; +var + I: integer; +begin + Result := -1; +{* JB - 12sep07 to remove uINI dependency + + //Search for Language + For I := 0 to high(ILanguage) do + if (LowerCase(ILanguage[I]) = sLanguage) then + begin + Result := I; + Break; + end; +*} +end; + +//------------- +// GetResolution - Get Resolution ID from saved String Information +//------------- +Function TCMDParams.GetResolution: Integer; +var + I: integer; +begin + Result := -1; +{* JB - 12sep07 to remove uINI dependency + + //Search for Resolution + For I := 0 to high(IResolution) do + if (LowerCase(IResolution[I]) = sResolution) then + begin + Result := I; + Break; + end; +*} +end; + +end. diff --git a/src/classes0/UCommon.pas b/src/classes0/UCommon.pas new file mode 100644 index 00000000..41e3c1f1 --- /dev/null +++ b/src/classes0/UCommon.pas @@ -0,0 +1,774 @@ +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes, + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF} + sdl, + UConfig, + ULog; + +type + TMessageType = ( mtInfo, mtError ); + +procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo ); + +procedure ConsoleWriteLn(const msg: string); + +function GetResourceStream(const aName, aType : string): TStream; +function RWopsFromStream(Stream: TStream): PSDL_RWops; + +{$IFDEF FPC} +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +{$ENDIF} + +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; +function AdaptFilePaths( const aPath : widestring ): widestring; + +procedure DisableFloatingPointExceptions(); +procedure SetDefaultNumericLocale(); +procedure RestoreNumericLocale(); + +{$IFNDEF MSWINDOWS} + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); + function MakeLong(a, b: Word): Longint; + (* + #define LOBYTE(a) (BYTE)(a) + #define HIBYTE(a) (BYTE)((a)>>8) + #define LOWORD(a) (WORD)(a) + #define HIWORD(a) (WORD)((a)>>16) + #define MAKEWORD(a,b) (WORD)(((a)&0xff)|((b)<<8)) + *) +{$ENDIF} + +function FileExistsInsensitive(var FileName: string): boolean; + +(* + * Character classes + *) + +function IsAlphaChar(ch: WideChar): boolean; +function IsNumericChar(ch: WideChar): boolean; +function IsAlphaNumericChar(ch: WideChar): boolean; +function IsPunctuationChar(ch: WideChar): boolean; +function IsControlChar(ch: WideChar): boolean; + +// A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below) +procedure MergeSort(List: TList; CompareFunc: TListSortCompare); + +function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer; +procedure FreeAlignedMem(P: Pointer); + + +implementation + +uses + Math, + {$IFDEF Delphi} + Dialogs, + {$ENDIF} + UMain; + + +// data used by the ...Locale() functions +{$IFDEF LINUX} + +var + PrevNumLocale: string; + +const + LC_NUMERIC = 1; + +function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' name 'setlocale'; + +{$ENDIF} + +// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '') +// to set the language/country specific locale (e.g. charset) for this application. +// Unfortunately, LC_NUMERIC is set by this call too. +// It defines the decimal-separator and other country-specific numeric settings. +// This parameter is used by the C string-to-float parsing functions atof() and strtod(). +// After changing LC_NUMERIC some external C-based libs (like projectM) are not +// able to parse strings correctly +// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is). +// So we reset the numeric settings to the default ('C'). +// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not +// changed by this because it doesn't use the locale-settings. +// TODO: +// - Check if this is needed in MacOSX (at least the locale is set in cwstring) +// - Find out which libs are concerned by this problem. +// If only projectM is concerned by this problem set and restore the numeric locale +// for each call to projectM instead of changing it globally. +procedure SetDefaultNumericLocale(); +begin + {$ifdef LINUX} + PrevNumLocale := setlocale(LC_NUMERIC, nil); + setlocale(LC_NUMERIC, 'C'); + {$endif} +end; + +procedure RestoreNumericLocale(); +begin + {$ifdef LINUX} + setlocale(LC_NUMERIC, PChar(PrevNumLocale)); + {$endif} +end; + +(* + * If an invalid floating point operation was performed the Floating-point unit (FPU) + * generates a Floating-point exception (FPE). Dependending on the settings in + * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself + * (we will call this as "FPE disabled" later on) or is passed to the application + * (FPE enabled). + * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is + * considered an error and an exception is thrown. Otherwise the FPU will handle + * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without + * throwing an error to the application. + * The same applies to a division by INF that either raises an exception + * (FPE enabled) or returns 0.0 (FPE disabled). + * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED + * on program startup (at least with Intel CPUs), but for some strange reasons + * they are ENABLED in pascal (both delphi and FPC) by default. + * Many libs operating with floating-point values rely heavily on the C-specific + * behaviour. So using them in delphi is a ticking time-bomb because sooner or + * later they will crash because of an FPE (this problem occurs massively + * in OpenGL-based libs like projectM). In contrast to this no error will occur + * if the lib is linked to a C-program. + * + * Further info on FPUs: + * For x86 and x86_64 CPUs we have to consider two FPU instruction sets. + * The math co-processor i387 (aka 8087 or x87) set introduced with the i386 + * and SSE (Streaming SIMD Extensions) introduced with the Pentium3. + * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR) + * to control FPEs. Either has (among others) 6bits to enable/disable several + * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision). + * Those exception-types must all be masked (=1) to get the default C behaviour. + * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE). + * Instead of using assembler code, we can use Set8087CW() provided by delphi and + * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR. + * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program + * startup but only FPC enables FPEs (especially div-by-zero) for SSE too. + * So we have to mask FPEs for x87 in Delphi and FPC and for SSE in FPC only. + * FPC and Delphi both provide a SetExceptionMask() for control of the FPE + * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE + * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask() + * is what we need and it even is plattform and CPU independent. + * + * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers) + * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL + * headers they do not work properly with FPC. I already patched them, so they + * work at least until they are updated the next time. In addition Set8086CW() + * does not suffice to disable FPEs because the SSE FPEs are not disabled by this. + * FPEs with SSE are a big problem with some libs because many linux distributions + * optimize code for SSE or Pentium3 (for example: int(INF) which convert the + * double value "infinity" to an integer might be automatically optimized by + * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case + * to make USDX portable. + * + * Summary: + * Call this function on initialization to make sure FPEs are turned off. + * It will solve a lot of errors with FPEs in external libs. + *) +procedure DisableFloatingPointExceptions(); +begin + (* + // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR(). + // Note: Leave these lines for documentation purposes just in case + // SetExceptionMask() does not work anymore (due to bugs in FPC etc.). + {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)} + Set8087CW($133F); + {$IFEND} + {$IF Defined(FPC)} + if (has_sse_support) then + SetSSECSR($1F80); + {$IFEND} + *) + + // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and + // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore). + SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, + exOverflow, exUnderflow, exPrecision]); +end; + +function StringReplaceW(text : WideString; search, rep: WideChar) : WideString; +var + iPos : integer; +// sTemp : WideString; +begin +(* + result := text; + iPos := Pos(search, result); + while (iPos > 0) do + begin + sTemp := copy(result, iPos + length(search), length(result)); + result := copy(result, 1, iPos - 1) + rep + sTEmp; + iPos := Pos(search, result); + end; +*) + result := text; + + if search = rep then + exit; + + for iPos := 1 to length(result) do + begin + if result[iPos] = search then + result[iPos] := rep; + end; +end; + +function AdaptFilePaths( const aPath : widestring ): widestring; +begin + result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); +end; + + +{$IFNDEF MSWINDOWS} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; + +function MakeLong(A, B: Word): Longint; +begin + Result := (LongInt(B) shl 16) + A; +end; + +(* +function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + + // From http://en.wikipedia.org/wiki/RDTSC + function RDTSC: Int64; register; + asm + rdtsc + end; + +begin + // Use clock_gettime(CLOCK_REALTIME, ...) here (but not from the libc unit) + lpPerformanceCount := RDTSC(); + result := true; +end; + +function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +begin + // clock_getres(CLOCK_REALTIME, ...) + lpFrequency := 0; + result := true; +end; +*) +{$ENDIF} + +// Checks if a regular files or directory with the given name exists. +// The comparison is case insensitive. +function FileExistsInsensitive(var FileName: string): boolean; +var + FilePath, LocalFileName: string; + SearchInfo: TSearchRec; +begin +{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems + // speed up standard case + if FileExists(FileName) then + begin + Result := true; + exit; + end; + + Result := false; + + FilePath := ExtractFilePath(FileName); + if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then + begin + LocalFileName := ExtractFileName(FileName); + repeat + if (AnsiSameText(LocalFileName, SearchInfo.Name)) then + begin + FileName := FilePath + SearchInfo.Name; + Result := true; + break; + end; + until (FindNext(SearchInfo) <> 0); + end; + FindClose(SearchInfo); +{$ELSE} + Result := FileExists(FileName); +{$ENDIF} +end; + + +{$IFDEF Unix} + // include resource-file info (stored in the constant array "resources") + {$I ../resource.inc} +{$ENDIF} + +function GetResourceStream(const aName, aType: string): TStream; +{$IFDEF Unix} +var + ResIndex: integer; + Filename: string; +{$ENDIF} +begin + Result := nil; + + {$IFDEF Unix} + for ResIndex := 0 to High(resources) do + begin + if (resources[ResIndex][0] = aName ) and + (resources[ResIndex][1] = aType ) then + begin + try + Filename := ResourcesPath + resources[ResIndex][2]; + Result := TFileStream.Create(Filename, fmOpenRead); + except + Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream'); + end; + exit; + end; + end; + {$ELSE} + try + Result := TResourceStream.Create(HInstance, aName , PChar(aType)); + except + Log.LogError('Invalid resource: "'+ aType + ':' + aName +'"', 'GetResourceStream'); + end; + {$ENDIF} +end; + +// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++ + function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl; + var + stream : TStream; + origin : Word; + begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamSeek on nil' ); + case whence of + 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0. + 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset. + 2 : origin := soFromEnd; + else + origin := soFromBeginning; // just in case + end; + Result := stream.Seek( offset, origin ); + end; + + function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl; + var + stream : TStream; + begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamRead on nil' ); + try + Result := stream.read( Ptr^, Size * maxnum ) div size; + except + Result := -1; + end; + end; + + function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl; + var + stream : TStream; + begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamClose on nil' ); + stream.Free; + Result := 1; + end; +// ----------------------------------------------- + +(* + * Creates an SDL_RWops handle from a TStream. + * The stream and RWops must be freed by the user after usage. + * Use SDL_FreeRW(...) to free the RWops data-struct. + *) +function RWopsFromStream(Stream: TStream): PSDL_RWops; +begin + Result := SDL_AllocRW(); + if (Result = nil) then + Exit; + + // set RW-callbacks + with Result^ do + begin + unknown := TUnknown(Stream); + seek := SDLStreamSeek; + read := SDLStreamRead; + write := nil; + close := SDLStreamClose; + type_ := 2; + end; +end; + + + +{$IFDEF FPC} +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +begin + RandomRange := Random(aMax-aMin) + aMin ; +end; +{$ENDIF} + + +{$IFDEF FPC} +var + MessageList: TStringList; + ConsoleHandler: TThreadID; + // Note: TRTLCriticalSection is defined in the units System and Libc, use System one + ConsoleCriticalSection: System.TRTLCriticalSection; + ConsoleEvent: PRTLEvent; + ConsoleQuit: boolean; +{$ENDIF} + +(* + * Write to console if one is available. + * It checks if a console is available before output so it will not + * crash on windows if none is available. + * Do not use this function directly because it is not thread-safe, + * use ConsoleWriteLn() instead. + *) +procedure _ConsoleWriteLn(const aString: string); {$IFDEF HasInline}inline;{$ENDIF} +begin + {$IFDEF MSWINDOWS} + // sanity check to avoid crashes with writeln() + if (IsConsole) then + begin + {$ENDIF} + Writeln(aString); + {$IFDEF MSWINDOWS} + end; + {$ENDIF} +end; + +{$IFDEF FPC} +{* + * The console-handlers main-function. + * TODO: create a quit-event on closing. + *} +function ConsoleHandlerFunc(param: pointer): PtrInt; +var + i: integer; + quit: boolean; +begin + quit := false; + while (not quit) do + begin + // wait for new output or quit-request + RTLeventWaitFor(ConsoleEvent); + + System.EnterCriticalSection(ConsoleCriticalSection); + // output pending messages + for i := 0 to MessageList.Count-1 do + begin + _ConsoleWriteLn(MessageList[i]); + end; + MessageList.Clear(); + + // use local quit-variable to avoid accessing + // ConsoleQuit outside of the critical section + if (ConsoleQuit) then + quit := true; + + RTLeventResetEvent(ConsoleEvent); + System.LeaveCriticalSection(ConsoleCriticalSection); + end; + result := 0; +end; +{$ENDIF} + +procedure InitConsoleOutput(); +begin + {$IFDEF FPC} + // init thread-safe output + MessageList := TStringList.Create(); + System.InitCriticalSection(ConsoleCriticalSection); + ConsoleEvent := RTLEventCreate(); + ConsoleQuit := false; + // must be a thread managed by FPC. Otherwise (e.g. SDL-thread) + // it will crash when using Writeln. + ConsoleHandler := BeginThread(@ConsoleHandlerFunc); + {$ENDIF} +end; + +procedure FinalizeConsoleOutput(); +begin + {$IFDEF FPC} + // terminate console-handler + System.EnterCriticalSection(ConsoleCriticalSection); + ConsoleQuit := true; + RTLeventSetEvent(ConsoleEvent); + System.LeaveCriticalSection(ConsoleCriticalSection); + WaitForThreadTerminate(ConsoleHandler, 0); + // free data + System.DoneCriticalsection(ConsoleCriticalSection); + RTLeventDestroy(ConsoleEvent); + MessageList.Free(); + {$ENDIF} +end; + +{* + * With FPC console output is not thread-safe. + * Using WriteLn() from external threads (like in SDL callbacks) + * will damage the heap and crash the program. + * Most probably FPC uses thread-local-data (TLS) to lock a mutex on + * the console-buffer. This does not work with external lib's threads + * because these do not have the TLS data and so it crashes while + * accessing unallocated memory. + * The solution is to create an FPC-managed thread which has the TLS data + * and use it to handle the console-output (hence it is called Console-Handler) + * It should be safe to do so, but maybe FPC requires the main-thread to access + * the console-buffer only. In this case output should be delegated to it. + * + * TODO: - check if it is safe if an FPC-managed thread different than the + * main-thread accesses the console-buffer in FPC. + * - check if Delphi's WriteLn is thread-safe. + * - check if we need to synchronize file-output too + *} +procedure ConsoleWriteLn(const msg: string); +begin +{$IFDEF CONSOLE} + {$IFDEF FPC} + // TODO: check for the main-thread and use a simple _ConsoleWriteLn() then? + //GetCurrentThreadThreadId(); + System.EnterCriticalSection(ConsoleCriticalSection); + MessageList.Add(msg); + RTLeventSetEvent(ConsoleEvent); + System.LeaveCriticalSection(ConsoleCriticalSection); + {$ELSE} + _ConsoleWriteLn(msg); + {$ENDIF} +{$ENDIF} +end; + +procedure ShowMessage(const msg: String; msgType: TMessageType); +{$IFDEF MSWINDOWS} +var Flags: Cardinal; +{$ENDIF} +begin +{$IF Defined(MSWINDOWS)} + case msgType of + mtInfo: Flags := MB_ICONINFORMATION or MB_OK; + mtError: Flags := MB_ICONERROR or MB_OK; + else Flags := MB_OK; + end; + MessageBox(0, PChar(msg), PChar(USDXVersionStr()), Flags); +{$ELSE} + ConsoleWriteln(msg); +{$IFEND} +end; + +function IsAlphaChar(ch: WideChar): boolean; +begin + // TODO: add chars > 255 when unicode-fonts work? + case ch of + 'A'..'Z', // A-Z + 'a'..'z', // a-z + #170,#181,#186, + #192..#214, + #216..#246, + #248..#255: + Result := true; + else + Result := false; + end; +end; + +function IsNumericChar(ch: WideChar): boolean; +begin + case ch of + '0'..'9': + Result := true; + else + Result := false; + end; +end; + +function IsAlphaNumericChar(ch: WideChar): boolean; +begin + Result := (IsAlphaChar(ch) or IsNumericChar(ch)); +end; + +function IsPunctuationChar(ch: WideChar): boolean; +begin + // TODO: add chars outside of Latin1 basic (0..127)? + case ch of + ' '..'/',':'..'@','['..'`','{'..'~': + Result := true; + else + Result := false; + end; +end; + +function IsControlChar(ch: WideChar): boolean; +begin + case ch of + #0..#31, + #127..#159: + Result := true; + else + Result := false; + end; +end; + +(* + * Recursive part of the MergeSort algorithm. + * OutList will be either InList or TempList and will be swapped in each + * depth-level of recursion. By doing this it we can directly merge into the + * output-list. If we only had In- and OutList parameters we had to merge into + * InList after the recursive calls and copy the data to the OutList afterwards. + *) +procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: integer; + CompareFunc: TListSortCompare); +var + LeftSize, RightSize: integer; // number of elements in left/right block + LeftEnd, RightEnd: integer; // Index after last element in left/right block + MidPos: integer; // index of first element in right block + Pos: integer; // position in output list +begin + LeftSize := BlockSize div 2; + RightSize := BlockSize - LeftSize; + MidPos := StartPos + LeftSize; + + // sort left and right halves of this block by recursive calls of this function + if (LeftSize >= 2) then + _MergeSort(InList, OutList, TempList, StartPos, LeftSize, CompareFunc) + else + TempList[StartPos] := InList[StartPos]; + if (RightSize >= 2) then + _MergeSort(InList, OutList, TempList, MidPos, RightSize, CompareFunc) + else + TempList[MidPos] := InList[MidPos]; + + // merge sorted left and right sub-lists into output-list + LeftEnd := MidPos; + RightEnd := StartPos + BlockSize; + Pos := StartPos; + while ((StartPos < LeftEnd) and (MidPos < RightEnd)) do + begin + if (CompareFunc(TempList[StartPos], TempList[MidPos]) <= 0) then + begin + OutList[Pos] := TempList[StartPos]; + Inc(StartPos); + end + else + begin + OutList[Pos] := TempList[MidPos]; + Inc(MidPos); + end; + Inc(Pos); + end; + + // copy remaining elements to output-list + while (StartPos < LeftEnd) do + begin + OutList[Pos] := TempList[StartPos]; + Inc(StartPos); + Inc(Pos); + end; + while (MidPos < RightEnd) do + begin + OutList[Pos] := TempList[MidPos]; + Inc(MidPos); + Inc(Pos); + end; +end; + +(* + * Stable alternative to the instable TList.Sort() (uses QuickSort) implementation. + * A stable sorting algorithm preserves preordered items. E.g. if sorting by + * songs by title first and artist afterwards, the songs of each artist will + * be ordered by title. In contrast to this an unstable algorithm (like QuickSort) + * may destroy an existing order, so the songs of an artist will not be ordered + * by title anymore after sorting by artist in the previous example. + * If you do not need a stable algorithm, use TList.Sort() instead. + *) +procedure MergeSort(List: TList; CompareFunc: TListSortCompare); +var + TempList: TList; +begin + TempList := TList.Create(); + TempList.Count := List.Count; + if (List.Count >= 2) then + _MergeSort(List, TempList, List, 0, List.Count, CompareFunc); + TempList.Free; +end; + + +type + // stores the unaligned pointer of data allocated by GetAlignedMem() + PMemAlignHeader = ^TMemAlignHeader; + TMemAlignHeader = Pointer; + +(** + * Use this function to assure that allocated memory is aligned on a specific + * byte boundary. + * Alignment must be a power of 2. + * + * Important: Memory allocated with GetAlignedMem() MUST be freed with + * FreeAlignedMem(), FreeMem() will cause a segmentation fault. + * + * Hint: If you do not need dynamic memory, consider to allocate memory + * statically and use the {$ALIGN x} compiler directive. Note that delphi + * supports an alignment "x" of up to 8 bytes only whereas FPC supports + * alignments on 16 and 32 byte boundaries too. + *) +{$WARNINGS OFF} +function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer; +var + OrigPtr: Pointer; +const + MIN_ALIGNMENT = 16; +begin + // Delphi and FPC (tested with 2.2.0) align memory blocks allocated with + // GetMem() at least on 8 byte boundaries. Delphi uses a minimal alignment + // of either 8 or 16 bytes depending on the size of the requested block + // (see System.GetMinimumBlockAlignment). As we do not want to change the + // boundary for the worse, we align at least on MIN_ALIGN. + if (Alignment < MIN_ALIGNMENT) then + Alignment := MIN_ALIGNMENT; + + // allocate unaligned memory + GetMem(OrigPtr, SizeOf(TMemAlignHeader) + Size + Alignment); + if (OrigPtr = nil) then + begin + Result := nil; + Exit; + end; + + // reserve space for the header + Result := Pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader)); + // align memory + Result := Pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment); + + // set header with info on old pointer for FreeMem + PMemAlignHeader(PtrUInt(Result) - SizeOf(TMemAlignHeader))^ := OrigPtr; +end; +{$WARNINGS ON} + +{$WARNINGS OFF} +procedure FreeAlignedMem(P: Pointer); +begin + if (P <> nil) then + FreeMem(PMemAlignHeader(PtrUInt(P) - SizeOf(TMemAlignHeader))^); +end; +{$WARNINGS ON} + + +initialization + InitConsoleOutput(); + +finalization + FinalizeConsoleOutput(); + +end. diff --git a/src/classes0/UConfig.pas b/src/classes0/UConfig.pas new file mode 100644 index 00000000..b77c2a5a --- /dev/null +++ b/src/classes0/UConfig.pas @@ -0,0 +1,199 @@ +unit UConfig; + +// ------------------------------------------------------------------- +// Note on version comparison (for developers only): +// ------------------------------------------------------------------- +// Delphi (in contrast to FPC) DOESN'T support MACROS. So we +// can't define a macro like VERSION_MAJOR(version) to extract +// parts of the version-number or to create version numbers for +// comparison purposes as with a MAKE_VERSION(maj, min, rev) macro. +// So we have to define constants for every part of the version here. +// +// In addition FPC (in contrast to delphi) DOES NOT support floating- +// point numbers in $IF compiler-directives (e.g. {$IF VERSION > 1.23}) +// It also DOESN'T support arithmetic operations so we aren't able to +// compare versions this way (brackets aren't supported too): +// {$IF VERSION > ((VER_MAJ*2)+(VER_MIN*23)+(VER_REL*1))} +// +// Hence we have to use fixed numbers in the directives. At least +// Pascal allows leading 0s so 0005 equals 5 (octals are +// preceded by & and not by 0 in FPC). +// We also fix the count of digits for each part of the version number +// to 3 (aaaiiirrr with aaa=major, iii=minor, rrr=release version) +// +// A check for a library with at least a version of 2.5.11 would look +// like this: +// {$IF LIB_VERSION >= 002005011} +// +// If you just need to check the major version do this: +// {$IF LIB_VERSION_MAJOR >= 23} +// +// IMPORTANT: +// Because this unit must be included in a uses-section it is +// not possible to use the version-numbers in this uses-clause. +// Example: +// interface +// uses +// versions, // include this file +// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // Error: USE_UNIT_XYZ not defined +// const +// {$IF USE_UNIT_XYZ}test = 2;{$IFEND} // OK +// uses +// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // OK +// +// Even if this file was an include-file no constants could be declared +// before the interface's uses clause. +// In FPC macros {$DEFINE VER:= 3} could be used to declare the version-numbers +// but this is incompatible to Delphi. In addition macros do not allow expand +// arithmetic expressions. Although you can define +// {$DEFINE FPC_VER:= FPC_VERSION*1000000+FPC_RELEASE*1000+FPC_PATCH} +// the following check would fail: +// {$IF FPC_VERSION_INT >= 002002000} +// would fail because FPC_VERSION_INT is interpreted as a string. +// +// PLEASE consider this if you use version numbers in $IF compiler- +// directives. Otherwise you might break portability. +// ------------------------------------------------------------------- + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$MACRO ON} // for evaluation of FPC_VERSION/RELEASE/PATCH +{$ENDIF} + +{$I switches.inc} + +uses + Sysutils; + +const + // IMPORTANT: + // If IncludeConstants is defined, the const-sections + // of the config-file will be included too. + // This switch is necessary because it is not possible to + // include the const-sections in the switches.inc. + // switches.inc is always included before the first uses- + // section but at that place no const-section is allowed. + // So we have to include the config-file in switches.inc + // with IncludeConstants undefined and in UConfig.pas with + // IncludeConstants defined (see the note above). + {$DEFINE IncludeConstants} + + // include config-file (defines + constants) + {$IF Defined(MSWindows)} + {$I ../config-win.inc} + {$ELSEIF Defined(Linux)} + {$I ../config-linux.inc} + {$ELSEIF Defined(Darwin)} + {$I ../config-darwin.inc} + {$ELSE} + {$MESSAGE Fatal 'Unknown OS'} + {$IFEND} + +{* Libraries *} + + VERSION_MAJOR = 1000000; + VERSION_MINOR = 1000; + VERSION_RELEASE = 1; + + (* + * Current version of UltraStar Deluxe + *) + USDX_VERSION_MAJOR = 1; + USDX_VERSION_MINOR = 1; + USDX_VERSION_RELEASE = 0; + USDX_VERSION_STATE = 'Alpha'; + USDX_STRING = 'UltraStar Deluxe'; + + (* + * FPC version numbers are already defined as built-in macros: + * FPC_VERSION (MAJOR) + * FPC_RELEASE (MINOR) + * FPC_PATCH (RELEASE) + * Since FPC_VERSION is already defined, we will use FPC_VERSION_INT as + * composed version number. + *) + {$IFNDEF FPC} + // Delphi 7 evaluates every $IF-directive even if it is disabled by a surrounding + // $IF or $IFDEF so the follwing will give you an error in delphi: + // {$IFDEF FPC}{$IF (FPC_VERSION > 2)}...{$IFEND}{$ENDIF} + // The reason for this error is that FPC_VERSION is not a valid constant. + // To avoid this error, we define dummys here. + FPC_VERSION = 0; + FPC_RELEASE = 0; + FPC_PATCH = 0; + {$ENDIF} + + FPC_VERSION_INT = (FPC_VERSION * VERSION_MAJOR) + + (FPC_RELEASE * VERSION_MINOR) + + (FPC_PATCH * VERSION_RELEASE); + + + {$IFDEF HaveFFmpeg} + + LIBAVCODEC_VERSION = (LIBAVCODEC_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVCODEC_VERSION_MINOR * VERSION_MINOR) + + (LIBAVCODEC_VERSION_RELEASE * VERSION_RELEASE); + + LIBAVFORMAT_VERSION = (LIBAVFORMAT_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVFORMAT_VERSION_MINOR * VERSION_MINOR) + + (LIBAVFORMAT_VERSION_RELEASE * VERSION_RELEASE); + + LIBAVUTIL_VERSION = (LIBAVUTIL_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVUTIL_VERSION_MINOR * VERSION_MINOR) + + (LIBAVUTIL_VERSION_RELEASE * VERSION_RELEASE); + + {$IFDEF HaveSWScale} + LIBSWSCALE_VERSION = (LIBSWSCALE_VERSION_MAJOR * VERSION_MAJOR) + + (LIBSWSCALE_VERSION_MINOR * VERSION_MINOR) + + (LIBSWSCALE_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + + {$ENDIF} + + {$IFDEF HaveProjectM} + PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) + + (PROJECTM_VERSION_MINOR * VERSION_MINOR) + + (PROJECTM_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + + {$IFDEF HavePortaudio} + PORTAUDIO_VERSION = (PORTAUDIO_VERSION_MAJOR * VERSION_MAJOR) + + (PORTAUDIO_VERSION_MINOR * VERSION_MINOR) + + (PORTAUDIO_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + + {$IFDEF HaveLibsamplerate} + LIBSAMPLERATE_VERSION = (LIBSAMPLERATE_VERSION_MAJOR * VERSION_MAJOR) + + (LIBSAMPLERATE_VERSION_MINOR * VERSION_MINOR) + + (LIBSAMPLERATE_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + +function USDXVersionStr(): string; +function USDXShortVersionStr(): string; + +implementation + +uses + StrUtils, Math; + +function USDXShortVersionStr(): string; +begin + Result := + USDX_STRING + + IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE); +end; + +function USDXVersionStr(): string; +begin + Result := + USDX_STRING + ' V ' + + IntToStr(USDX_VERSION_MAJOR) + '.' + + IntToStr(USDX_VERSION_MINOR) + '.' + + IntToStr(USDX_VERSION_RELEASE) + + IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE) + + ' Build'; +end; + +end. diff --git a/src/classes0/UCore.pas b/src/classes0/UCore.pas new file mode 100644 index 00000000..fe23a68e --- /dev/null +++ b/src/classes0/UCore.pas @@ -0,0 +1,525 @@ +unit UCore; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + uPluginDefs, + uCoreModule, + UHooks, + UServices, + UModules; + +{********************* + TCore + Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process + Also it does some Error Handling, and maybe sometime multithreaded Loading ;) +*********************} + +type + TModuleListItem = record + Module: TCoreModule; //Instance of the Modules Class + Info: TModuleInfo; //ModuleInfo returned by Modules Modulinfo Proc + NeedsDeInit: Boolean; //True if Module was succesful inited + end; + + TCore = class + private + //Some Hook Handles. See Plugin SDKs Hooks.txt for Infos + hLoadingFinished: THandle; + hMainLoop: THandle; + hTranslate: THandle; + hLoadTextures: THandle; + hExitQuery: THandle; + hExit: THandle; + hDebug: THandle; + hError: THandle; + sReportError: THandle; + sReportDebug: THandle; + sShowMessage: THandle; + sRetranslate: THandle; + sReloadTextures: THandle; + sGetModuleInfo: THandle; + sGetApplicationHandle: THandle; + + Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; + + //Cur + Last Executed Setting and Getting ;) + iCurExecuted: Integer; + iLastExecuted: Integer; + + procedure SetCurExecuted(Value: Integer); + + //Function Get all Modules and Creates them + function GetModules: Boolean; + + //Loads Core and all Modules + function Load: Boolean; + + //Inits Core and all Modules + function Init: Boolean; + + //DeInits Core and all Modules + function DeInit: Boolean; + + //Load the Core + function LoadCore: Boolean; + + //Init the Core + function InitCore: Boolean; + + //DeInit the Core + function DeInitCore: Boolean; + + //Called one Time per Frame + function MainLoop: Boolean; + + public + Hooks: THookManager; //Teh Hook Manager ;) + Services: TServiceManager;//The Service Manager + + Name: String; //Name of this Application + Version: LongWord; //Version of this ". For Info Look PluginDefs Functions + + LastErrorReporter:String; //Who Reported the Last Error String + LastErrorString: String; //Last Error String reported + + property CurExecuted: Integer read iCurExecuted write SetCurExecuted; //ID of Plugin or Module curently Executed + property LastExecuted: Integer read iLastExecuted; + + //--------------- + //Main Methods to control the Core: + //--------------- + constructor Create(const cName: String; const cVersion: LongWord); + + //Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown + procedure Run; + + //Method for other Classes to get Pointer to a specific Module + function GetModulebyName(const Name: String): PCoreModule; + + //-------------- + // Hook and Service Procs: + //-------------- + function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) + function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook + function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook + function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam + function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle + end; + +var + Core: TCore; + +implementation + +uses + {$IFDEF win32} + Windows, + {$ENDIF} + SysUtils; + +//------------- +// Create - Creates Class + Hook and Service Manager +//------------- +constructor TCore.Create(const cName: String; const cVersion: LongWord); +begin + inherited Create; + + Name := cName; + Version := cVersion; + iLastExecuted := 0; + iCurExecuted := 0; + + LastErrorReporter := ''; + LastErrorString := ''; + + Hooks := THookManager.Create(50); + Services := TServiceManager.Create; +end; + +//------------- +//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown +//------------- +procedure TCore.Run; +var + Success: Boolean; + + procedure HandleError(const ErrorMsg: string); + begin + if (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg + ': ' + LastErrorString)) + else + Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg)); + + //DeInit + DeInit; + end; + +begin + //Get Modules + try + Success := GetModules(); + except + Success := False; + end; + + if (not Success) then + begin + HandleError('Error Getting Modules'); + Exit; + end; + + //Loading + try + Success := Load(); + except + Success := False; + end; + + if (not Success) then + begin + HandleError('Error loading Modules'); + Exit; + end; + + //Init + try + Success := Init(); + except + Success := False; + end; + + if (not Success) then + begin + HandleError('Error initing Modules'); + Exit; + end; + + //Call Translate Hook + if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then + begin + HandleError('Error translating'); + Exit; + end; + + //Calls LoadTextures Hook + if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then + begin + HandleError('Error loading textures'); + Exit; + end; + + //Calls Loading Finished Hook + if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then + begin + HandleError('Error calling LoadingFinished Hook'); + Exit; + end; + + //Start MainLoop + while Success do + begin + Success := MainLoop(); + // to-do : Call Display Draw here + end; +end; + +//------------- +//Called one Time per Frame +//------------- +function TCore.MainLoop: Boolean; +begin + Result := False; +end; + +//------------- +//Function Get all Modules and Creates them +//------------- +function TCore.GetModules: Boolean; +var + i: Integer; +begin + Result := False; + for i := 0 to high(Modules) do + begin + try + Modules[i].NeedsDeInit := False; + Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create; + Modules[i].Module.Info(@Modules[i].Info); + except + ReportError(Integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + Exit; + end; + end; + Result := True; +end; + +//------------- +//Loads Core and all Modules +//------------- +function TCore.Load: Boolean; +var + i: Integer; +begin + Result := LoadCore; + + for i := 0 to High(CORE_MODULES_TO_LOAD) do + begin + try + Result := Modules[i].Module.Load; + except + Result := False; + end; + + if (not Result) then + begin + ReportError(Integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + break; + end; + end; +end; + +//------------- +//Inits Core and all Modules +//------------- +function TCore.Init: Boolean; +var + i: Integer; +begin + Result := InitCore; + + for i := 0 to High(CORE_MODULES_TO_LOAD) do + begin + try + Result := Modules[i].Module.Init; + except + Result := False; + end; + + if (not Result) then + begin + ReportError(Integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + break; + end; + + Modules[i].NeedsDeInit := Result; + end; +end; + +//------------- +//DeInits Core and all Modules +//------------- +function TCore.DeInit: boolean; +var + i: integer; +begin + + for i := High(CORE_MODULES_TO_LOAD) downto 0 do + begin + try + if (Modules[i].NeedsDeInit) then + Modules[i].Module.DeInit; + except + end; + end; + + DeInitCore; + + Result := true; +end; + +//------------- +//Load the Core +//------------- +function TCore.LoadCore: Boolean; +begin + hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished'); + hMainLoop := Hooks.AddEvent('Core/MainLoop'); + hTranslate := Hooks.AddEvent('Core/Translate'); + hLoadTextures := Hooks.AddEvent('Core/LoadTextures'); + hExitQuery := Hooks.AddEvent('Core/ExitQuery'); + hExit := Hooks.AddEvent('Core/Exit'); + hDebug := Hooks.AddEvent('Core/NewDebugInfo'); + hError := Hooks.AddEvent('Core/NewError'); + + sReportError := Services.AddService('Core/ReportError', nil, Self.ReportError); + sReportDebug := Services.AddService('Core/ReportDebug', nil, Self.ReportDebug); + sShowMessage := Services.AddService('Core/ShowMessage', nil, Self.ShowMessage); + sRetranslate := Services.AddService('Core/Retranslate', nil, Self.Retranslate); + sReloadTextures := Services.AddService('Core/ReloadTextures', nil, Self.ReloadTextures); + sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo); + sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle); + + //A little Test + Hooks.AddSubscriber('Core/NewError', HookTest); + + result := true; +end; + +//------------- +//Init the Core +//------------- +function TCore.InitCore: Boolean; +begin + //Don not init something atm. + result := true; +end; + +//------------- +//DeInit the Core +//------------- +function TCore.DeInitCore: Boolean; +begin + // TODO: write TService-/HookManager.Free and call it here + Result := true; +end; + +//------------- +//Method for other classes to get pointer to a specific module +//------------- +function TCore.GetModuleByName(const Name: String): PCoreModule; +var i: Integer; +begin + Result := nil; + for i := 0 to High(Modules) do + begin + if (Modules[i].Info.Name = Name) then + begin + Result := @Modules[i].Module; + Break; + end; + end; +end; + +//------------- +// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) +//------------- +function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer; +{$IFDEF MSWINDOWS} +var Params: Cardinal; +{$ENDIF} +begin + Result := -1; + + {$IFDEF MSWINDOWS} + if (lParam <> nil) then + begin + Params := MB_OK; + case wParam of + CORE_SM_ERROR: Params := Params or MB_ICONERROR; + CORE_SM_WARNING: Params := Params or MB_ICONWARNING; + CORE_SM_INFO: Params := Params or MB_ICONINFORMATION; + end; + + //Show: + Result := Messagebox(0, lParam, PChar(Name), Params); + end; + {$ENDIF} + + // TODO: write ShowMessage for other OSes +end; + +//------------- +// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer; +begin + //Update LastErrorReporter and LastErrorString + LastErrorReporter := String(PChar(lParam)); + LastErrorString := String(PChar(Pointer(wParam))); + + Hooks.CallEventChain(hError, wParam, lParam); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hDebug, wParam, lParam); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// Calls Translate hook +//------------- +function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hTranslate, 1, nil); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// Calls LoadTextures hook +//------------- +function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hLoadTextures, 1, nil); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam +//------------- +function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; +var + I: integer; +begin + if (Pointer(lParam) = nil) then + begin + Result := Length(Modules); + end + else + begin + try + for I := 0 to High(Modules) do + begin + AModuleInfo(Pointer(lParam))[I].Name := Modules[I].Info.Name; + AModuleInfo(Pointer(lParam))[I].Version := Modules[I].Info.Version; + AModuleInfo(Pointer(lParam))[I].Description := Modules[I].Info.Description; + end; + Result := Length(Modules); + except + Result := -1; + end; + end; +end; + +//------------- +// Returns Application Handle +//------------- +function TCore.GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; +begin + Result := hInstance; +end; + +//------------- +// Called when setting CurExecuted +//------------- +procedure TCore.SetCurExecuted(Value: Integer); +begin + //Set Last Executed + iLastExecuted := iCurExecuted; + + //Set Cur Executed + iCurExecuted := Value; +end; + +end. diff --git a/src/classes0/UCoreModule.pas b/src/classes0/UCoreModule.pas new file mode 100644 index 00000000..031fb04e --- /dev/null +++ b/src/classes0/UCoreModule.pas @@ -0,0 +1,128 @@ +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 + Destructor Destroy; override; + end; + cCoreModule = class of TCoreModule; + +implementation + +//------------- +// Just the Constructor +//------------- +Constructor TCoreModule.Create; +begin + //Dummy maaaan ;) + inherited; +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 +//------------- +Destructor TCoreModule.Destroy; +begin + //Dummy ftw!! + inherited; +end; + +end. diff --git a/src/classes0/UCovers.pas b/src/classes0/UCovers.pas new file mode 100644 index 00000000..7bb57b4a --- /dev/null +++ b/src/classes0/UCovers.pas @@ -0,0 +1,430 @@ +unit UCovers; + +{ + TODO: + - adjust database to new song-loading (e.g. use SongIDs) + - support for deletion of outdated covers + - support for update of changed covers + - use paths relative to the song for removable disks support + (a drive might have a different drive-name the next time it is connected, + so "H:/songs/..." will not match "I:/songs/...") +} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + sdl, + SQLite3, + SQLiteTable3, + SysUtils, + Classes, + UImage, + UTexture; + +type + ECoverDBException = class(Exception) + end; + + TCover = class + private + ID: int64; + Filename: WideString; + public + constructor Create(ID: int64; Filename: WideString); + function GetPreviewTexture(): TTexture; + function GetTexture(): TTexture; + end; + + TThumbnailInfo = record + CoverWidth: integer; // Original width of cover + CoverHeight: integer; // Original height of cover + PixelFormat: TImagePixelFmt; // Pixel-format of thumbnail + end; + + TCoverDatabase = class + private + DB: TSQLiteDatabase; + procedure InitCoverDatabase(); + function CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface; + function LoadCover(CoverID: int64): TTexture; + procedure DeleteCover(CoverID: int64); + function FindCoverIntern(const Filename: WideString): int64; + procedure Open(); + function GetVersion(): integer; + procedure SetVersion(Version: integer); + public + constructor Create(); + destructor Destroy; override; + function AddCover(const Filename: WideString): TCover; + function FindCover(const Filename: WideString): TCover; + function CoverExists(const Filename: WideString): boolean; + function GetMaxCoverSize(): integer; + procedure SetMaxCoverSize(Size: integer); + end; + + TBlobWrapper = class(TCustomMemoryStream) + function Write(const Buffer; Count: Integer): Integer; override; + end; + +var + Covers: TCoverDatabase; + +implementation + +uses + UMain, + ULog, + UPlatform, + UIni, + Math, + DateUtils; + +const + COVERDB_FILENAME = 'cover.db'; + COVERDB_VERSION = 01; // 0.1 + COVER_TBL = 'Cover'; + COVER_THUMBNAIL_TBL = 'CoverThumbnail'; + COVER_IDX = 'Cover_Filename_IDX'; + +// Note: DateUtils.DateTimeToUnix() will throw an exception in FPC +function DateTimeToUnixTime(time: TDateTime): int64; +begin + Result := Round((time - UnixDateDelta) * SecsPerDay); +end; + +// Note: DateUtils.UnixToDateTime() will throw an exception in FPC +function UnixTimeToDateTime(timestamp: int64): TDateTime; +begin + Result := timestamp / SecsPerDay + UnixDateDelta; +end; + + +{ TBlobWrapper } + +function TBlobWrapper.Write(const Buffer; Count: Integer): Integer; +begin + SetPointer(Pointer(Buffer), Count); + Result := Count; +end; + + +{ TCover } + +constructor TCover.Create(ID: int64; Filename: WideString); +begin + Self.ID := ID; + Self.Filename := Filename; +end; + +function TCover.GetPreviewTexture(): TTexture; +begin + Result := Covers.LoadCover(ID); +end; + +function TCover.GetTexture(): TTexture; +begin + Result := Texture.LoadTexture(Filename); +end; + + +{ TCoverDatabase } + +constructor TCoverDatabase.Create(); +begin + inherited; + + Open(); + InitCoverDatabase(); +end; + +destructor TCoverDatabase.Destroy; +begin + DB.Free; + inherited; +end; + +function TCoverDatabase.GetVersion(): integer; +begin + Result := DB.GetTableValue('PRAGMA user_version'); +end; + +procedure TCoverDatabase.SetVersion(Version: integer); +begin + DB.ExecSQL(Format('PRAGMA user_version = %d', [Version])); +end; + +function TCoverDatabase.GetMaxCoverSize(): integer; +begin + Result := ITextureSizeVals[Ini.TextureSize]; +end; + +procedure TCoverDatabase.SetMaxCoverSize(Size: integer); +var + I: integer; +begin + // search for first valid cover-size > Size + for I := 0 to Length(ITextureSizeVals)-1 do + begin + if (Size <= ITextureSizeVals[I]) then + begin + Ini.TextureSize := I; + Exit; + end; + end; + + // fall-back to highest size + Ini.TextureSize := High(ITextureSizeVals); +end; + +procedure TCoverDatabase.Open(); +var + Version: integer; + Filename: string; +begin + Filename := UTF8Encode(Platform.GetGameUserPath() + COVERDB_FILENAME); + + DB := TSQLiteDatabase.Create(Filename); + Version := GetVersion(); + + // check version, if version is too old/new, delete database file + if ((Version <> 0) and (Version <> COVERDB_VERSION)) then + begin + Log.LogInfo('Outdated cover-database file found', 'TCoverDatabase.Open'); + // close and delete outdated file + DB.Free; + if (not DeleteFile(Filename)) then + raise ECoverDBException.Create('Could not delete ' + Filename); + // reopen + DB := TSQLiteDatabase.Create(Filename); + Version := 0; + end; + + // set version number after creation + if (Version = 0) then + SetVersion(COVERDB_VERSION); + + // speed-up disk-writing. The default FULL-synchronous mode is too slow. + // With this option disk-writing is approx. 4 times faster but the database + // might be corrupted if the OS crashes, although this is very unlikely. + DB.ExecSQL('PRAGMA synchronous = OFF;'); + + // the next line rather gives a slow-down instead of a speed-up, so we do not use it + //DB.ExecSQL('PRAGMA temp_store = MEMORY;'); +end; + +procedure TCoverDatabase.InitCoverDatabase(); +begin + DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_TBL+'] (' + + '[ID] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, ' + + '[Filename] TEXT UNIQUE NOT NULL, ' + + '[Date] INTEGER NOT NULL, ' + + '[Width] INTEGER NOT NULL, ' + + '[Height] INTEGER NOT NULL ' + + ')'); + + DB.ExecSQL('CREATE INDEX IF NOT EXISTS ['+COVER_IDX+'] ON ['+COVER_TBL+'](' + + '[Filename] ASC' + + ')'); + + DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_THUMBNAIL_TBL+'] (' + + '[ID] INTEGER NOT NULL PRIMARY KEY, ' + + '[Format] INTEGER NOT NULL, ' + + '[Width] INTEGER NOT NULL, ' + + '[Height] INTEGER NOT NULL, ' + + '[Data] BLOB NULL' + + ')'); +end; + +function TCoverDatabase.FindCoverIntern(const Filename: WideString): int64; +begin + Result := DB.GetTableValue('SELECT [ID] FROM ['+COVER_TBL+'] ' + + 'WHERE [Filename] = ?', + [UTF8Encode(Filename)]); +end; + +function TCoverDatabase.FindCover(const Filename: WideString): TCover; +var + CoverID: int64; +begin + Result := nil; + try + CoverID := FindCoverIntern(Filename); + if (CoverID > 0) then + Result := TCover.Create(CoverID, Filename); + except on E: Exception do + Log.LogError(E.Message, 'TCoverDatabase.FindCover'); + end; +end; + +function TCoverDatabase.CoverExists(const Filename: WideString): boolean; +begin + Result := false; + try + Result := (FindCoverIntern(Filename) > 0); + except on E: Exception do + Log.LogError(E.Message, 'TCoverDatabase.CoverExists'); + end; +end; + +function TCoverDatabase.AddCover(const Filename: WideString): TCover; +var + CoverID: int64; + Thumbnail: PSDL_Surface; + CoverData: TBlobWrapper; + FileDate: TDateTime; + Info: TThumbnailInfo; +begin + Result := nil; + + //if (not FileExists(Filename)) then + // Exit; + + // TODO: replace '\' with '/' in filename + FileDate := Now(); //FileDateToDateTime(FileAge(Filename)); + + Thumbnail := CreateThumbnail(Filename, Info); + if (Thumbnail = nil) then + Exit; + + CoverData := TBlobWrapper.Create; + CoverData.Write(Thumbnail^.pixels, Thumbnail^.h * Thumbnail^.pitch); + + try + // Note: use a transaction to speed-up file-writing. + // Without data written by the first INSERT might be moved at the second INSERT. + DB.BeginTransaction(); + + // add general cover info + DB.ExecSQL('INSERT INTO ['+COVER_TBL+'] ' + + '([Filename], [Date], [Width], [Height]) VALUES' + + '(?, ?, ?, ?)', + [UTF8Encode(Filename), DateTimeToUnixTime(FileDate), + Info.CoverWidth, Info.CoverHeight]); + + // get auto-generated cover ID + CoverID := DB.GetLastInsertRowID(); + + // add thumbnail info + DB.ExecSQL('INSERT INTO ['+COVER_THUMBNAIL_TBL+'] ' + + '([ID], [Format], [Width], [Height], [Data]) VALUES' + + '(?, ?, ?, ?, ?)', + [CoverID, Ord(Info.PixelFormat), + Thumbnail^.w, Thumbnail^.h, CoverData]); + + Result := TCover.Create(CoverID, Filename); + except on E: Exception do + Log.LogError(E.Message, 'TCoverDatabase.AddCover'); + end; + + DB.Commit(); + CoverData.Free; + SDL_FreeSurface(Thumbnail); +end; + +function TCoverDatabase.LoadCover(CoverID: int64): TTexture; +var + Width, Height: integer; + PixelFmt: TImagePixelFmt; + Data: PChar; + DataSize: integer; + Filename: WideString; + Table: TSQLiteUniTable; +begin + Table := nil; + + try + Table := DB.GetUniTable(Format( + 'SELECT C.[Filename], T.[Format], T.[Width], T.[Height], T.[Data] ' + + 'FROM ['+COVER_TBL+'] C ' + + 'INNER JOIN ['+COVER_THUMBNAIL_TBL+'] T ' + + 'USING(ID) ' + + 'WHERE [ID] = %d', [CoverID])); + + Filename := UTF8Decode(Table.FieldAsString(0)); + PixelFmt := TImagePixelFmt(Table.FieldAsInteger(1)); + Width := Table.FieldAsInteger(2); + Height := Table.FieldAsInteger(3); + + Data := Table.FieldAsBlobPtr(4, DataSize); + if (Data <> nil) and + (PixelFmt = ipfRGB) then + begin + Result := Texture.CreateTexture(Data, Filename, Width, Height, 24) + end + else + begin + FillChar(Result, SizeOf(TTexture), 0); + end; + except on E: Exception do + Log.LogError(E.Message, 'TCoverDatabase.LoadCover'); + end; + + Table.Free; +end; + +procedure TCoverDatabase.DeleteCover(CoverID: int64); +begin + DB.ExecSQL(Format('DELETE FROM ['+COVER_TBL+'] WHERE [ID] = %d', [CoverID])); + DB.ExecSQL(Format('DELETE FROM ['+COVER_THUMBNAIL_TBL+'] WHERE [ID] = %d', [CoverID])); +end; + +(** + * Returns a pointer to an array of bytes containing the texture data in the + * requested size + *) +function TCoverDatabase.CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface; +var + TargetAspect, SourceAspect: double; + //TargetWidth, TargetHeight: integer; + Thumbnail: PSDL_Surface; + MaxSize: integer; +begin + Result := nil; + + MaxSize := GetMaxCoverSize(); + + Thumbnail := LoadImage(Filename); + if (not assigned(Thumbnail)) then + begin + Log.LogError('Could not load cover: "'+ Filename +'"', 'TCoverDatabase.AddCover'); + Exit; + end; + + // Convert pixel format as needed + AdjustPixelFormat(Thumbnail, TEXTURE_TYPE_PLAIN); + + Info.CoverWidth := Thumbnail^.w; + Info.CoverHeight := Thumbnail^.h; + Info.PixelFormat := ipfRGB; + + (* TODO: keep aspect ratio + TargetAspect := Width / Height; + SourceAspect := TexSurface.w / TexSurface.h; + + // Scale texture to covers dimensions (keep aspect) + if (SourceAspect >= TargetAspect) then + begin + TargetWidth := Width; + TargetHeight := Trunc(Width / SourceAspect); + end + else + begin + TargetHeight := Height; + TargetWidth := Trunc(Height * SourceAspect); + end; + *) + + // TODO: do not scale if image is smaller + ScaleImage(Thumbnail, MaxSize, MaxSize); + + Result := Thumbnail; +end; + +end. + diff --git a/src/classes0/UDLLManager.pas b/src/classes0/UDLLManager.pas new file mode 100644 index 00000000..3d32a72a --- /dev/null +++ b/src/classes0/UDLLManager.pas @@ -0,0 +1,253 @@ +unit UDLLManager; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses ModiSDK, + UFiles; + +type + TDLLMan = class + private + hLib: THandle; + P_Init: fModi_Init; + P_Draw: fModi_Draw; + P_Finish: fModi_Finish; + P_RData: pModi_RData; + public + Plugins: array of TPluginInfo; + PluginPaths: array of String; + Selected: ^TPluginInfo; + + constructor Create; + + procedure GetPluginList; + procedure ClearPluginInfo(No: Cardinal); + function LoadPluginInfo(Filename: String; No: Cardinal): boolean; + + function LoadPlugin(No: Cardinal): boolean; + procedure UnLoadPlugin; + + function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; + function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; + function PluginFinish (var Playerinfo: TPlayerinfo): byte; + procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); + end; + +var + DLLMan: TDLLMan; + +const + DLLPath = 'Plugins'; + + {$IFDEF MSWINDOWS} + DLLExt = '.dll'; + {$ENDIF} + {$IFDEF LINUX} + DLLExt = '.so'; + {$ENDIF} + {$IFDEF DARWIN} + DLLExt = '.dylib'; + {$ENDIF} + +implementation + +uses {$IFDEF MSWINDOWS} + windows, + {$ELSE} + dynlibs, + {$ENDIF} + ULog, + SysUtils; + + +constructor TDLLMan.Create; +begin + inherited; + SetLength(Plugins, 0); + SetLength(PluginPaths, Length(Plugins)); + GetPluginList; +end; + +procedure TDLLMan.GetPluginList; +var + SR: TSearchRec; +begin + + if FindFirst(DLLPath +PathDelim+ '*' + DLLExt, faAnyFile , SR) = 0 then + begin + repeat + SetLength(Plugins, Length(Plugins)+1); + SetLength(PluginPaths, Length(Plugins)); + + if LoadPluginInfo(SR.Name, High(Plugins)) then //Loaded succesful + begin + PluginPaths[High(PluginPaths)] := SR.Name; + end + else //Error Loading + begin + SetLength(Plugins, Length(Plugins)-1); + SetLength(PluginPaths, Length(Plugins)); + end; + + until FindNext(SR) <> 0; + FindClose(SR); + end; +end; + +procedure TDLLMan.ClearPluginInfo(No: Cardinal); +begin + //Set to Party Modi Plugin + Plugins[No].Typ := 8; + + Plugins[No].Name := 'unknown'; + Plugins[No].NumPlayers := 0; + + Plugins[No].Creator := 'Nobody'; + Plugins[No].PluginDesc := 'NO_PLUGIN_DESC'; + + Plugins[No].LoadSong := True; + Plugins[No].ShowScore := True; + Plugins[No].ShowBars := False; + Plugins[No].ShowNotes := True; + Plugins[No].LoadVideo := True; + Plugins[No].LoadBack := True; + + Plugins[No].TeamModeOnly := False; + Plugins[No].GetSoundData := False; + Plugins[No].Dummy := False; + + + Plugins[No].BGShowFull := False; + Plugins[No].BGShowFull_O := True; + + Plugins[No].ShowRateBar:= False; + Plugins[No].ShowRateBar_O := True; + + Plugins[No].EnLineBonus := False; + Plugins[No].EnLineBonus_O := True; +end; + +function TDLLMan.LoadPluginInfo(Filename: String; No: Cardinal): boolean; +var + hLibg: THandle; + Info: pModi_PluginInfo; + I: Integer; +begin + Result := False; + //Clear Plugin Info + ClearPluginInfo(No); + + {//Workaround Plugins Loaded 2 Times + For I := low(PluginPaths) to high(PluginPaths) do + if (PluginPaths[I] = Filename) then + exit; } + + //Load Libary + hLibg := LoadLibrary(PChar(DLLPath +PathDelim+ Filename)); + //If Loaded + if (hLibg <> 0) then + begin + //Load Info Procedure + @Info := GetProcAddress (hLibg, PChar('PluginInfo')); + + //If Loaded + if (@Info <> nil) then + begin + //Load PluginInfo + Info (Plugins[No]); + Result := True; + end + else + Log.LogError('Could not Load Plugin "' + Filename + '": Info Procedure not Found'); + + FreeLibrary (hLibg); + end + else + Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded'); +end; + +function TDLLMan.LoadPlugin(No: Cardinal): boolean; +begin + Result := False; + //Load Libary + hLib := LoadLibrary(PChar(DLLPath +PathDelim+ PluginPaths[No])); + //If Loaded + if (hLib <> 0) then + begin + //Load Info Procedure + @P_Init := GetProcAddress (hLib, PChar('Init')); + @P_Draw := GetProcAddress (hLib, PChar('Draw')); + @P_Finish := GetProcAddress (hLib, PChar('Finish')); + + //If Loaded + if (@P_Init <> nil) And (@P_Draw <> nil) And (@P_Finish <> nil) then + begin + Selected := @Plugins[No]; + Result := True; + end + else + begin + Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Procedures not Found'); + + end; + end + else + Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Libary not Loaded'); +end; + +procedure TDLLMan.UnLoadPlugin; +begin +if (hLib <> 0) then + FreeLibrary (hLib); + +//Selected := nil; +@P_Init := nil; +@P_Draw := nil; +@P_Finish := nil; +@P_RData := nil; +end; + +function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; +var + Methods: TMethodRec; +begin + Methods.LoadTex := LoadTex; + Methods.Print := Print; + Methods.LoadSound := LoadSound; + Methods.PlaySound := PlaySound; + + if (@P_Init <> nil) then + Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods) + else + Result := False +end; + +function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; +begin +if (@P_Draw <> nil) then + Result := P_Draw (PlayerInfo, CurSentence) +else + Result := False +end; + +function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte; +begin +if (@P_Finish <> nil) then + Result := P_Finish (PlayerInfo) +else + Result := 0; +end; + +procedure TDLLMan.PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); +begin +if (@P_RData <> nil) then + P_RData (handle, buffer, len, user); +end; + +end. diff --git a/src/classes0/UDataBase.pas b/src/classes0/UDataBase.pas new file mode 100644 index 00000000..cd315df3 --- /dev/null +++ b/src/classes0/UDataBase.pas @@ -0,0 +1,533 @@ +unit UDataBase; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses USongs, + USong, + Classes, + SQLiteTable3; + +//-------------------- +//DataBaseSystem - Class including all DB Methods +//-------------------- +type + TStatType = ( + stBestScores, // Best Scores + stBestSingers, // Best Singers + stMostSungSong, // Most sung Songs + stMostPopBand // Most popular Band + ); + + // abstract super-class for statistic results + TStatResult = class + public + Typ: TStatType; + end; + + TStatResultBestScores = class(TStatResult) + public + Singer: WideString; + Score: Word; + Difficulty: Byte; + SongArtist: WideString; + SongTitle: WideString; + end; + + TStatResultBestSingers = class(TStatResult) + public + Player: WideString; + AverageScore: Word; + end; + + TStatResultMostSungSong = class(TStatResult) + public + Artist: WideString; + Title: WideString; + TimesSung: Word; + end; + + TStatResultMostPopBand = class(TStatResult) + public + ArtistName: WideString; + TimesSungTot: Word; + end; + + + TDataBaseSystem = class + private + ScoreDB: TSQLiteDatabase; + fFilename: string; + + function GetVersion(): integer; + procedure SetVersion(Version: integer); + public + property Filename: string read fFilename; + + destructor Destroy; override; + + procedure Init(const Filename: string); + procedure ReadScore(Song: TSong); + procedure AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer); + procedure WriteScore(Song: TSong); + + function GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList; + procedure FreeStats(StatList: TList); + function GetTotalEntrys(Typ: TStatType): Cardinal; + function GetStatReset: TDateTime; + end; + +var + DataBase: TDataBaseSystem; + +implementation + +uses + ULog, + DateUtils, + StrUtils, + SysUtils; + +const + cDBVersion = 01; // 0.1 + cUS_Scores = 'us_scores'; + cUS_Songs = 'us_songs'; + cUS_Statistics_Info = 'us_statistics_info'; + +(** + * Opens Database and Create Tables if not Exist + *) +procedure TDataBaseSystem.Init(const Filename: string); +var + Version: integer; +begin + if Assigned(ScoreDB) then + Exit; + + Log.LogStatus('Initializing database: "'+Filename+'"', 'TDataBaseSystem.Init'); + + try + + // Open Database + ScoreDB := TSQLiteDatabase.Create(Filename); + fFilename := Filename; + + // Close and delete outdated file + Version := GetVersion(); + if ((Version <> 0) and (Version <> cDBVersion)) then + begin + Log.LogInfo('Outdated cover-database file found', 'TDataBaseSystem.Init'); + // Close and delete outdated file + ScoreDB.Free; + if (not DeleteFile(Filename)) then + raise Exception.Create('Could not delete ' + Filename); + // Reopen + ScoreDB := TSQLiteDatabase.Create(Filename); + Version := 0; + end; + + // Set version number after creation + if (Version = 0) then + SetVersion(cDBVersion); + + + // SQLite does not handle VARCHAR(n) or INT(n) as expected. + // Texts do not have a restricted length, no matter which type is used, + // so use the native TEXT type. INT(n) is always INTEGER. + // In addition, SQLiteTable3 will fail if other types than the native SQLite + // types are used (especially FieldAsInteger). Also take care to write the + // types in upper-case letters although SQLite does not care about this - + // SQLiteTable3 is very sensitive in this regard. + + ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Scores+'] (' + + '[SongID] INTEGER NOT NULL, ' + + '[Difficulty] INTEGER NOT NULL, ' + + '[Player] TEXT NOT NULL, ' + + '[Score] INTEGER NOT NULL' + + ');'); + + ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Songs+'] (' + + '[ID] INTEGER PRIMARY KEY, ' + + '[Artist] TEXT NOT NULL, ' + + '[Title] TEXT NOT NULL, ' + + '[TimesPlayed] INTEGER NOT NULL' + + ');'); + + if not ScoreDB.TableExists(cUS_Statistics_Info) then + begin + ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Statistics_Info+'] (' + + '[ResetTime] INTEGER' + + ');'); + // insert creation timestamp + ScoreDB.ExecSQL(Format('INSERT INTO ['+cUS_Statistics_Info+'] ' + + '([ResetTime]) VALUES(%d);', + [DateTimeToUnix(Now())])); + end; + + except + on E: Exception do + begin + Log.LogError(E.Message, 'TDataBaseSystem.Init'); + FreeAndNil(ScoreDB); + end; + end; + +end; + +(** + * Frees Database + *) +destructor TDataBaseSystem.Destroy; +begin + Log.LogInfo('TDataBaseSystem.Free', 'TDataBaseSystem.Destroy'); + ScoreDB.Free; + inherited; +end; + +(** + * Read Scores into SongArray + *) +procedure TDataBaseSystem.ReadScore(Song: TSong); +var + TableData: TSQLiteUniTable; + Difficulty: Integer; +begin + if not Assigned(ScoreDB) then + Exit; + + TableData := nil; + + try + // Search Song in DB + TableData := ScoreDB.GetUniTable( + 'SELECT [Difficulty], [Player], [Score] FROM ['+cUS_Scores+'] ' + + 'WHERE [SongID] = (' + + 'SELECT [ID] FROM ['+cUS_Songs+'] ' + + 'WHERE [Artist] = ? AND [Title] = ? ' + + 'LIMIT 1) ' + + 'ORDER BY [Score] DESC LIMIT 15', + [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); + + // Empty Old Scores + SetLength(Song.Score[0], 0); + SetLength(Song.Score[1], 0); + SetLength(Song.Score[2], 0); + + // Go through all Entrys + while (not TableData.EOF) do + begin + // Add one Entry to Array + Difficulty := TableData.FieldAsInteger(TableData.FieldIndex['Difficulty']); + if ((Difficulty >= 0) and (Difficulty <= 2)) and + (Length(Song.Score[Difficulty]) < 5) then + begin + SetLength(Song.Score[Difficulty], Length(Song.Score[Difficulty]) + 1); + + Song.Score[Difficulty, High(Song.Score[Difficulty])].Name := + UTF8Decode(TableData.FieldByName['Player']); + Song.Score[Difficulty, High(Song.Score[Difficulty])].Score := + TableData.FieldAsInteger(TableData.FieldIndex['Score']); + end; + + TableData.Next; + end; // while + + except + for Difficulty := 0 to 2 do + begin + SetLength(Song.Score[Difficulty], 1); + Song.Score[Difficulty, 1].Name := 'Error Reading ScoreDB'; + end; + end; + + TableData.Free; +end; + +(** + * Adds one new score to DB + *) +procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer); +var + ID: Integer; + TableData: TSQLiteTable; +begin + if not Assigned(ScoreDB) then + Exit; + + // Prevent 0 Scores from being added + if (Score <= 0) then + Exit; + + TableData := nil; + + try + + ID := ScoreDB.GetTableValue( + 'SELECT [ID] FROM ['+cUS_Songs+'] ' + + 'WHERE [Artist] = ? AND [Title] = ?', + [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); + if (ID = 0) then + begin + // Create song if it does not exist + ScoreDB.ExecSQL( + 'INSERT INTO ['+cUS_Songs+'] ' + + '([ID], [Artist], [Title], [TimesPlayed]) VALUES ' + + '(NULL, ?, ?, 0);', + [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); + // Get song-ID + ID := ScoreDB.GetLastInsertRowID(); + end; + // Create new entry + ScoreDB.ExecSQL( + 'INSERT INTO ['+cUS_Scores+'] ' + + '([SongID] ,[Difficulty], [Player], [Score]) VALUES ' + + '(?, ?, ?, ?);', + [ID, Level, UTF8Encode(Name), Score]); + + // Delete last position when there are more than 5 entrys. + // Fixes crash when there are > 5 ScoreEntrys + // Note: GetUniTable is not applicable here, as the results are used while + // table entries are deleted. + TableData := ScoreDB.GetTable( + 'SELECT [Player], [Score] FROM ['+cUS_Scores+'] ' + + 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' + + '[Difficulty] = ' + InttoStr(Level) +' ' + + 'ORDER BY [Score] DESC LIMIT -1 OFFSET 5'); + + while (not TableData.EOF) do + begin + // Note: Score is an int-value, so in contrast to Player, we do not bind + // this value. Otherwise we had to convert the string to an int to avoid + // an automatic cast of this field to the TEXT type (although it might even + // work that way). + ScoreDB.ExecSQL( + 'DELETE FROM ['+cUS_Scores+'] ' + + 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' + + '[Difficulty] = ' + InttoStr(Level) +' AND ' + + '[Player] = ? AND ' + + '[Score] = ' + TableData.FieldByName['Score'], + [TableData.FieldByName['Player']]); + + TableData.Next; + end; + + except on E: Exception do + Log.LogError(E.Message, 'TDataBaseSystem.AddScore'); + end; + + TableData.Free; +end; + +(** + * Not needed with new System. + * Used for increment played count + *) +procedure TDataBaseSystem.WriteScore(Song: TSong); +begin + if not Assigned(ScoreDB) then + Exit; + + try + // Increase TimesPlayed + ScoreDB.ExecSQL( + 'UPDATE ['+cUS_Songs+'] ' + + 'SET [TimesPlayed] = [TimesPlayed] + 1 ' + + 'WHERE [Title] = ? AND [Artist] = ?;', + [UTF8Encode(Song.Title), UTF8Encode(Song.Artist)]); + except on E: Exception do + Log.LogError(E.Message, 'TDataBaseSystem.WriteScore'); + end; +end; + +(** + * Writes some stats to array. + * Returns nil if the database is not ready or a list with zero or more statistic + * entries. + * Free the result-list with FreeStats() after usage to avoid memory leaks. + *) +function TDataBaseSystem.GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList; +var + Query: String; + TableData: TSQLiteUniTable; + Stat: TStatResult; +begin + Result := nil; + + if not Assigned(ScoreDB) then + Exit; + + {Todo: Add Prevention that only players with more than 5 scores are selected at type 2} + + // Create query + case Typ of + stBestScores: begin + Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title] FROM ['+cUS_Scores+'] ' + + 'INNER JOIN ['+cUS_Songs+'] ON ([SongID] = [ID]) ORDER BY [Score]'; + end; + stBestSingers: begin + Query := 'SELECT [Player], ROUND(AVG([Score])) FROM ['+cUS_Scores+'] ' + + 'GROUP BY [Player] ORDER BY AVG([Score])'; + end; + stMostSungSong: begin + Query := 'SELECT [Artist], [Title], [TimesPlayed] FROM ['+cUS_Songs+'] ' + + 'ORDER BY [TimesPlayed]'; + end; + stMostPopBand: begin + Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM ['+cUS_Songs+'] ' + + 'GROUP BY [Artist] ORDER BY SUM([TimesPlayed])'; + end; + end; + + // Add order direction + Query := Query + IfThen(Reversed, ' ASC', ' DESC'); + + // Add limit + Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';'; + + // Execute query + try + TableData := ScoreDB.GetUniTable(Query); + except + on E: Exception do + begin + Log.LogError(E.Message, 'TDataBaseSystem.GetStats'); + Exit; + end; + end; + + Result := TList.Create; + Stat := nil; + + // Copy result to stats array + while not TableData.EOF do + begin + case Typ of + stBestScores: begin + Stat := TStatResultBestScores.Create; + with TStatResultBestScores(Stat) do + begin + Singer := UTF8Decode(TableData.Fields[0]); + Difficulty := TableData.FieldAsInteger(1); + Score := TableData.FieldAsInteger(2); + SongArtist := UTF8Decode(TableData.Fields[3]); + SongTitle := UTF8Decode(TableData.Fields[4]); + end; + end; + stBestSingers: begin + Stat := TStatResultBestSingers.Create; + with TStatResultBestSingers(Stat) do + begin + Player := UTF8Decode(TableData.Fields[0]); + AverageScore := TableData.FieldAsInteger(1); + end; + end; + stMostSungSong: begin + Stat := TStatResultMostSungSong.Create; + with TStatResultMostSungSong(Stat) do + begin + Artist := UTF8Decode(TableData.Fields[0]); + Title := UTF8Decode(TableData.Fields[1]); + TimesSung := TableData.FieldAsInteger(2); + end; + end; + stMostPopBand: begin + Stat := TStatResultMostPopBand.Create; + with TStatResultMostPopBand(Stat) do + begin + ArtistName := UTF8Decode(TableData.Fields[0]); + TimesSungTot := TableData.FieldAsInteger(1); + end; + end + else + Log.LogCritical('Unknown stat-type', 'TDataBaseSystem.GetStats'); + end; + + Stat.Typ := Typ; + Result.Add(Stat); + + TableData.Next; + end; + + TableData.Free; +end; + +procedure TDataBaseSystem.FreeStats(StatList: TList); +var + I: integer; +begin + if (StatList = nil) then + Exit; + for I := 0 to StatList.Count-1 do + TStatResult(StatList[I]).Free; + StatList.Free; +end; + +(** + * Gets total number of entrys for a stats query + *) +function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): Cardinal; +var + Query: String; +begin + Result := 0; + + if not Assigned(ScoreDB) then + Exit; + + try + // Create query + case Typ of + stBestScores: + Query := 'SELECT COUNT([SongID]) FROM ['+cUS_Scores+'];'; + stBestSingers: + Query := 'SELECT COUNT(DISTINCT [Player]) FROM ['+cUS_Scores+'];'; + stMostSungSong: + Query := 'SELECT COUNT([ID]) FROM ['+cUS_Songs+'];'; + stMostPopBand: + Query := 'SELECT COUNT(DISTINCT [Artist]) FROM ['+cUS_Songs+'];'; + end; + + Result := ScoreDB.GetTableValue(Query); + except on E: Exception do + Log.LogError(E.Message, 'TDataBaseSystem.GetTotalEntrys'); + end; + +end; + +(** + * Gets reset date of statistic data + *) +function TDataBaseSystem.GetStatReset: TDateTime; +var + Query: string; + ResetTime: int64; +begin + Result := 0; + + if not Assigned(ScoreDB) then + Exit; + + try + Query := 'SELECT [ResetTime] FROM ['+cUS_Statistics_Info+'];'; + Result := UnixToDateTime(ScoreDB.GetTableValue(Query)); + except on E: Exception do + Log.LogError(E.Message, 'TDataBaseSystem.GetStatReset'); + end; +end; + +function TDataBaseSystem.GetVersion(): integer; +begin + Result := ScoreDB.GetTableValue('PRAGMA user_version'); +end; + +procedure TDataBaseSystem.SetVersion(Version: integer); +begin + ScoreDB.ExecSQL(Format('PRAGMA user_version = %d', [Version])); +end; + +end. diff --git a/src/classes0/UDraw.pas b/src/classes0/UDraw.pas new file mode 100644 index 00000000..ff0920f5 --- /dev/null +++ b/src/classes0/UDraw.pas @@ -0,0 +1,1390 @@ +unit UDraw; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UThemes, + ModiSDK, + UGraphicClasses; + +procedure SingDraw; +procedure SingModiDraw (PlayerInfo: TPlayerInfo); +procedure SingDrawBackground; +procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); +procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); +procedure SingDrawLyricHelper(Left, LyricsMid: real); +procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer); +procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); +procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer); +procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer); + +// TimeBar +procedure SingDrawTimeBar(); + +//Draw Editor NoteLines +procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); + + +type + TRecR = record + Top: real; + Left: real; + Right: real; + Bottom: real; + + Width: real; + WMid: real; + Height: real; + HMid: real; + + Mid: real; + end; + +var + NotesW: real; + NotesH: real; + Starfr: integer; + StarfrG: integer; + + //SingBar + TickOld: cardinal; + TickOld2:cardinal; + +const + Przedz = 32; + +implementation + +uses + gl, + UGraphic, + SysUtils, + UMusic, + URecord, + ULog, + UScreenSing, + UScreenSingModi, + ULyrics, + UMain, + TextGL, + UTexture, + UDrawTexture, + UIni, + Math, + UDLLManager; + +procedure SingDrawBackground; +var + Rec: TRecR; + TexRec: TRecR; +begin + if (ScreenSing.Tex_Background.TexNum > 0) then begin + + glClearColor (1, 1, 1, 1); + glColor4f (1, 1, 1, 1); + + if (Ini.MovieSize <= 1) then //HalfSize BG + begin + (* half screen + gradient *) + Rec.Top := 110; // 80 + Rec.Bottom := Rec.Top + 20; + Rec.Left := 0; + Rec.Right := 800; + + TexRec.Top := (Rec.Top / 600) * ScreenSing.Tex_Background.TexH; + TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; + TexRec.Left := 0; + TexRec.Right := ScreenSing.Tex_Background.TexW; + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum); + glEnable(GL_BLEND); + glBegin(GL_QUADS); + (* gradient draw *) + (* top *) + glColor4f(1, 1, 1, 0); + glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); + glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); + glColor4f(1, 1, 1, 1); + glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); + (* mid *) + Rec.Top := Rec.Bottom; + Rec.Bottom := 490 - 20; // 490 - 20 + TexRec.Top := TexRec.Bottom; + TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; + glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); + (* bottom *) + Rec.Top := Rec.Bottom; + Rec.Bottom := 490; // 490 + TexRec.Top := TexRec.Bottom; + TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; + glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); + glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); + glColor4f(1, 1, 1, 0); + glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); + + glEnd; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + end + else //Full Size BG + begin + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum); + //glEnable(GL_BLEND); + glBegin(GL_QUADS); + + glTexCoord2f(0, 0); glVertex2f(0, 0); + glTexCoord2f(0, ScreenSing.Tex_Background.TexH); glVertex2f(0, 600); + glTexCoord2f( ScreenSing.Tex_Background.TexW, ScreenSing.Tex_Background.TexH); glVertex2f(800, 600); + glTexCoord2f( ScreenSing.Tex_Background.TexW, 0); glVertex2f(800, 0); + + glEnd; + glDisable(GL_TEXTURE_2D); + //glDisable(GL_BLEND); + end; + end; +end; + +procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); +var + SampleIndex: integer; + Sound: TCaptureBuffer; + MaxX, MaxY: real; +begin; + Sound := AudioInputProcessor.Sound[NrSound]; + + // Log.LogStatus('Oscilloscope', 'SingDraw'); + glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); + {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then + glColor3f(1, 1, 1); } + + MaxX := W-1; + MaxY := (H-1) / 2; + + Sound.LockAnalysisBuffer(); + + glBegin(GL_LINE_STRIP); + for SampleIndex := 0 to High(Sound.AnalysisBuffer) do + begin + glVertex2f(X + MaxX * SampleIndex/High(Sound.AnalysisBuffer), + Y + MaxY * (1 - Sound.AnalysisBuffer[SampleIndex]/-Low(Smallint))); + end; + glEnd; + + Sound.UnlockAnalysisBuffer(); +end; + + + +procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); +var + Count: integer; +begin + glEnable(GL_BLEND); + glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); + glBegin(GL_LINES); + for Count := 0 to 9 do begin + glVertex2f(Left, Top + Count * Space); + glVertex2f(Right, Top + Count * Space); + end; + glEnd; + glDisable(GL_BLEND); +end; + +procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer); +var + Count: integer; + TempR: real; +begin + TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); + glEnable(GL_BLEND); + glBegin(GL_LINES); + for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do begin + if (Count mod Lines[NrLines].Resolution) = Lines[NrLines].NotesGAP then + glColor4f(0, 0, 0, 1) + else + glColor4f(0, 0, 0, 0.3); + glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top); + glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top + 135); + end; + glEnd; + glDisable(GL_BLEND); +end; + +// draw blank Notebars +procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); +var + Rec: TRecR; + Count: integer; + TempR: real; + R,G,B: real; + + PlayerNumber: Integer; + + GoldenStarPos : real; + + lTmpA , + lTmpB : real; +begin +// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it's always set to zero +// So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero +// This could also come quite in handy when we do the duet mode, cause just the notes for the player that has to sing should be drawn then +// BUT this is not implemented yet, all notes are drawn! :D + + PlayerNumber := NrLines + 1; // Player 1 is 0 + NrLines := 0; + +// exploit done + + glColor3f(1, 1, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + lTmpA := (Right-Left); + lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); + + if ( lTmpA > 0 ) AND + ( lTmpB > 0 ) THEN + begin + TempR := lTmpA / lTmpB; + end + else + begin + TempR := 0; + end; + + + with Lines[NrLines].Line[Lines[NrLines].Current] do begin + for Count := 0 to HighNote do begin + with Note[Count] do begin + if NoteType <> ntFreestyle then begin + + + if Ini.EffectSing = 0 then + // If Golden note Effect of then Change not Color + begin + case NoteType of + ntNormal: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + ntGolden: glColor4f(1, 1, 0.3, 1); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); - we could + end; // case + end //Else all Notes same Color + else + glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + // Czesci == teil, element == piece, element | koniec == end / ending + // lewa czesc - left part + Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; + Rec.Bottom := Rec.Top + 2 * NotesH; + glBindTexture(GL_TEXTURE_2D, Tex_plain_Left[PlayerNumber].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + //We keep the postion of the top left corner b4 it's overwritten + GoldenStarPos := Rec.Left; + //done + + // srodkowa czesc - middle part + Rec.Left := Rec.Right; + Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == length + + glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // prawa czesc - right part + Rec.Left := Rec.Right; + Rec.Right := Rec.Right + NotesW; + + glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // Golden Star Patch + if (NoteType = ntGolden) AND (Ini.EffectSing=1) then + begin + GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); + end; + + end; // if not FreeStyle + end; // with + end; // for + end; // with + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + + +// draw sung notes +procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer); +var + TempR: real; + Rec: TRecR; + N: integer; + R, G, B, A: real; + NotesH2: real; +begin + //Log.LogStatus('Player notes', 'SingDraw'); + + //if NrGracza = 0 then LoadColor(R, G, B, 'P1Light') + //else LoadColor(R, G, B, 'P2Light'); + + //R := 71/255; + //G := 175/255; + //B := 247/255; + + glColor3f(1, 1, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + //if Player[NrGracza].LengthNote > 0 then + begin + TempR := W / (Lines[0].Line[Lines[0].Current].End_ - Lines[0].Line[Lines[0].Current].Note[0].Start); + for N := 0 to Player[PlayerIndex].HighNote do + begin + with Player[PlayerIndex].Note[N] do + begin + // Left part of note + Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + + // Draw it in half size, if not hit + if Hit then + begin + NotesH2 := NotesH + end + else + begin + NotesH2 := int(NotesH * 0.65); + end; + + Rec.Top := Y - (Tone-Lines[0].Line[Lines[0].Current].BaseNote)*Space/2 - NotesH2; + Rec.Bottom := Rec.Top + 2 *NotesH2; + + // draw the left part + glColor3f(1, 1, 1); + glBindTexture(GL_TEXTURE_2D, Tex_Left[PlayerIndex+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // Middle part of the note + Rec.Left := Rec.Right; + Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX; + + // (nowe) - dunno + if (Start+Length-1 = LyricsState.CurrentBeatD) then + Rec.Right := Rec.Right - (1-Frac(LyricsState.MidBeatD)) * TempR; + // the left note is more right than the right note itself, sounds weird - so we fix that xD + if Rec.Right <= Rec.Left then + Rec.Right := Rec.Left; + + // draw the middle part + glBindTexture(GL_TEXTURE_2D, Tex_Mid[PlayerIndex+1].TexNum); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + glColor3f(1, 1, 1); + + // the right part of the note + Rec.Left := Rec.Right; + Rec.Right := Rec.Right + NotesW; + + glBindTexture(GL_TEXTURE_2D, Tex_Right[PlayerIndex+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // Perfect note is stored + if Perfect and (Ini.EffectSing=1) then + begin + A := 1 - 2*(LyricsState.GetCurrentTime() - GetTimeFromBeat(Start+Length)); + if not (Start+Length-1 = LyricsState.CurrentBeatD) then + begin + //Star animation counter + //inc(Starfr); + //Starfr := Starfr mod 128; + GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); + end; + end; + end; // with + end; // for + + // actually we need a comparison here, to determine if the singing process + // is ahead Rec.Right even if there is no singing + + if (Ini.EffectSing = 1) then + GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, PlayerIndex); + end; // if +end; + +//draw Note glow +procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer); +var + Rec: TRecR; + Count: integer; + TempR: real; + R,G,B: real; + X1, X2, X3, X4: real; + W, H: real; + + lTmpA , + lTmpB : real; +begin + if (Player[PlayerIndex].ScoreTotalInt >= 0) then + begin + glColor4f(1, 1, 1, sqrt((1+sin( AudioPlayback.Position * 3))/4)/ 2 + 0.5 ); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + lTmpA := (Right-Left); + lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); + + if ( lTmpA > 0 ) and + ( lTmpB > 0 ) then + begin + TempR := lTmpA / lTmpB; + end + else + begin + TempR := 0; + end; + + with Lines[NrLines].Line[Lines[NrLines].Current] do + begin + for Count := 0 to HighNote do + begin + with Note[Count] do + begin + if NoteType <> ntFreestyle then + begin + // begin: 14, 20 + // easy: 6, 11 + W := NotesW * 2 + 2; + H := NotesH * 1.5 + 3.5; + + X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie + X1 := X2-W; + + X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie + X4 := X3+W; + + // left + Rec.Left := X1; + Rec.Right := X2; + Rec.Top := Top - (Tone-BaseNote)*Space/2 - H; + Rec.Bottom := Rec.Top + 2 * H; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[PlayerIndex+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // srodkowa czesc + Rec.Left := X2; + Rec.Right := X3; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[PlayerIndex+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // prawa czesc + Rec.Left := X3; + Rec.Right := X4; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[PlayerIndex+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + end; // if not FreeStyle + end; // with + end; // for + end; // with + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; +end; + +(** + * Draws the lyrics helper bar. + * Left: position the bar starts at + * LyricsMid: the middle of the lyrics relative to the position Left + *) +procedure SingDrawLyricHelper(Left, LyricsMid: real); +var + Bounds: TRecR; // bounds of the lyric help bar + BarProgress: real; // progress of the lyrics helper + BarMoveDelta: real; // current beat relative to the beat the bar starts to move at + BarAlpha: real; // transparency + CurLine: PLine; // current lyric line (beat specific) + LineWidth: real; // lyric line width + FirstNoteBeat: integer; // beat of the first note in the current line + FirstNoteDelta: integer; // time in beats between the start of the current line and its first note + MoveStartX: real; // x-pos. the bar starts to move from + MoveDist: real; // number of pixels the bar will move + LyricEngine: TLyricEngine; +const + BarWidth = 50; // width of the lyric helper bar + BarHeight = 30; // height of the lyric helper bar + BarMoveLimit = 40; // max. number of beats remaining before the bar starts to move +begin + // get current lyrics line and the time in beats of its first note + CurLine := @Lines[0].Line[Lines[0].Current]; + + // FIXME: accessing ScreenSing is not that generic + LyricEngine := ScreenSing.Lyrics; + + // do not draw the lyrics helper if the current line does not contain any note + if (Length(CurLine.Note) > 0) then + begin + // start beat of the first note of this line + FirstNoteBeat := CurLine.Note[0].Start; + // time in beats between the start of the current line and its first note + FirstNoteDelta := FirstNoteBeat - CurLine.Start; + + // beats from current beat to the first note of the line + BarMoveDelta := FirstNoteBeat - LyricsState.MidBeat; + + if (FirstNoteDelta > 8) and // if the wait-time is large enough + (BarMoveDelta > 0) then // and the first note of the line is not reached + begin + // let the bar blink to the beat + BarAlpha := 0.75 + cos(BarMoveDelta/2) * 0.25; + + // if the number of beats to the first note is too big, + // the bar stays on the left side. + if (BarMoveDelta > BarMoveLimit) then + BarMoveDelta := BarMoveLimit; + + // limit number of beats the bar moves + if (FirstNoteDelta > BarMoveLimit) then + FirstNoteDelta := BarMoveLimit; + + // calc bar progress + BarProgress := 1 - BarMoveDelta / FirstNoteDelta; + + // retrieve the width of the upper lyrics line on the display + if (LyricEngine.GetUpperLine() <> nil) then + LineWidth := LyricEngine.GetUpperLine().Width + else + LineWidth := 0; + + // distance the bar will move (LyricRec.Left to beginning of text) + MoveDist := LyricsMid - LineWidth / 2 - BarWidth; + // if the line is too long the helper might move from right to left + // so we have to assure the start position is left of the text. + if (MoveDist >= 0) then + MoveStartX := Left + else + MoveStartX := Left + MoveDist; + + // determine lyric help bar position and size + Bounds.Left := MoveStartX + BarProgress * MoveDist; + Bounds.Right := Bounds.Left + BarWidth; + Bounds.Top := Skin_LyricsT + 3; + Bounds.Bottom := Bounds.Top + BarHeight + 3; + + // draw lyric help bar + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glColor4f(1, 1, 1, BarAlpha); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Bounds.Left, Bounds.Top); + glTexCoord2f(0, 1); glVertex2f(Bounds.Left, Bounds.Bottom); + glTexCoord2f(1, 1); glVertex2f(Bounds.Right, Bounds.Bottom); + glTexCoord2f(1, 0); glVertex2f(Bounds.Right, Bounds.Top); + glEnd; + glDisable(GL_BLEND); + end; + end; +end; + +procedure SingDraw; +var + NR: TRecR; // lyrics area bounds (NR = NoteRec?) + LyricEngine: TLyricEngine; +begin + // positions + if Ini.SingWindow = 0 then + NR.Left := 120 + else + NR.Left := 20; + + NR.Right := 780; + + NR.Width := NR.Right - NR.Left; + NR.WMid := NR.Width / 2; + NR.Mid := NR.Left + NR.WMid; + + // FIXME: accessing ScreenSing is not that generic + LyricEngine := ScreenSing.Lyrics; + + // background //BG Fullsize Mod + //SingDrawBackground; + + // draw time-bar + SingDrawTimeBar(); + + // draw note-lines + + if (PlayersPlay = 1) and (Ini.NoteLines = 1) then + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + + if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then + begin + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + end; + + if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin + SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); + SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); + SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); + end; + + // draw Lyrics + LyricEngine.Draw(LyricsState.MidBeat); + SingDrawLyricHelper(NR.Left, NR.WMid); + + // oscilloscope + if Ini.Oscilloscope = 1 then begin + if PlayersPlay = 1 then + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + + if PlayersPlay = 2 then begin + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); + end; + if ScreenAct = 2 then begin + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3); + end; + end; + + if PlayersPlay = 3 then begin + SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); + end; + if ScreenAct = 2 then begin + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4); + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5); + end; + end; + + end; + + // Set the note heights according to the difficulty level + case Ini.Difficulty of + 0: + begin + NotesH := 11; // 9 + NotesW := 6; // 5 + end; + 1: + begin + NotesH := 8; // 7 + NotesW := 4; // 4 + end; + 2: + begin + NotesH := 5; + NotesW := 3; + end; + end; + + // Draw the Notes + if PlayersPlay = 1 then begin + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes + end; + + if (PlayersPlay = 2) then begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + + SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + + if PlayersPlay = 3 then begin + NotesW := NotesW * 0.8; + NotesH := NotesH * 0.8; + + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + + SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); + end; + end; + + if PlayersPlay = 6 then begin + NotesW := NotesW * 0.8; + NotesH := NotesH * 0.8; + + if ScreenAct = 1 then begin + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); + SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); + SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); + end; + end; + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + +// q'n'd for using the game mode dll's +procedure SingModiDraw (PlayerInfo: TPlayerInfo); +var + Count: integer; + Pet2: integer; + TempR: real; + Rec: TRecR; + TexRec: TRecR; + NR: TRecR; + FS: real; + BarFrom: integer; + BarAlpha: real; + BarWspol: real; + TempCol: real; + Tekst: string; + PetCz: integer; +begin + // positions + if Ini.SingWindow = 0 then begin + NR.Left := 120; + end else begin + NR.Left := 20; + end; + + NR.Right := 780; + NR.Width := NR.Right - NR.Left; + NR.WMid := NR.Width / 2; + NR.Mid := NR.Left + NR.WMid; + + // time bar + SingDrawTimeBar(); + + if DLLMan.Selected.ShowNotes then + begin + if PlayersPlay = 1 then + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + if (PlayersPlay = 2) or (PlayersPlay = 4) then begin + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + end; + + if (PlayersPlay = 3) or (PlayersPlay = 6) then begin + SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); + SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); + SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); + end; + end; + + // Draw Lyrics + ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat); + + // todo: Lyrics +{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start; + if BarFrom > 40 then BarFrom := 40; + if (Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat > 0) and // przed tekstem + (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (LyricsState.MidBeat - (Lines[0].Line[Lines[0].Current].StartNote - BarFrom)) / BarFrom; + Rec.Left := NR.Left + BarWspol * (ScreenSingModi.LyricMain.ClientX - NR.Left - 50) + 10*ScreenX; + Rec.Right := Rec.Left + 50; + Rec.Top := Skin_LyricsT + 3; + Rec.Bottom := Rec.Top + 33;//SingScreen.LyricMain.Size * 3; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); + glBegin(GL_QUADS); + glColor4f(1, 1, 1, 0); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glColor4f(1, 1, 1, 0.5); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + glDisable(GL_BLEND); + end; + } + + // oscilloscope | the thing that moves when you yell into your mic (imho) + if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then begin + if PlayersPlay = 1 then + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + + if PlayersPlay = 2 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3); + end; + end; + + if PlayersPlay = 3 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); + if PlayerInfo.Playerinfo[4].Enabled then + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4); + if PlayerInfo.Playerinfo[5].Enabled then + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5); + end; + end; + + end; + +// resize the notes according to the difficulty level + case Ini.Difficulty of + 0: + begin + NotesH := 11; // 9 + NotesW := 6; // 5 + end; + 1: + begin + NotesH := 8; // 7 + NotesW := 4; // 4 + end; + 2: + begin + NotesH := 5; + NotesW := 3; + end; + end; + + if (DLLMAn.Selected.ShowNotes And DLLMan.Selected.LoadSong) then + begin + if (PlayersPlay = 1) And PlayerInfo.Playerinfo[0].Enabled then begin + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + end; + + if (PlayersPlay = 2) then begin + if PlayerInfo.Playerinfo[0].Enabled then + begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + end; + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + + end; + + if PlayersPlay = 3 then begin + NotesW := NotesW * 0.8; + NotesH := NotesH * 0.8; + + if PlayerInfo.Playerinfo[0].Enabled then + begin + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + end; + + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + end; + + if PlayerInfo.Playerinfo[2].Enabled then + begin + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + + if ScreenAct = 1 then begin + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); + end; + end; + + if PlayersPlay = 6 then begin + NotesW := NotesW * 0.8; + NotesH := NotesH * 0.8; + + if ScreenAct = 1 then begin + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + + if ScreenAct = 1 then begin + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); + end; + end; + end; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + + +{//SingBar Mod +procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); +var + R: Real; + G: Real; + B: Real; + A: cardinal; + I: Integer; + +begin; + + //SingBar Background + glColor4f(1, 1, 1, 0.8); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Back.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y+H); + glTexCoord2f(1, 1); glVertex2f(X+W, Y+H); + glTexCoord2f(1, 0); glVertex2f(X+W, Y); + glEnd; + + //SingBar coloured Bar + Case Percent of + 0..22: begin + R := 1; + G := 0; + B := 0; + end; + 23..42: begin + R := 1; + G := ((Percent-23)/100)*5; + B := 0; + end; + 43..57: begin + R := 1; + G := 1; + B := 0; + end; + 58..77: begin + R := 1-(Percent - 58)/100*5; + G := 1; + B := 0; + end; + 78..99: begin + R := 0; + G := 1; + B := 0; + end; + End; //Case + + glColor4f(R, G, B, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Bar.TexNum); + //Size= Player[PlayerNum].ScorePercent of W + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y+H); + glTexCoord2f(1, 1); glVertex2f(X+(W/100 * (Percent +1)), Y+H); + glTexCoord2f(1, 0); glVertex2f(X+(W/100 * (Percent +1)), Y); + glEnd; + + //SingBar Front + glColor4f(1, 1, 1, 0.6); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Front.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y+H); + glTexCoord2f(1, 1); glVertex2f(X+W, Y+H); + glTexCoord2f(1, 0); glVertex2f(X+W, Y); + glEnd; +end; +//end Singbar Mod + +//PhrasenBonus - Line Bonus Pop Up +procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); +var +Length, X2: Real; //Length of Text +Size: Integer; //Size of Popup +begin +if Alpha <> 0 then +begin + +//Set Font Propertys +SetFontStyle(2); //Font: Outlined1 +if Age < 5 then SetFontSize(Age + 1) else SetFontSize(6); +SetFontItalic(False); + +//Check Font Size +Length := glTextWidth ( PChar(Text)) + 3; //Little Space for a Better Look ^^ + +//Text +SetFontPos (X + 50 - (Length / 2), Y + 12); //Position + + +if Age < 5 then Size := Age * 10 else Size := 50; + + //Draw Background + //glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color + glColor4f(1, 1, 1, Alpha); + + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + //glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + + //New Method, Not Variable + glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); + glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2)); + glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2)); + glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2)); + glEnd; + + glColor4f(1, 1, 1, Alpha); //Set Color + //Draw Text + glPrint (PChar(Text)); +end; +end; +//PhrasenBonus - Line Bonus Mod} + +// Draw Note Bars for Editor +//There are 11 Resons for a new Procdedure: (nice binary :D ) +// 1. It don't look good when you Draw the Golden Note Star Effect in the Editor +// 2. You can see the Freestyle Notes in the Editor SemiTransparent +// 3. Its easier and Faster then changing the old Procedure +procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); +var + Rec: TRecR; + Count: integer; + TempR: real; +begin + glColor3f(1, 1, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); + with Lines[NrLines].Line[Lines[NrLines].Current] do begin + for Count := 0 to HighNote do begin + with Note[Count] do begin + + // Golden Note Patch + case NoteType of + ntFreestyle: glColor4f(1, 1, 1, 0.35); + ntNormal: glColor4f(1, 1, 1, 0.85); + ntGolden: Glcolor4f(1, 1, 0.3, 0.85); + end; // case + + + + // lewa czesc - left part + Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; + Rec.Bottom := Rec.Top + 2 * NotesH; + glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // srodkowa czesc - middle part + Rec.Left := Rec.Right; + Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; + + glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // prawa czesc - right part + Rec.Left := Rec.Right; + Rec.Right := Rec.Right + NotesW; + + glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + end; // with + end; // for + end; // with + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + +procedure SingDrawTimeBar(); +var + x,y: real; + width, height: real; + LyricsProgress: real; + CurLyricsTime: real; +begin + x := Theme.Sing.StaticTimeProgress.x; + y := Theme.Sing.StaticTimeProgress.y; + + width := Theme.Sing.StaticTimeProgress.w; + height := Theme.Sing.StaticTimeProgress.h; + + glColor4f(Theme.Sing.StaticTimeProgress.ColR, + Theme.Sing.StaticTimeProgress.ColG, + Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + + glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(x, y); + + CurLyricsTime := LyricsState.GetCurrentTime(); + if (CurLyricsTime > 0) and + (LyricsState.TotalTime > 0) then + begin + LyricsProgress := CurLyricsTime / LyricsState.TotalTime; + glTexCoord2f((width * LyricsProgress) / 8, 0); + glVertex2f(x + width * LyricsProgress, y); + + glTexCoord2f((width * LyricsProgress) / 8, 1); + glVertex2f(x + width * LyricsProgress, y + height); + end; + + glTexCoord2f(0, 1); + glVertex2f(x, y + height); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + glcolor4f(1, 1, 1, 1); +end; + +end. + diff --git a/src/classes0/UEditorLyrics.pas b/src/classes0/UEditorLyrics.pas new file mode 100644 index 00000000..25e8423e --- /dev/null +++ b/src/classes0/UEditorLyrics.pas @@ -0,0 +1,229 @@ +unit UEditorLyrics; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + gl, + UMusic, + UTexture; + +type + TWord = record + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; + end; + + TEditorLyrics = class + private + AlignI: integer; + XR: real; + YR: real; + SizeR: real; + SelectedI: integer; + FontStyleI: integer; // font number + Word: array of TWord; + + 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 SetFStyle(Value: integer); + procedure AddWord(Text: string); + procedure Refresh; + public + ColR: real; + ColG: real; + ColB: real; + ColSR: real; + ColSG: real; + ColSB: real; + Italic: boolean; + + constructor Create; + destructor Destroy; override; + + procedure AddLine(NrLine: integer); + + 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 FontStyle: integer write SetFStyle; + end; + +implementation + +uses + TextGL, UGraphic, UDrawTexture, Math, USkins; + +constructor TEditorLyrics.Create; +begin + inherited; +end; + +destructor TEditorLyrics.Destroy; +begin + SetLength(Word, 0); + inherited; +end; + +procedure TEditorLyrics.SetX(Value: real); +begin + XR := Value; +end; + +procedure TEditorLyrics.SetY(Value: real); +begin + YR := Value; +end; + +function TEditorLyrics.GetClientX: real; +begin + Result := Word[0].X; +end; + +procedure TEditorLyrics.SetAlign(Value: integer); +begin + AlignI := Value; +end; + +function TEditorLyrics.GetSize: real; +begin + Result := SizeR; +end; + +procedure TEditorLyrics.SetSize(Value: real); +begin + SizeR := Value; +end; + +procedure TEditorLyrics.SetSelected(Value: integer); +var + W: integer; +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; + 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; + end; + + Refresh; +end; + +procedure TEditorLyrics.SetFStyle(Value: integer); +begin + FontStyleI := Value; +end; + +procedure TEditorLyrics.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; + 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].Italic := Italic; + + Refresh; +end; + +procedure TEditorLyrics.AddLine(NrLine: integer); +var + N: integer; +begin + Clear; + for N := 0 to Lines[0].Line[NrLine].HighNote do begin + Italic := Lines[0].Line[NrLine].Note[N].NoteType = ntFreestyle; + AddWord(Lines[0].Line[NrLine].Note[N].Text); + end; + Selected := -1; +end; + +procedure TEditorLyrics.Clear; +begin + SetLength(Word, 0); + SelectedI := -1; +end; + +procedure TEditorLyrics.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 TEditorLyrics.Draw; +var + W: integer; +begin + for W := 0 to High(Word) do + 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; +end; + +end. diff --git a/src/classes0/UFiles.pas b/src/classes0/UFiles.pas new file mode 100644 index 00000000..ca43bb21 --- /dev/null +++ b/src/classes0/UFiles.pas @@ -0,0 +1,150 @@ +unit UFiles; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} +{$I switches.inc} + +uses SysUtils, + ULog, + UMusic, + USongs, + USong; + +procedure ResetSingTemp; +function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean; + +var + SongFile: TextFile; // all procedures in this unit operates on this file + FileLineNo: integer; //Line which is readed at Last, for error reporting + + // variables available for all procedures + Base : array[0..1] of integer; + Rel : array[0..1] of integer; + Mult : integer = 1; + MultBPM : integer = 4; + +implementation + +uses TextGL, + UIni, + UPlatform, + UMain; + +//-------------------- +// Resets the temporary Sentence Arrays for each Player and some other Variables +//-------------------- +procedure ResetSingTemp; +var + Count: integer; +begin + SetLength(Lines, Length(Player)); + for Count := 0 to High(Player) do begin + SetLength(Lines[Count].Line, 1); + SetLength(Lines[Count].Line[0].Note, 0); + Lines[Count].Line[0].Lyric := ''; + Lines[Count].Line[0].LyricWidth := 0; + Player[Count].Score := 0; + Player[Count].LengthNote := 0; + Player[Count].HighNote := -1; + end; + + (* FIXME + //Reset Path and Filename Values to Prevent Errors in Editor + if assigned( CurrentSong ) then + begin + SetLength(CurrentSong.BPM, 0); + CurrentSong.Path := ''; + CurrentSong.FileName := ''; + end; + *) + +// CurrentSong := nil; +end; + + +//-------------------- +// Saves a Song +//-------------------- +function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean; +var + C: integer; + N: integer; + S: string; + B: integer; + RelativeSubTime: integer; + NoteState: String; + +begin +// Relative := true; // override (idea - use shift+S to save with relative) + AssignFile(SongFile, Name); + Rewrite(SongFile); + + Writeln(SongFile, '#TITLE:' + Song.Title + ''); + Writeln(SongFile, '#ARTIST:' + Song.Artist); + + if Song.Creator <> '' then Writeln(SongFile, '#CREATOR:' + Song.Creator); + if Song.Edition <> 'Unknown' then Writeln(SongFile, '#EDITION:' + Song.Edition); + if Song.Genre <> 'Unknown' then Writeln(SongFile, '#GENRE:' + Song.Genre); + if Song.Language <> 'Unknown' then Writeln(SongFile, '#LANGUAGE:' + Song.Language); + + Writeln(SongFile, '#MP3:' + Song.Mp3); + + if Song.Cover <> '' then Writeln(SongFile, '#COVER:' + Song.Cover); + if Song.Background <> '' then Writeln(SongFile, '#BACKGROUND:' + Song.Background); + if Song.Video <> '' then Writeln(SongFile, '#VIDEO:' + Song.Video); + if Song.VideoGAP <> 0 then Writeln(SongFile, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP)); + if Song.Resolution <> 4 then Writeln(SongFile, '#RESOLUTION:' + IntToStr(Song.Resolution)); + if Song.NotesGAP <> 0 then Writeln(SongFile, '#NOTESGAP:' + IntToStr(Song.NotesGAP)); + if Song.Start <> 0 then Writeln(SongFile, '#START:' + FloatToStr(Song.Start)); + if Song.Finish <> 0 then Writeln(SongFile, '#END:' + IntToStr(Song.Finish)); + if Relative then Writeln(SongFile, '#RELATIVE:yes'); + + Writeln(SongFile, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4)); + Writeln(SongFile, '#GAP:' + FloatToStr(Song.GAP)); + + RelativeSubTime := 0; + for B := 1 to High(CurrentSong.BPM) do + Writeln(SongFile, 'B ' + FloatToStr(CurrentSong.BPM[B].StartBeat) + ' ' + FloatToStr(CurrentSong.BPM[B].BPM/4)); + + for C := 0 to Lines.High do begin + for N := 0 to Lines.Line[C].HighNote do begin + with Lines.Line[C].Note[N] do begin + + + //Golden + Freestyle Note Patch + case Lines.Line[C].Note[N].NoteType of + ntFreestyle: NoteState := 'F '; + ntNormal: NoteState := ': '; + ntGolden: NoteState := '* '; + end; // case + S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Length) + ' ' + IntToStr(Tone) + ' ' + Text; + + + Writeln(SongFile, S); + end; // with + end; // N + + if C < Lines.High then begin // don't write end of last sentence + if not Relative then + S := '- ' + IntToStr(Lines.Line[C+1].Start) + else begin + S := '- ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime) + + ' ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime); + RelativeSubTime := Lines.Line[C+1].Start; + end; + Writeln(SongFile, S); + end; + + end; // C + + + Writeln(SongFile, 'E'); + CloseFile(SongFile); + + Result := true; +end; + +end. diff --git a/src/classes0/UGraphic.pas b/src/classes0/UGraphic.pas new file mode 100644 index 00000000..2432503c --- /dev/null +++ b/src/classes0/UGraphic.pas @@ -0,0 +1,760 @@ +unit UGraphic; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + gl, + glext, + UTexture, + TextGL, + ULog, + SysUtils, + ULyrics, + UImage, + UMusic, + UScreenLoading, + UScreenWelcome, + UScreenMain, + UScreenName, + UScreenLevel, + UScreenOptions, + UScreenOptionsGame, + UScreenOptionsGraphics, + UScreenOptionsSound, + UScreenOptionsLyrics, + UScreenOptionsThemes, + UScreenOptionsRecord, + UScreenOptionsAdvanced, + UScreenSong, + UScreenSing, + UScreenScore, + UScreenTop5, + UScreenEditSub, + UScreenEdit, + UScreenEditConvert, + UScreenEditHeader, + UScreenOpen, + UThemes, + USkins, + UScreenSongMenu, + UScreenSongJumpto, + {Party Screens} + UScreenSingModi, + UScreenPartyNewRound, + UScreenPartyScore, + UScreenPartyOptions, + UScreenPartyWin, + UScreenPartyPlayer, + {Stats Screens} + UScreenStatMain, + UScreenStatDetail, + {CreditsScreen} + UScreenCredits, + {Popup for errors, etc.} + UScreenPopup; + +type + TRecR = record + Top: real; + Left: real; + Right: real; + Bottom: real; + end; + +var + Screen: PSDL_Surface; + LoadingThread: PSDL_Thread; + Mutex: PSDL_Mutex; + + RenderW: integer; + RenderH: integer; + ScreenW: integer; + ScreenH: integer; + Screens: integer; + ScreenAct: integer; + ScreenX: integer; + + ScreenLoading: TScreenLoading; + ScreenWelcome: TScreenWelcome; + ScreenMain: TScreenMain; + ScreenName: TScreenName; + ScreenLevel: TScreenLevel; + ScreenSong: TScreenSong; + ScreenSing: TScreenSing; + ScreenScore: TScreenScore; + ScreenTop5: TScreenTop5; + ScreenOptions: TScreenOptions; + ScreenOptionsGame: TScreenOptionsGame; + ScreenOptionsGraphics: TScreenOptionsGraphics; + ScreenOptionsSound: TScreenOptionsSound; + ScreenOptionsLyrics: TScreenOptionsLyrics; + ScreenOptionsThemes: TScreenOptionsThemes; + ScreenOptionsRecord: TScreenOptionsRecord; + ScreenOptionsAdvanced: TScreenOptionsAdvanced; + ScreenEditSub: TScreenEditSub; + ScreenEdit: TScreenEdit; + ScreenEditConvert: TScreenEditConvert; + ScreenEditHeader: TScreenEditHeader; + ScreenOpen: TScreenOpen; + + ScreenSongMenu: TScreenSongMenu; + ScreenSongJumpto: TScreenSongJumpto; + + //Party Screens + ScreenSingModi: TScreenSingModi; + ScreenPartyNewRound: TScreenPartyNewRound; + ScreenPartyScore: TScreenPartyScore; + ScreenPartyWin: TScreenPartyWin; + ScreenPartyOptions: TScreenPartyOptions; + ScreenPartyPlayer: TScreenPartyPlayer; + + //StatsScreens + ScreenStatMain: TScreenStatMain; + ScreenStatDetail: TScreenStatDetail; + + //CreditsScreen + ScreenCredits: TScreenCredits; + + //popup mod + ScreenPopupCheck: TScreenPopupCheck; + ScreenPopupError: TScreenPopupError; + + //Notes + Tex_Left: array[0..6] of TTexture; //rename to tex_note_left + Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid + Tex_Right: array[0..6] of TTexture; //rename to tex_note_right + + Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left + Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid + Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right + + Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left + Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid + Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right + + Tex_Note_Star: TTexture; + Tex_Note_Perfect_Star: TTexture; + + + Tex_Ball: TTexture; + Tex_Lyric_Help_Bar: TTexture; + FullScreen: boolean; + + Tex_TimeProgress: TTexture; + + //Sing Bar Mod + Tex_SingBar_Back: TTexture; + Tex_SingBar_Bar: TTexture; + Tex_SingBar_Front: TTexture; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + Tex_SingLineBonusBack: array[0..8] of TTexture; + //End PhrasenBonus - Line Bonus Mod + + //ScoreBG Texs + Tex_ScoreBG: array [0..5] of TTexture; + + //Score Screen Textures + Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture; + + Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Light : array [1..6] of TTexture; + + Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture; + + Tex_Score_Ratings : array [0..7] of TTexture; + +const + Skin_BGColorR = 1; + Skin_BGColorG = 1; + Skin_BGColorB = 1; + + Skin_SpectrumR = 0; + Skin_SpectrumG = 0; + Skin_SpectrumB = 0; + + Skin_Spectograph1R = 0.6; + Skin_Spectograph1G = 0.8; + Skin_Spectograph1B = 1; + + Skin_Spectograph2R = 0; + Skin_Spectograph2G = 0; + Skin_Spectograph2B = 0.2; + + Skin_SzczytR = 0.8; + Skin_SzczytG = 0; + Skin_SzczytB = 0; + + Skin_SzczytLimitR = 0; + Skin_SzczytLimitG = 0.8; + Skin_SzczytLimitB = 0; + + Skin_FontR = 0; + Skin_FontG = 0; + Skin_FontB = 0; + + Skin_FontHighlightR = 0.3; // 0.3 + Skin_FontHighlightG = 0.3; // 0.3 + Skin_FontHighlightB = 1; // 1 + + Skin_TimeR = 0.25; //0,0,0 + Skin_TimeG = 0.25; + Skin_TimeB = 0.25; + + Skin_OscR = 0; + Skin_OscG = 0; + Skin_OscB = 0; + + Skin_LyricsT = 494; // 500 / 510 / 400 + Skin_SpectrumT = 470; + Skin_SpectrumBot = 570; + Skin_SpectrumH = 100; + + Skin_P1_LinesR = 0.5; // 0.6 0.6 1 + Skin_P1_LinesG = 0.5; + Skin_P1_LinesB = 0.5; + + Skin_P2_LinesR = 0.5; // 1 0.6 0.6 + Skin_P2_LinesG = 0.5; + Skin_P2_LinesB = 0.5; + + Skin_P1_NotesB = 250; + Skin_P2_NotesB = 430; // 430 / 300 + + Skin_P1_ScoreT = 50; + Skin_P1_ScoreL = 20; + + Skin_P2_ScoreT = 50; + Skin_P2_ScoreL = 640; + +procedure Initialize3D (Title: string); +procedure Reinitialize3D; +procedure SwapBuffers; + +procedure LoadTextures; +procedure InitializeScreen; +procedure LoadLoadingScreen; +procedure LoadScreens; +procedure UnLoadScreens; + +function LoadingThreadFunction: integer; + + +implementation + +uses + UMain, + UIni, + UDisplay, + UCommandLine, + Classes; + +procedure LoadFontTextures; +begin + Log.LogStatus('Building Fonts', 'LoadTextures'); + BuildFont; +end; + +procedure LoadTextures; + + +var + P: integer; + R, G, B: real; + Col: integer; +begin + // zaladowanie tekstur + Log.LogStatus('Loading Textures', 'LoadTextures'); + + Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch? + Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); //brauch man die noch? + Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch? + + Log.LogStatus('Loading Textures - A', 'LoadTextures'); + + // P1-6 + // TODO... do it once for each player... this is a bit crappy !! + // can we make it any better !? + for P := 1 to 6 do + begin + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + + Tex_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_COLORIZED, Col); + Tex_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_COLORIZED, Col); + Tex_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_COLORIZED, Col); + + Tex_plain_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainLeft'), TEXTURE_TYPE_COLORIZED, Col); + Tex_plain_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainMid'), TEXTURE_TYPE_COLORIZED, Col); + Tex_plain_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainRight'), TEXTURE_TYPE_COLORIZED, Col); + + Tex_BG_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGLeft'), TEXTURE_TYPE_COLORIZED, Col); + Tex_BG_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGMid'), TEXTURE_TYPE_COLORIZED, Col); + Tex_BG_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGRight'), TEXTURE_TYPE_COLORIZED, Col); + end; + + Log.LogStatus('Loading Textures - B', 'LoadTextures'); + + Tex_Note_Perfect_Star := Texture.LoadTexture(Skin.GetTextureFileName('NotePerfectStar'), TEXTURE_TYPE_TRANSPARENT, 0); + Tex_Note_Star := Texture.LoadTexture(Skin.GetTextureFileName('NoteStar') , TEXTURE_TYPE_TRANSPARENT, $FFFFFF); + Tex_Ball := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); + Tex_Lyric_Help_Bar := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); + + + //TimeBar mod + Tex_TimeProgress := Texture.LoadTexture(Skin.GetTextureFileName('TimeBar')); + //eoa TimeBar mod + + //SingBar Mod + Tex_SingBar_Back := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBack'), TEXTURE_TYPE_PLAIN, 0); + Tex_SingBar_Bar := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBar'), TEXTURE_TYPE_PLAIN, 0); + Tex_SingBar_Front := Texture.LoadTexture(Skin.GetTextureFileName('SingBarFront'), TEXTURE_TYPE_PLAIN, 0); + //end Singbar Mod + + Log.LogStatus('Loading Textures - C', 'LoadTextures'); + + //Line Bonus PopUp + for P := 0 to 8 do + begin + Case P of + 0: begin + R := 1; + G := 0; + B := 0; + end; + 1..3: begin + R := 1; + G := (P * 0.25); + B := 0; + end; + 4: begin + R := 1; + G := 1; + B := 0; + end; + 5..7: begin + R := 1-((P-4)*0.25); + G := 1; + B := 0; + end; + 8: begin + R := 0; + G := 1; + B := 0; + end; + End; + + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), TEXTURE_TYPE_COLORIZED, Col); + end; + +//## backgrounds for the scores ## + for P := 0 to 5 do begin + LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), TEXTURE_TYPE_COLORIZED, Col); + end; + + + Log.LogStatus('Loading Textures - D', 'LoadTextures'); + +// ###################### +// Score screen textures +// ###################### + +//## the bars that visualize the score ## + for P := 1 to 6 do begin +//NoteBar ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), TEXTURE_TYPE_COLORIZED, Col); +//LineBonus ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), TEXTURE_TYPE_COLORIZED, Col); +//GoldenNotes ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), TEXTURE_TYPE_COLORIZED, Col); + end; + +//## rating pictures that show a picture according to your rate ## + for P := 0 to 7 do begin + Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), TEXTURE_TYPE_TRANSPARENT, 0); + end; + + Log.LogStatus('Loading Textures - Done', 'LoadTextures'); +end; + +(* + * Load OpenGL extensions. Must be called after SDL_SetVideoMode() and each + * time the pixel-format or render-context (RC) changes. + *) +procedure LoadOpenGLExtensions; +begin + // Load OpenGL 1.2 extensions for OpenGL 1.2 compatibility + if (not Load_GL_version_1_2()) then + begin + Log.LogCritical('Failed loading OpenGL 1.2', 'UGraphic.Initialize3D'); + end; + + // Other extensions e.g. OpenGL 1.3-2.0 or Framebuffer-Object might be loaded here + // ... + //Load_GL_EXT_framebuffer_object(); +end; + +procedure Initialize3D (Title: string); +var + Icon: PSDL_Surface; +begin + Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); + if ( SDL_InitSubSystem(SDL_INIT_VIDEO) = -1 ) then + begin + Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); + exit; + end; + + // load icon image (must be 32x32 for win32) + Icon := LoadImage('WINDOWICON'); + if (Icon <> nil) then + SDL_WM_SetIcon(Icon, 0); + + SDL_WM_SetCaption(PChar(Title), nil); + + //Log.BenchmarkStart(2); + + InitializeScreen; + + //Log.BenchmarkEnd(2); + //Log.LogBenchmark('--> Setting Screen', 2); + + //Log.BenchmarkStart(2); + Texture := TTextureUnit.Create; + // FIXME: this does not seem to be correct as Limit is the max. of either + // width or height. + Texture.Limit := 1024*1024; + + //LoadTextures; + //Log.BenchmarkEnd(2); + //Log.LogBenchmark('--> Loading Textures', 2); + + { + Log.BenchmarkStart(2); + Lyric:= TLyric.Create; + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Fonts', 2); + } + + // Note: do not initialize video modules earlier. They might depend on some + // SDL video functions or OpenGL extensions initialized in InitializeScreen() + InitializeVideo(); + + //Log.BenchmarkStart(2); + + Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D'); + Display := TDisplay.Create; + + //Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); + + //Log.LogStatus('Loading Screens', 'Initialize3D'); + //Log.BenchmarkStart(3); + + Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D'); + LoadFontTextures(); + + // Show the Loading Screen ------------- + Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D'); + LoadLoadingScreen; + + + Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D'); + LoadTextures; // jb + + + + // now that we have something to display while loading, + // start thread that loads the rest of ultrastar + //Mutex := SDL_CreateMutex; + //SDL_UnLockMutex(Mutex); + + // does not work this way because the loading thread tries to access opengl. + // See comment below + //LoadingThread := SDL_CreateThread(@LoadingThread, nil); + + // this would be run in the loadingthread + Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D'); + LoadScreens; + + + // TODO: + // here should be a loop which + // * draws the loading screen (form time to time) + // * controlls the "process of the loading screen + // * checks if the loadingthread has loaded textures (check mutex) and + // * load the textures into opengl + // * tells the loadingthread, that the memory for the texture can be reused + // to load the netx texture (over another mutex) + // * runs as long as the loadingthread tells, that everything is loaded and ready (using a third mutex) + // + // therefor loadtexture have to be changed, that it, instat of caling some opengl functions + // for itself, it should change mutex + // the mainthread have to know somehow what opengl function have to be called with which parameters like + // texturetype, textureobjekt, textur-buffer-adress, ... + + // wait for loading thread to finish + // currently does not work this way + // SDL_WaitThread(LoadingThread, I); + // SDL_DestroyMutex(Mutex); + + Display.CurrentScreen^.FadeTo( @ScreenMain ); + + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Screens', 2); + + Log.LogStatus('Finish', 'Initialize3D'); +end; + +procedure SwapBuffers; +begin + SDL_GL_SwapBuffers; + glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, RenderW, RenderH, 0, -1, 100); + glMatrixMode(GL_MODELVIEW); +end; + +procedure Reinitialize3D; +begin + InitializeScreen; +end; + +procedure InitializeScreen; +var + S: string; + I: integer; + W, H: integer; + Depth: Integer; +begin + if (Params.Screens <> -1) then + Screens := Params.Screens + 1 + else + Screens := Ini.Screens + 1; + + SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); // Z-Buffer depth + SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); + + // VSYNC works for windows only at the moment. SDL_GL_SWAP_CONTROL under + // linux uses GLX_MESA_swap_control which is not supported by nvidea cards. + // Maybe use glXSwapIntervalSGI(1) from the GLX_SGI_swap_control extension instead. + //SDL_GL_SetAttribute(SDL_GL_SWAP_CONTROL, 1); // VSYNC (currently Windows only) + + // If there is a resolution in Parameters, use it, else use the Ini value + I := Params.Resolution; + if (I <> -1) then + S := IResolution[I] + else + S := IResolution[Ini.Resolution]; + + I := Pos('x', S); + W := StrToInt(Copy(S, 1, I-1)) * Screens; + H := StrToInt(Copy(S, I+1, 1000)); + + if (Params.Depth <> -1) then + Depth := Params.Depth + else + Depth := Ini.Depth; + + Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); + //SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); + + if (Ini.FullScreen = 0) and (Not Params.FullScreen) then + begin + Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed'); + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE) + end + else + begin + Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen'); + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN ); + SDL_ShowCursor(0); + end; + + if (screen = nil) then + begin + Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); + exit; + end; + + LoadOpenGLExtensions(); + + // define virtual (Render) and real (Screen) screen size + RenderW := 800; + RenderH := 600; + ScreenW := W; + ScreenH := H; + + // clear screen once window is being shown + // Note: SwapBuffers uses RenderW/H, so they must be defined before + glClearColor(1, 1, 1, 1); + glClear(GL_COLOR_BUFFER_BIT); + SwapBuffers; +end; + +procedure LoadLoadingScreen; +begin + ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + + Display.CurrentScreen := @ScreenLoading; + + swapbuffers; + + ScreenLoading.Draw; + Display.Draw; + + SwapBuffers; +end; + +procedure LoadScreens; +begin +{ ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + Display.CurrentScreen := @ScreenLoading; + ScreenLoading.Draw; + Display.Draw; + SwapBuffers; +} + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); +{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} + ScreenMain := TScreenMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); + ScreenName := TScreenName.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); + ScreenLevel := TScreenLevel.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); + ScreenSong := TScreenSong.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); + ScreenSing := TScreenSing.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); + ScreenScore := TScreenScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); + ScreenTop5 := TScreenTop5.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); + ScreenOptions := TScreenOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); + ScreenOptionsGame := TScreenOptionsGame.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); + ScreenOptionsGraphics := TScreenOptionsGraphics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); + ScreenOptionsSound := TScreenOptionsSound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); + ScreenOptionsLyrics := TScreenOptionsLyrics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); + ScreenOptionsThemes := TScreenOptionsThemes.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); + ScreenOptionsRecord := TScreenOptionsRecord.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); + ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); + ScreenEditSub := TScreenEditSub.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); + ScreenEdit := TScreenEdit.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); + ScreenEditConvert := TScreenEditConvert.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); +// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); +// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); + ScreenOpen := TScreenOpen.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); + ScreenSingModi := TScreenSingModi.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); + ScreenSongJumpto := TScreenSongJumpto.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); + ScreenPopupCheck := TScreenPopupCheck.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); + ScreenPopupError := TScreenPopupError.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); + ScreenPartyNewRound := TScreenPartyNewRound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); + ScreenPartyScore := TScreenPartyScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); + ScreenPartyWin := TScreenPartyWin.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); + ScreenPartyOptions := TScreenPartyOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); + ScreenPartyPlayer := TScreenPartyPlayer.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); + ScreenStatMain := TScreenStatMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); + ScreenStatDetail := TScreenStatDetail.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); + ScreenCredits := TScreenCredits.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); + +end; + +function LoadingThreadFunction: integer; +begin + LoadScreens; + Result:= 1; +end; + +procedure UnLoadScreens; +begin + freeandnil( ScreenMain ); + freeandnil( ScreenName ); + freeandnil( ScreenLevel); + freeandnil( ScreenSong ); + freeandnil( ScreenSongMenu ); + freeandnil( ScreenSing ); + freeandnil( ScreenScore); + freeandnil( ScreenTop5 ); + freeandnil( ScreenOptions ); + freeandnil( ScreenOptionsGame ); + freeandnil( ScreenOptionsGraphics ); + freeandnil( ScreenOptionsSound ); + freeandnil( ScreenOptionsLyrics ); +// freeandnil( ScreenOptionsThemes ); + freeandnil( ScreenOptionsRecord ); + freeandnil( ScreenOptionsAdvanced ); + freeandnil( ScreenEditSub ); + freeandnil( ScreenEdit ); + freeandnil( ScreenEditConvert ); + freeandnil( ScreenOpen ); + freeandnil( ScreenSingModi ); + freeandnil( ScreenSongMenu ); + freeandnil( ScreenSongJumpto); + freeandnil( ScreenPopupCheck ); + freeandnil( ScreenPopupError ); + freeandnil( ScreenPartyNewRound ); + freeandnil( ScreenPartyScore ); + freeandnil( ScreenPartyWin ); + freeandnil( ScreenPartyOptions ); + freeandnil( ScreenPartyPlayer ); + freeandnil( ScreenStatMain ); + freeandnil( ScreenStatDetail ); +end; + +end. diff --git a/src/classes0/UGraphicClasses.pas b/src/classes0/UGraphicClasses.pas new file mode 100644 index 00000000..b7174991 --- /dev/null +++ b/src/classes0/UGraphicClasses.pas @@ -0,0 +1,673 @@ +// notes: +unit UGraphicClasses; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses UTexture,SDL; + +const DelayBetweenFrames : Cardinal = 60; +type + + TParticleType=(GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle, ColoredStar, Flare); + + TColour3f = Record + r, g, b: Real; + end; + + TParticle = Class + X, Y : Real; //Position + Screen : Integer; + W, H : Cardinal; //dimensions of particle + Col : array of TColour3f; // Colour(s) of particle + Scale : array of Real; // Scaling factors of particle layers + Frame : Byte; //act. Frame + Tex : Cardinal; //Tex num from Textur Manager + Live : Byte; //How many Cycles before Kill + RecIndex : Integer; //To which rectangle this particle belongs (only GoldenNote) + StarType : TParticleType; // GoldenNote | PerfectNote | NoteHitTwinkle | PerfectLineTwinkle + Alpha : Real; // used for fading... + mX, mY : Real; // movement-vector for PerfectLineTwinkle + SizeMod : Real; // experimental size modifier + SurviveSentenceChange : Boolean; + + Constructor Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); + Destructor Destroy(); override; + procedure Draw; + procedure LiveOn; + end; + + RectanglePositions = Record + xTop, yTop, xBottom, yBottom : Real; + TotalStarCount : Integer; + CurrentStarCount : Integer; + Screen : Integer; + end; + + PerfectNotePositions = Record + xPos, yPos : Real; + Screen : Integer; + end; + + TEffectManager = Class + Particle : array of TParticle; + LastTime : Cardinal; + RecArray : Array of RectanglePositions; + TwinkleArray : Array[0..5] of Real; // store x-position of last twinkle for every player + PerfNoteArray : Array of PerfectNotePositions; + + FlareTex: TTexture; + + constructor Create; + destructor Destroy; override; + procedure Draw; + function Spawn(X, Y: Real; + Screen: Integer; + Live: Byte; + StartFrame: Integer; + RecArrayIndex: Integer; // this is only used with GoldenNotes + StarType: TParticleType; + Player: Cardinal // for PerfectLineTwinkle + ): Cardinal; + procedure SpawnRec(); + procedure Kill(index: Cardinal); + procedure KillAll(); + procedure SentenceChange(); + procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); + procedure SavePerfectNotePos(Xtop, Ytop: Real); + procedure GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer); + procedure SpawnPerfectLineTwinkle(); + end; + +var GoldenRec : TEffectManager; + +implementation + +uses sysutils, + gl, + UIni, + UMain, + UThemes, + USkins, + UGraphic, + UDrawTexture, + UCommon, + math; + +//TParticle +Constructor TParticle.Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); +begin + inherited Create; + // in this constructor we set all initial values for our particle + X := cX; + Y := cY; + Screen := cScreen; + Live := cLive; + Frame:= cFrame; + RecIndex := cRecArrayIndex; + StarType := cStarType; + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + SetLength(Scale,1); + Scale[0] := 1; + SurviveSentenceChange := False; + SizeMod := 1; + case cStarType of + GoldenNote: + begin + Tex := Tex_Note_Star.TexNum; + W := 20; + H := 20; + SetLength(Scale,4); + Scale[1]:=0.8; + Scale[2]:=0.4; + Scale[3]:=0.3; + SetLength(Col,4); + Col[0].r := 1; + Col[0].g := 0.7; + Col[0].b := 0.1; + + Col[1].r := 1; + Col[1].g := 1; + Col[1].b := 0.4; + + Col[2].r := 1; + Col[2].g := 1; + Col[2].b := 1; + + Col[3].r := 1; + Col[3].g := 1; + Col[3].b := 1; + end; + PerfectNote: + begin + Tex := Tex_Note_Perfect_Star.TexNum; + W := 30; + H := 30; + SetLength(Col,1); + Col[0].r := 1; + Col[0].g := 1; + Col[0].b := 0.95; + end; + NoteHitTwinkle: + begin + Tex := Tex_Note_Star.TexNum; + Alpha := (Live/16); // linear fade-out + W := 15; + H := 15; + Setlength(Col,1); + Col[0].r := 1; + Col[0].g := 1; + Col[0].b := RandomRange(10*Live,100)/90; //0.9; + end; + PerfectLineTwinkle: + begin + Tex := Tex_Note_Star.TexNum; + W := RandomRange(10,20); + H := W; + SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); + SurviveSentenceChange:=True; + // assign colours according to player given + SetLength(Scale,3); + Scale[1]:=0.3; + Scale[2]:=0.2; + SetLength(Col,3); + case Player of + 0: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light'); + 1: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P2Light'); + 2: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P3Light'); + 3: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P4Light'); + 4: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P5Light'); + 5: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P6Light'); + else LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light'); + end; + Col[1].r := 1; + Col[1].g := 1; + Col[1].b := 0.4; + Col[2].r:=Col[0].r+0.5; + Col[2].g:=Col[0].g+0.5; + Col[2].b:=Col[0].b+0.5; + mX := RandomRange(-5,5); + mY := RandomRange(-5,5); + end; + ColoredStar: + begin + Tex := Tex_Note_Star.TexNum; + W := RandomRange(10,20); + H := W; + SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); + SurviveSentenceChange:=True; + // assign colours according to player given + SetLength(Scale,1); + SetLength(Col,1); + Col[0].b := (Player and $ff)/255; + Col[0].g := ((Player shr 8) and $ff)/255; + Col[0].r := ((Player shr 16) and $ff)/255; + mX := 0; + mY := 0; + end; + Flare: + begin + Tex := Tex_Note_Star.TexNum; + W := 7; + H := 7; + SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); + mX := RandomRange(-5,5); + mY := RandomRange(-5,5); + SetLength(Scale,4); + Scale[1]:=0.8; + Scale[2]:=0.4; + Scale[3]:=0.3; + SetLength(Col,4); + Col[0].r := 1; + Col[0].g := 0.7; + Col[0].b := 0.1; + + Col[1].r := 1; + Col[1].g := 1; + Col[1].b := 0.4; + + Col[2].r := 1; + Col[2].g := 1; + Col[2].b := 1; + + Col[3].r := 1; + Col[3].g := 1; + Col[3].b := 1; + + end; + else // just some random default values + begin + Tex := Tex_Note_Star.TexNum; + Alpha := 1; + W := 20; + H := 20; + SetLength(Col,1); + Col[0].r := 1; + Col[0].g := 1; + Col[0].b := 1; + end; + end; +end; + +Destructor TParticle.Destroy(); +begin + SetLength(Scale,0); + SetLength(Col,0); + inherited; +end; + +procedure TParticle.LiveOn; +begin + //Live = 0 => Live forever ?? but if this is 0 they would be killed in the Manager at Draw + if (Live > 0) then + Dec(Live); + + // animate frames + Frame := ( Frame + 1 ) mod 16; + + // make our particles do funny stuff (besides being animated) + // changes of any particle-values throughout its life are done here + case StarType of + GoldenNote: + begin + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + end; + PerfectNote: + begin + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + end; + NoteHitTwinkle: + begin + Alpha := (Live/10); // linear fade-out + end; + PerfectLineTwinkle: + begin + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); + // move around + X := X + mX; + Y := Y + mY; + end; + ColoredStar: + begin + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + end; + Flare: + begin + Alpha := (-cos((Frame+1)/16*1.7*pi+0.3*pi)+1); // neat fade-in-and-out + SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); + // move around + X := X + mX; + Y := Y + mY; + mY:=mY+1.8; +// mX:=mX/2; + end; + end; +end; + +procedure TParticle.Draw; +var L: Cardinal; +begin + if ScreenAct = Screen then + // this draws (multiple) texture(s) of our particle + for L:=0 to High(Col) do + begin + glColor4f(Col[L].r, Col[L].g, Col[L].b, Alpha); + + glBindTexture(GL_TEXTURE_2D, Tex); + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + + begin + glBegin(GL_QUADS); + glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); + glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); + glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); + glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); + glEnd; + end; + end; + glcolor4f(1,1,1,1); +end; +// end of TParticle + +// TEffectManager + +constructor TEffectManager.Create; +var c: Cardinal; +begin + inherited; + LastTime := SDL_GetTicks(); + for c:=0 to 5 do + begin + TwinkleArray[c] := 0; + end; +end; + +destructor TEffectManager.Destroy; +begin + Killall; + inherited; +end; + + +procedure TEffectManager.Draw; +var + I: Integer; + CurrentTime: Cardinal; +//const +// DelayBetweenFrames : Cardinal = 100; +begin + + CurrentTime := SDL_GetTicks(); + //Manage particle life + if (CurrentTime - LastTime) > DelayBetweenFrames then + begin + LastTime := CurrentTime; + for I := 0 to high(Particle) do + Particle[I].LiveOn; + end; + + I := 0; + //Kill dead particles + while (I <= High(Particle)) do + begin + if (Particle[I].Live <= 0) then + begin + kill(I); + end + else + begin + inc(I); + end; + end; + + //Draw + for I := 0 to high(Particle) do + begin + Particle[I].Draw; + end; +end; + +// this method creates just one particle +function TEffectManager.Spawn(X, Y: Real; Screen: Integer; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : TParticleType; Player: Cardinal): Cardinal; +begin + Result := Length(Particle); + SetLength(Particle, (Result + 1)); + Particle[Result] := TParticle.Create(X, Y, Screen, Live, StartFrame, RecArrayIndex, StarType, Player); +end; + +// manage Sparkling of GoldenNote Bars +procedure TEffectManager.SpawnRec(); +Var + Xkatze, Ykatze : Real; + RandomFrame : Integer; + P : Integer; // P as seen on TV as Positionman +begin +//Spawn a random amount of stars within the given coordinates +//RandomRange(0,14) <- this one starts at a random frame, 16 is our last frame - would be senseless to start a particle with 16, cause it would be dead at the next frame +for P:= 0 to high(RecArray) do + begin + while (RecArray[P].TotalStarCount > RecArray[P].CurrentStarCount) do + begin + Xkatze := RandomRange(Ceil(RecArray[P].xTop), Ceil(RecArray[P].xBottom)); + Ykatze := RandomRange(Ceil(RecArray[P].yTop), Ceil(RecArray[P].yBottom)); + RandomFrame := RandomRange(0,14); + // Spawn a GoldenNote Particle + Spawn(Xkatze, Ykatze, RecArray[P].Screen, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0); + inc(RecArray[P].CurrentStarCount); + end; + end; + draw; +end; + +// kill one particle (with given index in our particle array) +procedure TEffectManager.Kill(Index: Cardinal); +var + LastParticleIndex : Integer; +begin +// delete particle indexed by Index, +// overwrite it's place in our particle-array with the particle stored at the last array index, +// shorten array + LastParticleIndex := high(Particle); + if not(LastParticleIndex = -1) then // is there still a particle to delete? + begin + if not(Particle[Index].RecIndex = -1) then // if it is a GoldenNote particle... + dec(RecArray[Particle[Index].RecIndex].CurrentStarCount); // take care of its associated GoldenRec + // now get rid of that particle + Particle[Index].Destroy; + Particle[Index] := Particle[LastParticleIndex]; + SetLength(Particle, LastParticleIndex); + end; +end; + +// clean up all particles and management structures +procedure TEffectManager.KillAll(); +var c: Cardinal; +begin +//It's the kill all kennies rotuine + while Length(Particle) > 0 do // kill all existing particles + Kill(0); + SetLength(RecArray,0); // remove GoldenRec positions + SetLength(PerfNoteArray,0); // remove PerfectNote positions + for c:=0 to 5 do + begin + TwinkleArray[c] := 0; // reset GoldenNoteHit memory + end; +end; + +procedure TEffectManager.SentenceChange(); +var c: Cardinal; +begin + c:=0; + while c <= High(Particle) do + begin + if Particle[c].SurviveSentenceChange then + inc(c) + else + Kill(c); + end; + SetLength(RecArray,0); // remove GoldenRec positions + SetLength(PerfNoteArray,0); // remove PerfectNote positions + for c:=0 to 5 do + begin + TwinkleArray[c] := 0; // reset GoldenNoteHit memory + end; +end; + +procedure TeffectManager.GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer); +//Twinkle stars while golden note hit +// this is called from UDraw.pas, SingDrawPlayerCzesc +var + C, P, XKatze, YKatze, LKatze: Integer; + H: Real; +begin + // make sure we spawn only one time at one position + if (TwinkleArray[Player] < Right) then + For P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle? + begin + H := (Top+Bottom)/2; // helper... + with RecArray[P] do + if ((xBottom >= Right) and (xTop <= Right) and + (yTop <= H) and (yBottom >= H)) + and (Screen = ScreenAct) then + begin + TwinkleArray[Player] := Right; // remember twinkle position for this player + for C := 1 to 10 do + begin + Ykatze := RandomRange(ceil(Top) , ceil(Bottom)); + XKatze := RandomRange(-7,3); + LKatze := RandomRange(7,13); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + for C := 1 to 3 do + begin + Ykatze := RandomRange(ceil(Top)-6 , ceil(Top)); + XKatze := RandomRange(-5,1); + LKatze := RandomRange(4,7); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + for C := 1 to 3 do + begin + Ykatze := RandomRange(ceil(Bottom), ceil(Bottom)+6); + XKatze := RandomRange(-5,1); + LKatze := RandomRange(4,7); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + for C := 1 to 3 do + begin + Ykatze := RandomRange(ceil(Top)-10 , ceil(Top)-6); + XKatze := RandomRange(-5,1); + LKatze := RandomRange(1,4); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + for C := 1 to 3 do + begin + Ykatze := RandomRange(ceil(Bottom)+6 , ceil(Bottom)+10); + XKatze := RandomRange(-5,1); + LKatze := RandomRange(1,4); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + + exit; // found a matching GoldenRec, did spawning stuff... done + end; + end; +end; + +procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); +var + P : Integer; // P like used in Positions + NewIndex : Integer; +begin + For P := 0 to high(RecArray) do // Do we already have that "new" position? + begin + if (ceil(RecArray[P].xTop) = ceil(Xtop)) and + (ceil(RecArray[P].yTop) = ceil(Ytop)) and + (ScreenAct = RecArray[p].Screen) then + exit; // it's already in the array, so we don't have to create a new one + end; + + // we got a new position, add the new positions to our array + NewIndex := Length(RecArray); + SetLength(RecArray, NewIndex + 1); + RecArray[NewIndex].xTop := Xtop; + RecArray[NewIndex].yTop := Ytop; + RecArray[NewIndex].xBottom := Xbottom; + RecArray[NewIndex].yBottom := Ybottom; + RecArray[NewIndex].TotalStarCount := ceil(Xbottom - Xtop) div 12 + 3; + RecArray[NewIndex].CurrentStarCount := 0; + RecArray[NewIndex].Screen := ScreenAct; +end; + +procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: Real); +var + P : Integer; // P like used in Positions + NewIndex : Integer; + RandomFrame : Integer; + Xkatze, Ykatze : Integer; +begin + For P := 0 to high(PerfNoteArray) do // Do we already have that "new" position? + begin + with PerfNoteArray[P] do + if (ceil(xPos) = ceil(Xtop)) and (ceil(yPos) = ceil(Ytop)) and + (Screen = ScreenAct) then + exit; // it's already in the array, so we don't have to create a new one + end; //for + + // we got a new position, add the new positions to our array + NewIndex := Length(PerfNoteArray); + SetLength(PerfNoteArray, NewIndex + 1); + PerfNoteArray[NewIndex].xPos := Xtop; + PerfNoteArray[NewIndex].yPos := Ytop; + PerfNoteArray[NewIndex].Screen := ScreenAct; + + for P:= 0 to 2 do + begin + Xkatze := RandomRange(ceil(Xtop) - 5 , ceil(Xtop) + 10); + Ykatze := RandomRange(ceil(Ytop) - 5 , ceil(Ytop) + 10); + RandomFrame := RandomRange(0,14); + Spawn(Xkatze, Ykatze, ScreenAct, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0); + end; //for + +end; + +procedure TEffectManager.SpawnPerfectLineTwinkle(); +var + P,I,Life: Cardinal; + Left, Right, Top, Bottom: Cardinal; + cScreen: Integer; +begin +// calculation of coordinates done with hardcoded values like in UDraw.pas +// might need to be adjusted if drawing of SingScreen is modified +// coordinates may still be a bit weird and need adjustment + if Ini.SingWindow = 0 then begin + Left := 130; + end else begin + Left := 30; + end; + Right := 770; + // spawn effect for every player with a perfect line + for P:=0 to PlayersPlay-1 do + if Player[P].LastSentencePerfect then + begin + // calculate area where notes of this player are drawn + case PlayersPlay of + 1: begin + Bottom:=Skin_P2_NotesB+10; + Top:=Bottom-105; + cScreen:=1; + end; + 2,4: begin + case P of + 0,2: begin + Bottom:=Skin_P1_NotesB+10; + Top:=Bottom-105; + end; + else begin + Bottom:=Skin_P2_NotesB+10; + Top:=Bottom-105; + end; + end; + case P of + 0,1: cScreen:=1; + else cScreen:=2; + end; + end; + 3,6: begin + case P of + 0,3: begin + Top:=130; + Bottom:=Top+85; + end; + 1,4: begin + Top:=255; + Bottom:=Top+85; + end; + 2,5: begin + Top:=380; + Bottom:=Top+85; + end; + end; + case P of + 0,1,2: cScreen:=1; + else cScreen:=2; + end; + end; + end; + // spawn Sparkling Stars inside calculated coordinates + for I:= 0 to 80 do + begin + Life:=RandomRange(8,16); + Spawn(RandomRange(Left,Right), RandomRange(Top,Bottom), cScreen, Life, 16-Life, -1, PerfectLineTwinkle, P); + end; + end; +end; + +end. + diff --git a/src/classes0/UHooks.pas b/src/classes0/UHooks.pas new file mode 100644 index 00000000..f0ba3276 --- /dev/null +++ b/src/classes0/UHooks.pas @@ -0,0 +1,434 @@ +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: TwParam; lParam: TlParam): Integer; + Function EventExists (const EventName: PChar): Integer; + + Procedure DelbyOwner(const Owner: Integer); + end; + +function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; + +var + HookManager: THookManager; + +implementation +uses + ULog, + UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +constructor THookManager.Create(const SpacetoAllocate: Word); +var I: Integer; +begin + inherited Create(); + + //Get the Space and "Zero" it + SetLength (Events, SpacetoAllocate); + For I := 0 to SpacetoAllocate-1 do + Events[I].Name[1] := chr(0); + + SpaceinEvents := SpacetoAllocate; + + {$IFDEF DEBUG} + debugWriteLn('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} + debugWriteLn('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} + debugWriteLn('HookManager: Add Event succesful: ''' + EventName + ''); + {$ENDIF} + end + {$IFDEF DEBUG} + else + debugWriteLn('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} + debugWriteLn('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 + debugWriteLn('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} + debugWriteLn('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} + debugWriteLn('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: TwParam; lParam: TlParam): 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} + debugWriteLn('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: TwParam; lParam: TlParam): integer; stdcall; +begin + Result := 0; //Don't break the chain + Core.ShowMessage(CORE_SM_INFO, PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam))))); +end; + +end. diff --git a/src/classes0/UImage.pas b/src/classes0/UImage.pas new file mode 100644 index 00000000..d33c0d38 --- /dev/null +++ b/src/classes0/UImage.pas @@ -0,0 +1,993 @@ +unit UImage; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SDL; + +{$DEFINE HavePNG} +{$DEFINE HaveBMP} +{$DEFINE HaveJPG} + +const + PixelFmt_RGBA: TSDL_Pixelformat = ( + palette: nil; + BitsPerPixel: 32; + BytesPerPixel: 4; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 0; + Gshift: 8; + Bshift: 16; + Ashift: 24; + Rmask: $000000ff; + Gmask: $0000ff00; + Bmask: $00ff0000; + Amask: $ff000000; + ColorKey: 0; + Alpha: 255 + ); + + PixelFmt_RGB: TSDL_Pixelformat = ( + palette: nil; + BitsPerPixel: 24; + BytesPerPixel: 3; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 0; + Gshift: 8; + Bshift: 16; + Ashift: 0; + Rmask: $000000ff; + Gmask: $0000ff00; + Bmask: $00ff0000; + Amask: $00000000; + ColorKey: 0; + Alpha: 255 + ); + + PixelFmt_BGRA: TSDL_Pixelformat = ( + palette: nil; + BitsPerPixel: 32; + BytesPerPixel: 4; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 16; + Gshift: 8; + Bshift: 0; + Ashift: 24; + Rmask: $00ff0000; + Gmask: $0000ff00; + Bmask: $000000ff; + Amask: $ff000000; + ColorKey: 0; + Alpha: 255 + ); + + PixelFmt_BGR: TSDL_Pixelformat = ( + palette: nil; + BitsPerPixel: 24; + BytesPerPixel: 3; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 16; + Gshift: 8; + Bshift: 0; + Ashift: 0; + Rmask: $00ff0000; + Gmask: $0000ff00; + Bmask: $000000ff; + Amask: $00000000; + ColorKey: 0; + Alpha: 255 + ); + +type + TImagePixelFmt = ( + ipfRGBA, ipfRGB, ipfBGRA, ipfBGR + ); + +(******************************************************* + * Image saving + *******************************************************) + +{$IFDEF HavePNG} +function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean; +{$ENDIF} +{$IFDEF HaveBMP} +function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean; +{$ENDIF} +{$IFDEF HaveJPG} +function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean; +{$ENDIF} + +(******************************************************* + * Image loading + *******************************************************) + +function LoadImage(const Identifier: string): PSDL_Surface; + +(******************************************************* + * Image manipulation + *******************************************************) + +function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; +procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); + + +implementation + +uses + SysUtils, + Classes, + Math, + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF} + {$IFDEF HaveJPG} + {$IFDEF Delphi} + Graphics, + jpeg, + {$ELSE} + jpeglib, + jerror, + jcparam, + jdatadst, jcapimin, jcapistd, + {$ENDIF} + {$ENDIF} + {$IFDEF HavePNG} + png, + {$ENDIF} + zlib, + sdl_image, + sdlutils, + UCommon, + ULog; + + +function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean; +begin + Result := (pixelFmt.BitsPerPixel = 24) and + (pixelFmt.RMask = $0000FF) and + (pixelFmt.GMask = $00FF00) and + (pixelFmt.BMask = $FF0000); +end; + +function IsRGBASurface(pixelFmt: PSDL_PixelFormat): boolean; +begin + Result := (pixelFmt.BitsPerPixel = 32) and + (pixelFmt.RMask = $000000FF) and + (pixelFmt.GMask = $0000FF00) and + (pixelFmt.BMask = $00FF0000) and + (pixelFmt.AMask = $FF000000); +end; + +function IsBGRSurface(pixelFmt: PSDL_PixelFormat): boolean; +begin + Result := (pixelFmt.BitsPerPixel = 24) and + (pixelFmt.BMask = $0000FF) and + (pixelFmt.GMask = $00FF00) and + (pixelFmt.RMask = $FF0000); +end; + +function IsBGRASurface(pixelFmt: PSDL_PixelFormat): boolean; +begin + Result := (pixelFmt.BitsPerPixel = 32) and + (pixelFmt.BMask = $000000FF) and + (pixelFmt.GMask = $0000FF00) and + (pixelFmt.RMask = $00FF0000) and + (pixelFmt.AMask = $FF000000); +end; + +// Converts alpha-formats to BGRA, non-alpha to BGR, and leaves BGR(A) as is +// sets converted to true if the surface needed to be converted +function ConvertToBGR_BGRASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface; +var + pixelFmt: PSDL_PixelFormat; +begin + pixelFmt := Surface.format; + if (IsBGRSurface(pixelFmt) or IsBGRASurface(pixelFmt)) then + begin + Converted := false; + Result := Surface; + end + else + begin + // invalid format -> needs conversion + if (pixelFmt.AMask <> 0) then + Result := SDL_ConvertSurface(Surface, @PixelFmt_BGRA, SDL_SWSURFACE) + else + Result := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE); + Converted := true; + end; +end; + +// Converts alpha-formats to RGBA, non-alpha to RGB, and leaves RGB(A) as is +// sets converted to true if the surface needed to be converted +function ConvertToRGB_RGBASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface; +var + pixelFmt: PSDL_PixelFormat; +begin + pixelFmt := Surface.format; + if (IsRGBSurface(pixelFmt) or IsRGBASurface(pixelFmt)) then + begin + Converted := false; + Result := Surface; + end + else + begin + // invalid format -> needs conversion + if (pixelFmt.AMask <> 0) then + Result := SDL_ConvertSurface(Surface, @PixelFmt_RGBA, SDL_SWSURFACE) + else + Result := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE); + Converted := true; + end; +end; + + +(******************************************************* + * Image saving + *******************************************************) + +(*************************** + * PNG section + *****************************) + +{$IFDEF HavePNG} + +// delphi does not support setjmp()/longjmp() -> define our own error-handler +procedure user_error_fn(png_ptr: png_structp; error_msg: png_const_charp); cdecl; +begin + raise Exception.Create(error_msg); +end; + +procedure user_read_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl; +var + inFile: TFileStream; +begin + inFile := TFileStream(png_get_io_ptr(png_ptr)); + inFile.Read(data^, length); +end; + +procedure user_write_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl; +var + outFile: TFileStream; +begin + outFile := TFileStream(png_get_io_ptr(png_ptr)); + outFile.Write(data^, length); +end; + +procedure user_flush_data(png_ptr: png_structp); cdecl; +//var +// outFile: TFileStream; +begin + // binary files are flushed automatically, Flush() works with Text-files only + //outFile := TFileStream(png_get_io_ptr(png_ptr)); + //outFile.Flush(); +end; + +procedure DateTimeToPngTime(time: TDateTime; var pngTime: png_time); +var + year, month, day: word; + hour, minute, second, msecond: word; +begin + DecodeDate(time, year, month, day); + pngTime.year := year; + pngTime.month := month; + pngTime.day := day; + DecodeTime(time, hour, minute, second, msecond); + pngTime.hour := hour; + pngTime.minute := minute; + pngTime.second := second; +end; + +(* + * ImageData must be in RGB-format + *) +function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean; +var + png_ptr: png_structp; + info_ptr: png_infop; + pngFile: TFileStream; + row: integer; + rowData: array of png_bytep; +// rowStride: integer; + converted: boolean; + colorType: integer; +// time: png_time; +begin + Result := false; + + // open file for writing + try + pngFile := TFileStream.Create(FileName, fmCreate); + except + Log.LogError('Could not open file: "' + FileName + '"', 'WritePngImage'); + Exit; + end; + + // only 24bit (RGB) or 32bit (RGBA) data is supported, so convert to it + Surface := ConvertToRGB_RGBASurface(Surface, converted); + + png_ptr := nil; + + try + // initialize png (and enable a user-defined error-handler that throws an exception on error) + png_ptr := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, @user_error_fn, nil); + // the error-handler is called if png_create_write_struct() fails, so png_ptr should always be <> nil + if (png_ptr = nil) then + begin + Log.LogError('png_create_write_struct() failed', 'WritePngImage'); + if (converted) then + SDL_FreeSurface(Surface); + Exit; + end; + + info_ptr := png_create_info_struct(png_ptr); + + if (Surface^.format^.BitsPerPixel = 24) then + colorType := PNG_COLOR_TYPE_RGB + else + colorType := PNG_COLOR_TYPE_RGBA; + + // define write IO-functions (POSIX-style FILE-pointers are not available in Delphi) + png_set_write_fn(png_ptr, pngFile, @user_write_data, @user_flush_data); + png_set_IHDR( + png_ptr, info_ptr, + Surface.w, Surface.h, + 8, + colorType, + PNG_INTERLACE_NONE, + PNG_COMPRESSION_TYPE_DEFAULT, + PNG_FILTER_TYPE_DEFAULT + ); + + // TODO: do we need the modification time? + //DateTimeToPngTime(Now, time); + //png_set_tIME(png_ptr, info_ptr, @time); + + if (SDL_MUSTLOCK(Surface)) then + SDL_LockSurface(Surface); + + // setup data + SetLength(rowData, Surface.h); + for row := 0 to Surface.h-1 do + begin + // set rowData-elements to beginning of each image row + // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned) + rowData[row] := @PChar(Surface.pixels)[(Surface.h-row-1) * Surface.pitch]; + end; + + if (SDL_MUSTLOCK(Surface)) then + SDL_UnlockSurface(Surface); + + png_write_info(png_ptr, info_ptr); + png_write_image(png_ptr, png_bytepp(rowData)); + png_write_end(png_ptr, nil); + + Result := true; + except on E: Exception do + Log.LogError(E.message, 'WritePngImage'); + end; + + // free row-data + SetLength(rowData, 0); + + // free png-resources + if (png_ptr <> nil) then + png_destroy_write_struct(@png_ptr, nil); + + if (converted) then + SDL_FreeSurface(Surface); + + // close file + pngFile.Free; +end; + +{$ENDIF} + +(*************************** + * BMP section + *****************************) + +{$IFDEF HaveBMP} + +{$IFNDEF MSWINDOWS} +const + (* constants for the biCompression field *) + BI_RGB = 0; + BI_RLE8 = 1; + BI_RLE4 = 2; + BI_BITFIELDS = 3; + BI_JPEG = 4; + BI_PNG = 5; + +type + BITMAPINFOHEADER = record + biSize: longword; + biWidth: longint; + biHeight: longint; + biPlanes: word; + biBitCount: word; + biCompression: longword; + biSizeImage: longword; + biXPelsPerMeter: longint; + biYPelsPerMeter: longint; + biClrUsed: longword; + biClrImportant: longword; + end; + LPBITMAPINFOHEADER = ^BITMAPINFOHEADER; + TBITMAPINFOHEADER = BITMAPINFOHEADER; + PBITMAPINFOHEADER = ^BITMAPINFOHEADER; + + RGBTRIPLE = record + rgbtBlue: byte; + rgbtGreen: byte; + rgbtRed: byte; + end; + tagRGBTRIPLE = RGBTRIPLE; + TRGBTRIPLE = RGBTRIPLE; + PRGBTRIPLE = ^RGBTRIPLE; + + RGBQUAD = record + rgbBlue: byte; + rgbGreen: byte; + rgbRed: byte; + rgbReserved: byte; + end; + tagRGBQUAD = RGBQUAD; + TRGBQUAD = RGBQUAD; + PRGBQUAD = ^RGBQUAD; + + BITMAPINFO = record + bmiHeader: BITMAPINFOHEADER; + bmiColors: array[0..0] of RGBQUAD; + end; + LPBITMAPINFO = ^BITMAPINFO; + PBITMAPINFO = ^BITMAPINFO; + TBITMAPINFO = BITMAPINFO; + + {$PACKRECORDS 2} + BITMAPFILEHEADER = record + bfType: word; + bfSize: longword; + bfReserved1: word; + bfReserved2: word; + bfOffBits: longword; + end; + {$PACKRECORDS DEFAULT} +{$ENDIF} + +(* + * ImageData must be in BGR-format + *) +function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean; +var + bmpFile: TFileStream; + FileInfo: BITMAPINFOHEADER; + FileHeader: BITMAPFILEHEADER; + Converted: boolean; + Row: integer; + RowSize: integer; +begin + Result := false; + + // open file for writing + try + bmpFile := TFileStream.Create(FileName, fmCreate); + except + Log.LogError('Could not open file: "' + FileName + '"', 'WriteBMPImage'); + Exit; + end; + + // only 24bit (BGR) or 32bit (BGRA) data is supported, so convert to it + Surface := ConvertToBGR_BGRASurface(Surface, Converted); + + // aligned (4-byte) row-size in bytes + RowSize := ((Surface.w * Surface.format.BytesPerPixel + 3) div 4) * 4; + + // initialize bitmap info + FillChar(FileInfo, SizeOf(BITMAPINFOHEADER), 0); + with FileInfo do + begin + biSize := SizeOf(BITMAPINFOHEADER); + biWidth := Surface.w; + biHeight := Surface.h; + biPlanes := 1; + biBitCount := Surface^.format^.BitsPerPixel; + biCompression := BI_RGB; + biSizeImage := RowSize * Surface.h; + end; + + // initialize header-data + FillChar(FileHeader, SizeOf(BITMAPFILEHEADER), 0); + with FileHeader do + begin + bfType := $4D42; // = 'BM' + bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER); + bfSize := bfOffBits + FileInfo.biSizeImage; + end; + + // and move the whole stuff into the file ;-) + try + // write headers + bmpFile.Write(FileHeader, SizeOf(BITMAPFILEHEADER)); + bmpFile.Write(FileInfo, SizeOf(BITMAPINFOHEADER)); + + // write image-data + + if (SDL_MUSTLOCK(Surface)) then + SDL_LockSurface(Surface); + + // BMP needs 4-byte alignment + if (Surface.pitch mod 4 = 0) then + begin + // aligned correctly -> write whole image at once + bmpFile.Write(Surface.pixels^, FileInfo.biSizeImage); + end + else + begin + // misaligned -> write each line separately + // Note: for the last line unassigned memory (> last Surface.pixels element) + // will be copied to the padding area (last bytes of a row), + // but we do not care because the content of padding data is ignored anyhow. + for Row := 0 to Surface.h do + bmpFile.Write(PChar(Surface.pixels)[Row * Surface.pitch], RowSize); + end; + + if (SDL_MUSTLOCK(Surface)) then + SDL_UnlockSurface(Surface); + + Result := true; + finally + Log.LogError('Could not write file: "' + FileName + '"', 'WriteBMPImage'); + end; + + if (Converted) then + SDL_FreeSurface(Surface); + + // close file + bmpFile.Free; +end; + +{$ENDIF} + +(*************************** + * JPG section + *****************************) + +{$IFDEF HaveJPG} + +function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean; +var + {$IFDEF Delphi} + Bitmap: TBitmap; + BitmapInfo: TBitmapInfo; + Jpeg: TJpegImage; + row: integer; + {$ELSE} + cinfo: jpeg_compress_struct; + jerr : jpeg_error_mgr; + jpgFile: TFileStream; + rowPtr: array[0..0] of JSAMPROW; + {$ENDIF} + converted: boolean; +begin + Result := false; + + {$IFDEF Delphi} + // only 24bit (BGR) data is supported, so convert to it + if (IsBGRSurface(Surface.format)) then + converted := false + else + begin + Surface := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE); + converted := true; + end; + + // create and setup bitmap + Bitmap := TBitmap.Create; + Bitmap.PixelFormat := pf24bit; + Bitmap.Width := Surface.w; + Bitmap.Height := Surface.h; + + // setup bitmap info on source image (Surface parameter) + ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo)); + with BitmapInfo.bmiHeader do + begin + biSize := SizeOf(BITMAPINFOHEADER); + biWidth := Surface.w; + biHeight := Surface.h; + biPlanes := 1; + biBitCount := 24; + biCompression := BI_RGB; + end; + + if (SDL_MUSTLOCK(Surface)) then + SDL_LockSurface(Surface); + + // use fast Win32-API functions to copy data instead of Bitmap.Canvas.Pixels + if (Surface.pitch mod 4 = 0) then + begin + // if the image is aligned (to a 4-byte boundary) -> copy all data at once + // Note: surfaces created with SDL (e.g. with SDL_ConvertSurface) are aligned + SetDIBits(0, Bitmap.Handle, 0, Bitmap.Height, Surface.pixels, BitmapInfo, DIB_RGB_COLORS); + end + else + begin + // wrong alignment -> copy each line separately. + // Note: for the last line unassigned memory (> last Surface.pixels element) + // will be copied to the padding area (last bytes of a row), + // but we do not care because the content of padding data is ignored anyhow. + for row := 0 to Surface.h do + begin + SetDIBits(0, Bitmap.Handle, row, 1, @PChar(Surface.pixels)[row * Surface.pitch], + BitmapInfo, DIB_RGB_COLORS); + end; + end; + + if (SDL_MUSTLOCK(Surface)) then + SDL_UnlockSurface(Surface); + + // assign Bitmap to JPEG and store the latter + Jpeg := TJPEGImage.Create; + Jpeg.Assign(Bitmap); + Bitmap.Free; + Jpeg.CompressionQuality := Quality; + try + // compress image (don't forget this line, otherwise it won't be compressed) + Jpeg.Compress(); + Jpeg.SaveToFile(FileName); + except + Log.LogError('Could not save file: "' + FileName + '"', 'WriteJPGImage'); + Exit; + end; + Jpeg.Free; + {$ELSE} + // based on example.pas in FPC's packages/base/pasjpeg directory + + // only 24bit (RGB) data is supported, so convert to it + if (IsRGBSurface(Surface.format)) then + converted := false + else + begin + Surface := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE); + converted := true; + end; + + // allocate and initialize JPEG compression object + cinfo.err := jpeg_std_error(jerr); + // msg_level that will be displayed. (Nomssi) + //jerr.trace_level := 3; + // initialize the JPEG compression object + jpeg_create_compress(@cinfo); + + // open file for writing + try + jpgFile := TFileStream.Create(FileName, fmCreate); + except + Log.LogError('Could not open file: "' + FileName + '"', 'WriteJPGImage'); + Exit; + end; + + // specify data destination + jpeg_stdio_dest(@cinfo, @jpgFile); + + // set parameters for compression + cinfo.image_width := Surface.w; + cinfo.image_height := Surface.h; + cinfo.in_color_space := JCS_RGB; + cinfo.input_components := 3; + cinfo.data_precision := 8; + + // set default compression parameters + jpeg_set_defaults(@cinfo); + jpeg_set_quality(@cinfo, quality, true); + + // start compressor + jpeg_start_compress(@cinfo, true); + + if (SDL_MUSTLOCK(Surface)) then + SDL_LockSurface(Surface); + + while (cinfo.next_scanline < cinfo.image_height) do + begin + // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned) + rowPtr[0] := JSAMPROW(@PChar(Surface.pixels)[(Surface.h-cinfo.next_scanline-1) * Surface.pitch]); + jpeg_write_scanlines(@cinfo, JSAMPARRAY(@rowPtr), 1); + end; + + if (SDL_MUSTLOCK(Surface)) then + SDL_UnlockSurface(Surface); + + // finish compression + jpeg_finish_compress(@cinfo); + // close the output file + jpgFile.Free; + + // release JPEG compression object + jpeg_destroy_compress(@cinfo); + {$ENDIF} + + if (converted) then + SDL_FreeSurface(Surface); + + Result := true; +end; + +{$ENDIF} + + +(******************************************************* + * Image loading + *******************************************************) + + +(* + * Loads an image from the given file or resource + *) +function LoadImage(const Identifier: string): PSDL_Surface; +var + TexRWops: PSDL_RWops; + TexStream: TStream; + FileName: string; +begin + Result := nil; + TexRWops := nil; + + if Identifier = '' then + exit; + + //Log.LogStatus( Identifier, 'LoadImage' ); + + FileName := Identifier; + + if (FileExistsInsensitive(FileName)) then + begin + // load from file + //Log.LogStatus( 'Is File ( Loading : '+FileName+')', ' LoadImage' ); + try + Result := IMG_Load(PChar(FileName)); + //Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' ); + except + Log.LogError('Could not load from file "'+FileName+'"', 'LoadImage'); + Exit; + end; + end + else + begin + //Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + TexStream := GetResourceStream(Identifier, 'TEX'); + if (not assigned(TexStream)) then + begin + Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'LoadImage'); + Exit; + end; + + TexRWops := RWopsFromStream(TexStream); + if (TexRWops = nil) then + begin + Log.LogError( 'Could not assign resource "'+Identifier+'"', 'LoadImage'); + TexStream.Free(); + Exit; + end; + + //Log.LogStatus( 'resource Assigned....' , Identifier); + try + Result := IMG_Load_RW(TexRWops, 0); + except + Log.LogError( 'Could not read resource "'+Identifier+'"', 'LoadImage'); + end; + + SDL_FreeRW(TexRWops); + TexStream.Free(); + end; +end; + + +(******************************************************* + * Image manipulation + *******************************************************) + + +function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; +begin + if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and + (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and + (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and + (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and + (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and + (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and + (fmt1^.Bshift = fmt2^.Bshift) + then + Result := true + else + Result := false; +end; + +procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface := ImgSurface; + ImgSurface := SDL_ScaleSurfaceRect(TempSurface, + 0, 0, TempSurface^.W,TempSurface^.H, + Width, Height); + SDL_FreeSurface(TempSurface); +end; + +procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +var + TempSurface: PSDL_Surface; + ImgFmt: PSDL_PixelFormat; +begin + TempSurface := ImgSurface; + + // create a new surface with given width and height + ImgFmt := TempSurface^.format; + ImgSurface := SDL_CreateRGBSurface( + SDL_SWSURFACE, Width, Height, ImgFmt^.BitsPerPixel, + ImgFmt^.RMask, ImgFmt^.GMask, ImgFmt^.BMask, ImgFmt^.AMask); + + // copy image from temp- to new surface + SDL_SetAlpha(ImgSurface, 0, 255); + SDL_SetAlpha(TempSurface, 0, 255); + SDL_BlitSurface(TempSurface, nil, ImgSurface, nil); + + SDL_FreeSurface(TempSurface); +end; + +(* +// Old slow floating point version of ColorizeTexture. +// For an easier understanding of the faster fixed point version below. +procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); +var + clr: array[0..2] of Double; // [0: R, 1: G, 2: B] + hsv: array[0..2] of Double; // [0: H(ue), 1: S(aturation), 2: V(alue)] + delta, f, p, q, t: Double; + max: Double; +begin + clr[0] := PixelColors[0]/255; + clr[1] := PixelColors[1]/255; + clr[2] := PixelColors[2]/255; + max := maxvalue(clr); + delta := max - minvalue(clr); + + hsv[0] := DestinationHue; // set H(ue) + hsv[2] := max; // set V(alue) + // calc S(aturation) + if (max = 0.0) then + hsv[1] := 0.0 + else + hsv[1] := delta/max; + + //ColorizePixel(PByteArray(Pixel), DestinationHue); + h_int := trunc(hsv[0]); // h_int = |_h_| + f := hsv[0]-h_int; // f = h-h_int + p := hsv[2]*(1.0-hsv[1]); // p = v*(1-s) + q := hsv[2]*(1.0-(hsv[1]*f)); // q = v*(1-s*f) + t := hsv[2]*(1.0-(hsv[1]*(1.0-f))); // t = v*(1-s*(1-f)) + case h_int of + 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p) + 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p) + 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t) + 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v) + 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v) + 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q) + end; + + // and store new rgb back into the image + PixelColors[0] := trunc(255*clr[0]); + PixelColors[1] := trunc(255*clr[1]); + PixelColors[2] := trunc(255*clr[2]); +end; +*) + +procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); + + //returns hue within range [0.0-6.0) + function col2hue(Color:Cardinal): double; + var + clr: array[0..2] of double; + hue, max, delta: double; + begin + clr[0] := ((Color and $ff0000) shr 16)/255; // R + clr[1] := ((Color and $ff00) shr 8)/255; // G + clr[2] := (Color and $ff) /255; // B + max := maxvalue(clr); + delta := max - minvalue(clr); + // calc hue + if (delta = 0.0) then hue := 0 + else if (clr[0] = max) then hue := (clr[1]-clr[2])/delta + else if (clr[1] = max) then hue := 2.0+(clr[2]-clr[0])/delta + else if (clr[2] = max) then hue := 4.0+(clr[0]-clr[1])/delta; + if (hue < 0.0) then + hue := hue + 6.0; + Result := hue; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; + Pixel: PByte; + PixelColors: PByteArray; + clr: array[0..2] of UInt32; // [0: R, 1: G, 2: B] + hsv: array[0..2] of UInt32; // [0: H(ue), 1: S(aturation), 2: V(alue)] + dhue: UInt32; + h_int: Cardinal; + delta, f, p, q, t: Longint; + max: Uint32; +begin + DestinationHue := col2hue(NewColor); + + dhue := Trunc(DestinationHue*1024); + + Pixel := ImgSurface^.Pixels; + + for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do + begin + PixelColors := PByteArray(Pixel); + // inlined colorize per pixel + + // uses fixed point math + // get color values + clr[0] := PixelColors[0] shl 10; + clr[1] := PixelColors[1] shl 10; + clr[2] := PixelColors[2] shl 10; + //calculate luminance and saturation from rgb + + max := clr[0]; + if clr[1] > max then max := clr[1]; + if clr[2] > max then max := clr[2]; + delta := clr[0]; + if clr[1] < delta then delta := clr[1]; + if clr[2] < delta then delta := clr[2]; + delta := max-delta; + hsv[0] := dhue; // shl 8 + hsv[2] := max; // shl 8 + if (max = 0) then + hsv[1] := 0 + else + hsv[1] := (delta shl 10) div max; // shl 8 + h_int := hsv[0] and $fffffC00; + f := hsv[0]-h_int; //shl 10 + p := (hsv[2]*(1024-hsv[1])) shr 10; + q := (hsv[2]*(1024-(hsv[1]*f) shr 10)) shr 10; + t := (hsv[2]*(1024-(hsv[1]*(1024-f)) shr 10)) shr 10; + h_int := h_int shr 10; + case h_int of + 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p) + 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p) + 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t) + 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v) + 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v) + 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q) + end; + + PixelColors[0] := clr[0] shr 10; + PixelColors[1] := clr[1] shr 10; + PixelColors[2] := clr[2] shr 10; + + Inc(Pixel, ImgSurface^.format.BytesPerPixel); + end; +end; + +end. diff --git a/src/classes0/UIni.pas b/src/classes0/UIni.pas new file mode 100644 index 00000000..b286c917 --- /dev/null +++ b/src/classes0/UIni.pas @@ -0,0 +1,928 @@ +unit UIni; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes, + IniFiles, + ULog, + SysUtils; + +type + // TInputDeviceConfig stores the configuration for an input device. + // Configurations will be stored in the InputDeviceConfig array. + // Note that not all devices listed in InputDeviceConfig are active devices. + // Some might be unplugged and hence unavailable. + // Available devices are held in TAudioInputProcessor.DeviceList. Each + // TAudioInputDevice listed there has a CfgIndex field which is the index to + // its configuration in the InputDeviceConfig array. + // Name: + // the name of the input device + // Input: + // the index of the input source to use for recording + // ChannelToPlayerMap: + // mapping of recording channels to players, e.g. ChannelToPlayerMap[0] = 2 + // maps the channel 0 (left) to player 2. A player index of 0 means that + // the channel is not assigned to a player. + PInputDeviceConfig = ^TInputDeviceConfig; + TInputDeviceConfig = record + Name: string; + Input: integer; + ChannelToPlayerMap: array of integer; + end; + +type + +//Options + + TVisualizerOption = (voOff, voWhenNoVideo, voOn); + TBackgroundMusicOption = (bmoOff, bmoOn); + TIni = class + private + function RemoveFileExt(FullName: string): string; + function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; + function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; + function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: Boolean = False): integer; + function ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; + IniSection: string; IniProperty: string; Default: integer): integer; + + procedure LoadInputDeviceCfg(IniFile: TMemIniFile); + procedure SaveInputDeviceCfg(IniFile: TIniFile); + procedure LoadThemes(IniFile: TCustomIniFile); + procedure LoadPaths(IniFile: TCustomIniFile); + procedure LoadScreenModes(IniFile: TCustomIniFile); + + public + Name: array[0..11] of string; + + // Templates for Names Mod + NameTeam: array[0..2] of string; + NameTemplate: array[0..11] of string; + + //Filename of the opened iniFile + Filename: string; + + // Game + Players: integer; + Difficulty: integer; + Language: integer; + Tabs: integer; + Tabs_at_startup:integer; //Tabs at Startup fix + Sorting: integer; + Debug: integer; + + // Graphics + Screens: integer; + Resolution: integer; + Depth: integer; + VisualizerOption:integer; + FullScreen: integer; + TextureSize: integer; + SingWindow: integer; + Oscilloscope: integer; + Spectrum: integer; + Spectrograph: integer; + MovieSize: integer; + + // Sound + MicBoost: integer; + ClickAssist: integer; + BeatClick: integer; + SavePlayback: integer; + ThresholdIndex: integer; + AudioOutputBufferSizeIndex:integer; + VoicePassthrough:integer; + + //Song Preview + PreviewVolume: integer; + PreviewFading: integer; + + // Lyrics + LyricsFont: integer; + LyricsEffect: integer; + Solmization: integer; + NoteLines: integer; + + // Themes + Theme: integer; + SkinNo: integer; + Color: integer; + BackgroundMusicOption:integer; + + // Record + InputDeviceConfig: array of TInputDeviceConfig; + + // Advanced + LoadAnimation: integer; + EffectSing: integer; + ScreenFade: integer; + AskBeforeDel: integer; + OnSongClick: integer; + LineBonus: integer; + PartyPopup: integer; + + // Controller + Joypad: integer; + + procedure Load(); + procedure Save(); + procedure SaveNames; + procedure SaveLevel; + end; + +var + Ini: TIni; + IResolution: array of string; + ILanguage: array of string; + ITheme: array of string; + ISkin: array of string; + + + +const + IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); + IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 ); + + IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); + ITabs: array[0..1] of string = ('Off', 'On'); + + ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + sEdition = 0; + sGenre = 1; + sLanguage = 2; + sFolder = 3; + sTitle = 4; + sArtist = 5; + sTitle2 = 6; + sArtist2 = 7; + + IDebug: array[0..1] of string = ('Off', 'On'); + + IScreens: array[0..1] of string = ('1', '2'); + IFullScreen: array[0..1] of string = ('Off', 'On'); + IDepth: array[0..1] of string = ('16 bit', '32 bit'); + IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On'); + + IBackgroundMusic: array[0..1] of string = ('Off', 'On'); + + + ITextureSize: array[0..2] of string = ('128', '256', '512'); + ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512); + + ISingWindow: array[0..1] of string = ('Small', 'Big'); + + //SingBar Mod + IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); +//IOscilloscope: array[0..1] of string = ('Off', 'On'); + + ISpectrum: array[0..1] of string = ('Off', 'On'); + ISpectrograph: array[0..1] of string = ('Off', 'On'); + IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + + IClickAssist: array[0..1] of string = ('Off', 'On'); + IBeatClick: array[0..1] of string = ('Off', 'On'); + ISavePlayback: array[0..1] of string = ('Off', 'On'); + + IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); + IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20); + + IVoicePassthrough: array[0..1] of string = ('Off', 'On'); + + IAudioOutputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); + + IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); + + //Song Preview + IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 ); + + IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 ); + + + ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); + ILyricsEffect: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); + ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); + INoteLines: array[0..1] of string = ('Off', 'On'); + + IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + + // Advanced + ILoadAnimation: array[0..1] of string = ('Off', 'On'); + IEffectSing: array[0..1] of string = ('Off', 'On'); + IScreenFade: array[0..1] of string =('Off', 'On'); + IAskbeforeDel: array[0..1] of string = ('Off', 'On'); + IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); + ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); + IPartyPopup: array[0..1] of string = ('Off', 'On'); + + IJoypad: array[0..1] of string = ('Off', 'On'); + + // Recording options + IChannelPlayer: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); + IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); + +implementation + +uses + StrUtils, + UMain, + SDL, + ULanguage, + UPlatform, + USkins, + URecord, + UCommandLine; + +(** + * Returns the filename without its fileextension + *) +function TIni.RemoveFileExt(FullName: string): string; +begin + Result := ChangeFileExt(FullName, ''); +end; + +(** + * Extracts an index of a key that is surrounded by a Prefix/Suffix pair. + * Example: ExtractKeyIndex('MyKey[1]', '[', ']') will return 1. + *) +function TIni.ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; +var + Value: string; + Start: integer; +begin + Result := -1; + + if Pos(Prefix, Key) > -1 then + begin + Start := Pos(Prefix, Key) + Length(Prefix); + + // copy all between prefix and suffix + Value := Copy(Key, Start, Pos(Suffix, Key)-1 - Start); + Result := StrToIntDef(Value, -1); + end; +end; + +(** + * Finds the maximum key-index in a key-list. + * The indexes of the list are surrounded by Prefix/Suffix, + * e.g. MyKey[1] (Prefix='[', Suffix=']') + *) +function TIni.GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; +var + i: integer; + KeyIndex: integer; +begin + Result := -1; + + for i := 0 to Keys.Count-1 do + begin + KeyIndex := ExtractKeyIndex(Keys[i], Prefix, Suffix); + if (KeyIndex > Result) then + Result := KeyIndex; + end; +end; + +(** + * Returns the index of Value in SearchArray + * or -1 if Value is not in SearchArray. + *) +function TIni.GetArrayIndex(const SearchArray: array of string; Value: string; + CaseInsensitiv: Boolean = False): integer; +var + i: integer; +begin + Result := -1; + + for i := 0 to High(SearchArray) do + begin + if (SearchArray[i] = Value) or + (CaseInsensitiv and (UpperCase(SearchArray[i]) = UpperCase(Value))) then + begin + Result := i; + Break; + end; + end; +end; + +(** + * Reads the property IniSeaction:IniProperty from IniFile and + * finds its corresponding index in SearchArray. + * If SearchArray does not contain the property value, the default value is + * returned. + *) +function TIni.ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; + IniSection: string; IniProperty: string; Default: integer): integer; +var + StrValue: string; +begin + StrValue := IniFile.ReadString(IniSection, IniProperty, SearchArray[Default]); + Result := GetArrayIndex(SearchArray, StrValue); + if (Result = -1) then + begin + Result := Default; + end; +end; + + +procedure TIni.LoadInputDeviceCfg(IniFile: TMemIniFile); +var + DeviceCfg: PInputDeviceConfig; + DeviceIndex: integer; + ChannelCount: integer; + ChannelIndex: integer; + RecordKeys: TStringList; + i: integer; +begin + RecordKeys := TStringList.Create(); + + // read all record-keys for filtering + IniFile.ReadSection('Record', RecordKeys); + + SetLength(InputDeviceConfig, 0); + + for i := 0 to RecordKeys.Count-1 do + begin + // find next device-name + DeviceIndex := ExtractKeyIndex(RecordKeys[i], 'DeviceName[', ']'); + if (DeviceIndex >= 0) then + begin + if not IniFile.ValueExists('Record', Format('DeviceName[%d]', [DeviceIndex])) then + break; + + // resize list + SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1); + + // read an input device's config. + // Note: All devices are appended to the list whether they exist or not. + // Otherwise an external device's config will be lost if it is not + // connected (e.g. singstar mics or USB-Audio devices). + DeviceCfg := @InputDeviceConfig[High(InputDeviceConfig)]; + DeviceCfg.Name := IniFile.ReadString('Record', Format('DeviceName[%d]', [DeviceIndex]), ''); + DeviceCfg.Input := IniFile.ReadInteger('Record', Format('Input[%d]', [DeviceIndex]), 0); + + // find the largest channel-number of the current device in the ini-file + ChannelCount := GetMaxKeyIndex(RecordKeys, 'Channel', Format('[%d]', [DeviceIndex])); + if (ChannelCount < 0) then + ChannelCount := 0; + + SetLength(DeviceCfg.ChannelToPlayerMap, ChannelCount); + + // read channel-to-player mapping for every channel of the current device + // or set non-configured channels to no player (=0). + for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do + begin + DeviceCfg.ChannelToPlayerMap[ChannelIndex] := + IniFile.ReadInteger('Record', Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex]), 0); + end; + end; + end; + + RecordKeys.Free(); + + // MicBoost + //MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off')); + // Threshold + // ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1])); +end; + +procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile); +var + DeviceIndex: integer; + ChannelIndex: integer; +begin + for DeviceIndex := 0 to High(InputDeviceConfig) do + begin + // DeviceName and DeviceInput + IniFile.WriteString('Record', Format('DeviceName[%d]', [DeviceIndex+1]), + InputDeviceConfig[DeviceIndex].Name); + IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]), + InputDeviceConfig[DeviceIndex].Input); + + // Channel-to-Player Mapping + for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do + begin + IniFile.WriteInteger('Record', + Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex+1]), + InputDeviceConfig[DeviceIndex].ChannelToPlayerMap[ChannelIndex]); + end; + end; + + // MicBoost + //IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]); + // Threshold + //IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]); +end; + +procedure TIni.LoadPaths(IniFile: TCustomIniFile); +var + PathStrings: TStringList; + I: integer; +begin + PathStrings := TStringList.Create; + IniFile.ReadSection('Directories', PathStrings); + + // Load song-paths + for I := 0 to PathStrings.Count-1 do + begin + if (AnsiStartsText('SongDir', PathStrings[I])) then + begin + AddSongPath(IniFile.ReadString('Directories', PathStrings[I], '')); + end; + end; + + PathStrings.Free; +end; + +procedure TIni.LoadThemes(IniFile: TCustomIniFile); +var + SearchResult: TSearchRec; + ThemeIni: TMemIniFile; + ThemeName: string; + I: integer; +begin + // Theme + SetLength(ITheme, 0); + Log.LogStatus('Searching for Theme : ' + ThemePath + '*.ini', 'Theme'); + + FindFirst(ThemePath + '*.ini',faAnyFile, SearchResult); + Repeat + Log.LogStatus('Found Theme: ' + SearchResult.Name, 'Theme'); + + //Read Themename from Theme + ThemeIni := TMemIniFile.Create(SearchResult.Name); + ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', RemoveFileExt(SearchResult.Name))); + ThemeIni.Free; + + //Search for Skins for this Theme + for I := Low(Skin.Skin) to High(Skin.Skin) do + begin + if UpperCase(Skin.Skin[I].Theme) = ThemeName then + begin + SetLength(ITheme, Length(ITheme)+1); + ITheme[High(ITheme)] := RemoveFileExt(SearchResult.Name); + break; + end; + end; + until FindNext(SearchResult) <> 0; + FindClose(SearchResult); + + // No Theme Found + if (Length(ITheme) = 0) then + begin + Log.CriticalError('Could not find any valid Themes.'); + end; + + Theme := GetArrayIndex(ITheme, IniFile.ReadString('Themes', 'Theme', 'DELUXE'), true); + if (Theme = -1) then + Theme := 0; + + // Skin + Skin.onThemeChange; + + SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[0])); +end; + +procedure TIni.LoadScreenModes(IniFile: TCustomIniFile); + + // swap two strings + procedure swap(var s1, s2: string); + var + s3: string; + begin + s3 := s1; + s1 := s2; + s2 := s3; + end; + +var + Modes: PPSDL_Rect; + I: integer; +begin + // Screens + Screens := GetArrayIndex(IScreens, IniFile.ReadString('Graphics', 'Screens', IScreens[0])); + + // FullScreen + FullScreen := GetArrayIndex(IFullScreen, IniFile.ReadString('Graphics', 'FullScreen', 'On')); + + // Resolution + SetLength(IResolution, 0); + + // Check if there are any modes available + // TODO: we should seperate windowed and fullscreen modes. Otherwise it is not + // possible to select a reasonable fullscreen mode when in windowed mode + if IFullScreen[FullScreen] = 'On' then + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN or SDL_RESIZABLE) + else + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ; + + if (Modes = nil) then + begin + Log.LogStatus( 'No resolutions Found' , 'Video'); + end + else if (Modes = PPSDL_Rect(-1)) then + begin + // Fallback to some standard resolutions + SetLength(IResolution, 10); + IResolution[0] := '640x480'; + IResolution[1] := '800x600'; + IResolution[2] := '1024x768'; + IResolution[3] := '1152x864'; + IResolution[4] := '1280x800'; + IResolution[5] := '1280x960'; + IResolution[6] := '1400x1050'; + IResolution[7] := '1440x900'; + IResolution[8] := '1600x1200'; + IResolution[9] := '1680x1050'; + + Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); + if Resolution = -1 then + begin + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IniFile.ReadString('Graphics', 'Resolution', '800x600'); + Resolution := High(IResolution); + end; + end + else + begin + while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) + begin + Log.LogStatus( 'Found Video Mode : ' + IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h) , 'Video'); + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); + Inc(Modes); + end; + + // reverse order + for I := 0 to (Length(IResolution) div 2) - 1 do + begin + swap(IResolution[I], IResolution[High(IResolution)-I]); + end; + Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); + + if Resolution = -1 then + begin + Resolution := GetArrayIndex(IResolution, '800x600'); + if Resolution = -1 then + Resolution := 0; + end; + end; + + // if no modes were set, then failback to 800x600 + // as per http://sourceforge.net/forum/message.php?msg_id=4544965 + // THANKS : linnex at users.sourceforge.net + if Length(IResolution) < 1 then + begin + Log.LogStatus( 'Found Video Mode : NONE !!! ( Defaulted to 800 x 600 )', 'Video'); + SetLength(IResolution, 1); + IResolution[0] := '800x600'; + Resolution := 0; + Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[0] , 'Graphics - Resolutions'); + + // Default to fullscreen OFF, in this case ! + FullScreen := 0; + end; + + // Depth + Depth := GetArrayIndex(IDepth, IniFile.ReadString('Graphics', 'Depth', '32 bit')); +end; + +procedure TIni.Load(); +var + IniFile: TMemIniFile; + I: integer; +begin + GamePath := Platform.GetGameUserPath; + + Log.LogStatus( 'GamePath : ' +GamePath , '' ); + + if (Params.ConfigFile <> '') then + try + FileName := Params.ConfigFile; + except + FileName := GamePath + 'config.ini'; + end + else + FileName := GamePath + 'config.ini'; + + Log.LogStatus( 'Using config : ' + FileName , 'Ini'); + IniFile := TMemIniFile.Create( FileName ); + + // Name + for I := 0 to 11 do + Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); + + // Templates for Names Mod + for I := 0 to 2 do + NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); + for I := 0 to 11 do + NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); + + // Players + Players := GetArrayIndex(IPlayers, IniFile.ReadString('Game', 'Players', IPlayers[0])); + + // Difficulty + Difficulty := GetArrayIndex(IDifficulty, IniFile.ReadString('Game', 'Difficulty', 'Easy')); + + // Language + Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English')); + //Language.ChangeLanguage(ILanguage[Language]); + + // Tabs + Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0])); + Tabs_at_startup := Tabs; //Tabs at Startup fix + + // Song Sorting + Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0])); + + // Debug + Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0])); + + LoadScreenModes(IniFile); + + // TextureSize + TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1])); + + // SingWindow + SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big')); + + // Oscilloscope + Oscilloscope := GetArrayIndex(IOscilloscope, IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar')); + + // Spectrum + Spectrum := GetArrayIndex(ISpectrum, IniFile.ReadString('Graphics', 'Spectrum', 'Off')); + + // Spectrograph + Spectrograph := GetArrayIndex(ISpectrograph, IniFile.ReadString('Graphics', 'Spectrograph', 'Off')); + + // MovieSize + MovieSize := GetArrayIndex(IMovieSize, IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2])); + + // ClickAssist + ClickAssist := GetArrayIndex(IClickAssist, IniFile.ReadString('Sound', 'ClickAssist', 'Off')); + + // BeatClick + BeatClick := GetArrayIndex(IBeatClick, IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0])); + + // SavePlayback + SavePlayback := GetArrayIndex(ISavePlayback, IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0])); + + // AudioOutputBufferSize + AudioOutputBufferSizeIndex := ReadArrayIndex(IAudioOutputBufferSize, IniFile, 'Sound', 'AudioOutputBufferSize', 0); + + //Preview Volume + PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7])); + + //Preview Fading + PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1])); + + //AudioRepeat aka VoicePassthrough + VoicePassthrough := GetArrayIndex(IVoicePassthrough, IniFile.ReadString('Sound', 'VoicePassthrough', IVoicePassthrough[0])); + + // Lyrics Font + LyricsFont := GetArrayIndex(ILyricsFont, IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1])); + + // Lyrics Effect + LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1])); + + // Solmization + Solmization := GetArrayIndex(ISolmization, IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0])); + + // NoteLines + NoteLines := GetArrayIndex(INoteLines, IniFile.ReadString('Lyrics', 'NoteLines', INoteLines[1])); + + LoadThemes(IniFile); + + // Color + Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[0])); + + LoadInputDeviceCfg(IniFile); + + // LoadAnimation + LoadAnimation := GetArrayIndex(ILoadAnimation, IniFile.ReadString('Advanced', 'LoadAnimation', 'On')); + + // ScreenFade + ScreenFade := GetArrayIndex(IScreenFade, IniFile.ReadString('Advanced', 'ScreenFade', 'On')); + + // Visualizations + // this could be of use later.. + // VisualizerOption := + // TVisualizerOption(GetEnumValue(TypeInfo(TVisualizerOption), + // IniFile.ReadString('Graphics', 'Visualization', 'Off'))); + // || VisualizerOption := TVisualizerOption(GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off'))); + VisualizerOption := GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off')); + +{** + * Background music + *} + BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'Off')); + + // EffectSing + EffectSing := GetArrayIndex(IEffectSing, IniFile.ReadString('Advanced', 'EffectSing', 'On')); + + // AskbeforeDel + AskBeforeDel := GetArrayIndex(IAskbeforeDel, IniFile.ReadString('Advanced', 'AskbeforeDel', 'On')); + + // OnSongClick + OnSongClick := GetArrayIndex(IOnSongClick, IniFile.ReadString('Advanced', 'OnSongClick', 'Sing')); + + // Linebonus + LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', 'At Score')); + + // PartyPopup + PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On')); + + // Joypad + Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0])); + + LoadPaths(IniFile); + + IniFile.Free; +end; + +procedure TIni.Save; +var + IniFile: TIniFile; +begin + if (FileExists(Filename) and FileIsReadOnly(Filename)) then + begin + Log.LogError('Config-file is read-only', 'TIni.Save'); + Exit; + end; + + IniFile := TIniFile.Create(Filename); + + // Players + IniFile.WriteString('Game', 'Players', IPlayers[Players]); + + // Difficulty + IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]); + + // Language + IniFile.WriteString('Game', 'Language', ILanguage[Language]); + + // Tabs + IniFile.WriteString('Game', 'Tabs', ITabs[Tabs]); + + // Sorting + IniFile.WriteString('Game', 'Sorting', ISorting[Sorting]); + + // Debug + IniFile.WriteString('Game', 'Debug', IDebug[Debug]); + + // Screens + IniFile.WriteString('Graphics', 'Screens', IScreens[Screens]); + + // FullScreen + IniFile.WriteString('Graphics', 'FullScreen', IFullScreen[FullScreen]); + + // Visualization + IniFile.WriteString('Graphics', 'Visualization', IVisualizer[VisualizerOption]); + + // Resolution + IniFile.WriteString('Graphics', 'Resolution', IResolution[Resolution]); + + // Depth + IniFile.WriteString('Graphics', 'Depth', IDepth[Depth]); + + // TextureSize + IniFile.WriteString('Graphics', 'TextureSize', ITextureSize[TextureSize]); + + // Sing Window + IniFile.WriteString('Graphics', 'SingWindow', ISingWindow[SingWindow]); + + // Oscilloscope + IniFile.WriteString('Graphics', 'Oscilloscope', IOscilloscope[Oscilloscope]); + + // Spectrum + IniFile.WriteString('Graphics', 'Spectrum', ISpectrum[Spectrum]); + + // Spectrograph + IniFile.WriteString('Graphics', 'Spectrograph', ISpectrograph[Spectrograph]); + + // Movie Size + IniFile.WriteString('Graphics', 'MovieSize', IMovieSize[MovieSize]); + + // ClickAssist + IniFile.WriteString('Sound', 'ClickAssist', IClickAssist[ClickAssist]); + + // BeatClick + IniFile.WriteString('Sound', 'BeatClick', IBeatClick[BeatClick]); + + // AudioOutputBufferSize + IniFile.WriteString('Sound', 'AudioOutputBufferSize', IAudioOutputBufferSize[AudioOutputBufferSizeIndex]); + + // Background music + IniFile.WriteString('Sound', 'BackgroundMusic', IBackgroundMusic[BackgroundMusicOption]); + + // Song Preview + IniFile.WriteString('Sound', 'PreviewVolume', IPreviewVolume[PreviewVolume]); + + // PreviewFading + IniFile.WriteString('Sound', 'PreviewFading', IPreviewFading[PreviewFading]); + + // SavePlayback + IniFile.WriteString('Sound', 'SavePlayback', ISavePlayback[SavePlayback]); + + // VoicePasstrough + IniFile.WriteString('Sound', 'VoicePassthrough', IVoicePassthrough[VoicePassthrough]); + + // Lyrics Font + IniFile.WriteString('Lyrics', 'LyricsFont', ILyricsFont[LyricsFont]); + + // Lyrics Effect + IniFile.WriteString('Lyrics', 'LyricsEffect', ILyricsEffect[LyricsEffect]); + + // Solmization + IniFile.WriteString('Lyrics', 'Solmization', ISolmization[Solmization]); + + // NoteLines + IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]); + + // Theme + IniFile.WriteString('Themes', 'Theme', ITheme[Theme]); + + // Skin + IniFile.WriteString('Themes', 'Skin', ISkin[SkinNo]); + + // Color + IniFile.WriteString('Themes', 'Color', IColor[Color]); + + SaveInputDeviceCfg(IniFile); + + //LoadAnimation + IniFile.WriteString('Advanced', 'LoadAnimation', ILoadAnimation[LoadAnimation]); + + //EffectSing + IniFile.WriteString('Advanced', 'EffectSing', IEffectSing[EffectSing]); + + //ScreenFade + IniFile.WriteString('Advanced', 'ScreenFade', IScreenFade[ScreenFade]); + + //AskbeforeDel + IniFile.WriteString('Advanced', 'AskbeforeDel', IAskbeforeDel[AskBeforeDel]); + + //OnSongClick + IniFile.WriteString('Advanced', 'OnSongClick', IOnSongClick[OnSongClick]); + + //Line Bonus + IniFile.WriteString('Advanced', 'LineBonus', ILineBonus[LineBonus]); + + //Party Popup + IniFile.WriteString('Advanced', 'PartyPopup', IPartyPopup[PartyPopup]); + + // Joypad + IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]); + + // Directories (add a template if section is missing) + if (not IniFile.SectionExists('Directories')) then + IniFile.WriteString('Directories', 'SongDir1', ''); + + IniFile.Free; +end; + +procedure TIni.SaveNames; +var + IniFile: TIniFile; + I: integer; +begin + if not FileIsReadOnly(Filename) then + begin + IniFile := TIniFile.Create(Filename); + + //Name Templates for Names Mod + for I := 1 to 12 do + IniFile.WriteString('Name', 'P' + IntToStr(I), Name[I-1]); + for I := 1 to 3 do + IniFile.WriteString('NameTeam', 'T' + IntToStr(I), NameTeam[I-1]); + for I := 1 to 12 do + IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), NameTemplate[I-1]); + + IniFile.Free; + end; +end; + +procedure TIni.SaveLevel; +var + IniFile: TIniFile; +begin + if not FileIsReadOnly(Filename) then + begin + IniFile := TIniFile.Create(Filename); + + // Difficulty + IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]); + + IniFile.Free; + end; +end; + +end. diff --git a/src/classes0/UJoystick.pas b/src/classes0/UJoystick.pas new file mode 100644 index 00000000..0ca7ba09 --- /dev/null +++ b/src/classes0/UJoystick.pas @@ -0,0 +1,282 @@ +unit UJoystick; + +interface + +{$I switches.inc} + + +uses SDL; + +type + TJoyButton = record + State: integer; + Enabled: boolean; + Type_: byte; + Sym: cardinal; + end; + + TJoyHatState = record + State: Boolean; + LastTick: Cardinal; + Enabled: boolean; + Type_: byte; + Sym: cardinal; + end; + + TJoyUnit = record + Button: array[0..15] of TJoyButton; + HatState: Array[0..3] of TJoyHatState; + end; + + TJoy = class + constructor Create; + procedure Update; + end; + +var + Joy: TJoy; + JoyUnit: TJoyUnit; + SDL_Joy: PSDL_Joystick; + JoyEvent: TSDL_Event; + +implementation + +uses SysUtils, + ULog; + +constructor TJoy.Create; +var + B, N: integer; +begin + inherited; + + //Old Corvus5 Method + {// joystick support + SDL_JoystickEventState(SDL_IGNORE); + SDL_InitSubSystem(SDL_INIT_JOYSTICK); + if SDL_NumJoysticks <> 1 then + Log.LogStatus('Joystick count <> 1', 'TJoy.Create'); + + SDL_Joy := SDL_JoystickOpen(0); + if SDL_Joy = nil then + Log.LogError('SDL_JoystickOpen failed', 'TJoy.Create'); + + if SDL_JoystickNumButtons(SDL_Joy) <> 16 then + Log.LogStatus('Joystick button count <> 16', 'TJoy.Create'); + +// SDL_JoystickEventState(SDL_ENABLE); + // Events don't work - thay hang the whole application with SDL_JoystickEventState(SDL_ENABLE) + + // clear states + for B := 0 to 15 do + JoyUnit.Button[B].State := 1; + + // mapping + JoyUnit.Button[1].Enabled := true; + JoyUnit.Button[1].Type_ := SDL_KEYDOWN; + JoyUnit.Button[1].Sym := SDLK_RETURN; + JoyUnit.Button[2].Enabled := true; + JoyUnit.Button[2].Type_ := SDL_KEYDOWN; + JoyUnit.Button[2].Sym := SDLK_ESCAPE; + + JoyUnit.Button[12].Enabled := true; + JoyUnit.Button[12].Type_ := SDL_KEYDOWN; + JoyUnit.Button[12].Sym := SDLK_LEFT; + JoyUnit.Button[13].Enabled := true; + JoyUnit.Button[13].Type_ := SDL_KEYDOWN; + JoyUnit.Button[13].Sym := SDLK_DOWN; + JoyUnit.Button[14].Enabled := true; + JoyUnit.Button[14].Type_ := SDL_KEYDOWN; + JoyUnit.Button[14].Sym := SDLK_RIGHT; + JoyUnit.Button[15].Enabled := true; + JoyUnit.Button[15].Type_ := SDL_KEYDOWN; + JoyUnit.Button[15].Sym := SDLK_UP; + } + //New Sarutas method + SDL_JoystickEventState(SDL_IGNORE); + SDL_InitSubSystem(SDL_INIT_JOYSTICK); + if SDL_NumJoysticks < 1 then + begin + Log.LogError('No Joystick found'); + exit; + end; + + + SDL_Joy := SDL_JoystickOpen(0); + if SDL_Joy = nil then + begin + Log.LogError('Could not Init Joystick'); + exit; + end; + N := SDL_JoystickNumButtons(SDL_Joy); + //if N < 6 then Log.LogStatus('Joystick button count < 6', 'TJoy.Create'); + + for B := 0 to 5 do begin + JoyUnit.Button[B].Enabled := true; + JoyUnit.Button[B].State := 1; + JoyUnit.Button[B].Type_ := SDL_KEYDOWN; + end; + + JoyUnit.Button[0].Sym := SDLK_Return; + JoyUnit.Button[1].Sym := SDLK_Escape; + JoyUnit.Button[2].Sym := SDLK_M; + JoyUnit.Button[3].Sym := SDLK_R; + + JoyUnit.Button[4].Sym := SDLK_RETURN; + JoyUnit.Button[5].Sym := SDLK_ESCAPE; + + //Set HatState + for B := 0 to 3 do begin + JoyUnit.HatState[B].Enabled := true; + JoyUnit.HatState[B].State := False; + JoyUnit.HatState[B].Type_ := SDL_KEYDOWN; + end; + + JoyUnit.HatState[0].Sym := SDLK_UP; + JoyUnit.HatState[1].Sym := SDLK_RIGHT; + JoyUnit.HatState[2].Sym := SDLK_DOWN; + JoyUnit.HatState[3].Sym := SDLK_LEFT; +end; + +procedure TJoy.Update; +var + B: integer; + State: UInt8; + Tick: Cardinal; + Axes: Smallint; +begin + SDL_JoystickUpdate; + + //Manage Buttons + for B := 0 to 15 do begin + if (JoyUnit.Button[B].Enabled) and (JoyUnit.Button[B].State <> SDL_JoystickGetButton(SDL_Joy, B)) and (JoyUnit.Button[B].State = 0) then begin + JoyEvent.type_ := JoyUnit.Button[B].Type_; + JoyEvent.key.keysym.sym := JoyUnit.Button[B].Sym; + SDL_PushEvent(@JoyEvent); + end; + end; + + + for B := 0 to 15 do begin + JoyUnit.Button[B].State := SDL_JoystickGetButton(SDL_Joy, B); + end; + + //Get Tick + Tick := SDL_GetTicks(); + + //Get CoolieHat + if (SDL_JoystickNumHats(SDL_Joy)>=1) then + State := SDL_JoystickGetHat(SDL_Joy, 0) + else + State := 0; + + //Get Axis + if (SDL_JoystickNumAxes(SDL_Joy)>=2) then + begin + //Down - Up (X- Axis) + Axes := SDL_JoystickGetAxis(SDL_Joy, 1); + If Axes >= 15000 then + State := State or SDL_HAT_Down + Else If Axes <= -15000 then + State := State or SDL_HAT_UP; + + //Left - Right (Y- Axis) + Axes := SDL_JoystickGetAxis(SDL_Joy, 0); + If Axes >= 15000 then + State := State or SDL_HAT_Right + Else If Axes <= -15000 then + State := State or SDL_HAT_Left; + end; + + //Manage Hat and joystick Events + if (SDL_JoystickNumHats(SDL_Joy)>=1) OR (SDL_JoystickNumAxes(SDL_Joy)>=2) then + begin + + //Up Button + If (JoyUnit.HatState[0].Enabled) and ((SDL_HAT_UP AND State) = SDL_HAT_UP) then + begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs + if (JoyUnit.HatState[0].State = False) OR (JoyUnit.HatState[0].Lasttick < Tick) then + begin + //Set Tick and State + if JoyUnit.HatState[0].State then + JoyUnit.HatState[0].Lasttick := Tick + 200 + else + JoyUnit.HatState[0].Lasttick := Tick + 500; + + JoyUnit.HatState[0].State := True; + + JoyEvent.type_ := JoyUnit.HatState[0].Type_; + JoyEvent.key.keysym.sym := JoyUnit.HatState[0].Sym; + SDL_PushEvent(@JoyEvent); + end; + end + else + JoyUnit.HatState[0].State := False; + + //Right Button + If (JoyUnit.HatState[1].Enabled) and ((SDL_HAT_RIGHT AND State) = SDL_HAT_RIGHT) then + begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs + if (JoyUnit.HatState[1].State = False) OR (JoyUnit.HatState[1].Lasttick < Tick) then + begin + //Set Tick and State + if JoyUnit.HatState[1].State then + JoyUnit.HatState[1].Lasttick := Tick + 200 + else + JoyUnit.HatState[1].Lasttick := Tick + 500; + + JoyUnit.HatState[1].State := True; + + JoyEvent.type_ := JoyUnit.HatState[1].Type_; + JoyEvent.key.keysym.sym := JoyUnit.HatState[1].Sym; + SDL_PushEvent(@JoyEvent); + end; + end + else + JoyUnit.HatState[1].State := False; + + //Down button + If (JoyUnit.HatState[2].Enabled) and ((SDL_HAT_DOWN AND State) = SDL_HAT_DOWN) then + begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs + if (JoyUnit.HatState[2].State = False) OR (JoyUnit.HatState[2].Lasttick < Tick) then + begin + //Set Tick and State + if JoyUnit.HatState[2].State then + JoyUnit.HatState[2].Lasttick := Tick + 200 + else + JoyUnit.HatState[2].Lasttick := Tick + 500; + + JoyUnit.HatState[2].State := True; + + JoyEvent.type_ := JoyUnit.HatState[2].Type_; + JoyEvent.key.keysym.sym := JoyUnit.HatState[2].Sym; + SDL_PushEvent(@JoyEvent); + end; + end + else + JoyUnit.HatState[2].State := False; + + //Left Button + If (JoyUnit.HatState[3].Enabled) and ((SDL_HAT_LEFT AND State) = SDL_HAT_LEFT) then + begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs + if (JoyUnit.HatState[3].State = False) OR (JoyUnit.HatState[3].Lasttick < Tick) then + begin + //Set Tick and State + if JoyUnit.HatState[3].State then + JoyUnit.HatState[3].Lasttick := Tick + 200 + else + JoyUnit.HatState[3].Lasttick := Tick + 500; + + JoyUnit.HatState[3].State := True; + + JoyEvent.type_ := JoyUnit.HatState[3].Type_; + JoyEvent.key.keysym.sym := JoyUnit.HatState[3].Sym; + SDL_PushEvent(@JoyEvent); + end; + end + else + JoyUnit.HatState[3].State := False; + end; + +end; + +end. diff --git a/src/classes0/ULCD.pas b/src/classes0/ULCD.pas new file mode 100644 index 00000000..82f7ba2f --- /dev/null +++ b/src/classes0/ULCD.pas @@ -0,0 +1,304 @@ +unit ULCD; + +interface + +{$I switches.inc} + +type + TLCD = class + private + Enabled: boolean; + Text: array[1..6] of string; + StartPos: integer; + LineBR: integer; + Position: integer; + procedure WriteCommand(B: byte); + procedure WriteData(B: byte); + procedure WriteString(S: string); + public + HalfInterface: boolean; + constructor Create; + procedure Enable; + procedure Clear; + procedure WriteText(Line: integer; S: string); + procedure MoveCursor(Line, Pos: integer); + procedure ShowCursor; + procedure HideCursor; + + // for 2x16 + procedure AddTextBR(S: string); + procedure MoveCursorBR(Pos: integer); + procedure ScrollUpBR; + procedure AddTextArray(Line:integer; S: string); + end; + +var + LCD: TLCD; + +const + Data = $378; // domyœlny adres portu + Status = Data + 1; + Control = Data + 2; + +implementation + +uses + SysUtils, + {$IFDEF UseSerialPort} + zlportio, + {$ENDIF} + SDL, + UTime; + +procedure TLCD.WriteCommand(B: Byte); +// Wysylanie komend sterujacych +begin +{$IFDEF UseSerialPort} + if not HalfInterface then + begin + zlioportwrite(Control, 0, $02); + zlioportwrite(Data, 0, B); + zlioportwrite(Control, 0, $03); + end + else + begin + zlioportwrite(Control, 0, $02); + zlioportwrite(Data, 0, B and $F0); + zlioportwrite(Control, 0, $03); + + SDL_Delay( 100 ); + + zlioportwrite(Control, 0, $02); + zlioportwrite(Data, 0, (B * 16) and $F0); + zlioportwrite(Control, 0, $03); + end; + + if (B=1) or (B=2) then + Sleep(2) + else + SDL_Delay( 100 ); +{$ENDIF} +end; + +procedure TLCD.WriteData(B: Byte); +// Wysylanie danych +begin +{$IFDEF UseSerialPort} + if not HalfInterface then + begin + zlioportwrite(Control, 0, $06); + zlioportwrite(Data, 0, B); + zlioportwrite(Control, 0, $07); + end + else + begin + zlioportwrite(Control, 0, $06); + zlioportwrite(Data, 0, B and $F0); + zlioportwrite(Control, 0, $07); + + SDL_Delay( 100 ); + + zlioportwrite(Control, 0, $06); + zlioportwrite(Data, 0, (B * 16) and $F0); + zlioportwrite(Control, 0, $07); + end; + + SDL_Delay( 100 ); + Inc(Position); +{$ENDIF} +end; + +procedure TLCD.WriteString(S: string); +// Wysylanie slow +var + I: integer; +begin + for I := 1 to Length(S) do + WriteData(Ord(S[I])); +end; + +constructor TLCD.Create; +begin + inherited; +end; + +procedure TLCD.Enable; +{var + A: byte; + B: byte;} +begin + Enabled := true; + if not HalfInterface then + WriteCommand($38) + else begin + WriteCommand($33); + WriteCommand($32); + WriteCommand($28); + end; + +// WriteCommand($06); +// WriteCommand($0C); +// sleep(10); +end; + +procedure TLCD.Clear; +begin + if Enabled then begin + WriteCommand(1); + WriteCommand(2); + Text[1] := ''; + Text[2] := ''; + Text[3] := ''; + Text[4] := ''; + Text[5] := ''; + Text[6] := ''; + StartPos := 1; + LineBR := 1; + end; +end; + +procedure TLCD.WriteText(Line: integer; S: string); +begin + if Enabled then begin + if Line <= 2 then begin + MoveCursor(Line, 1); + WriteString(S); + end; + + Text[Line] := ''; + AddTextArray(Line, S); + end; +end; + +procedure TLCD.MoveCursor(Line, Pos: integer); +var + I: integer; +begin + if Enabled then begin + Pos := Pos + (Line-1) * 40; + + if Position > Pos then begin + WriteCommand(2); + for I := 1 to Pos-1 do + WriteCommand(20); + end; + + if Position < Pos then + for I := 1 to Pos - Position do + WriteCommand(20); + + Position := Pos; + end; +end; + +procedure TLCD.ShowCursor; +begin + if Enabled then begin + WriteCommand(14); + end; +end; + +procedure TLCD.HideCursor; +begin + if Enabled then begin + WriteCommand(12); + end; +end; + +procedure TLCD.AddTextBR(S: string); +var + Word: string; +// W: integer; + P: integer; + L: integer; +begin + if Enabled then begin + if LineBR <= 6 then begin + L := LineBR; + P := Pos(' ', S); + + if L <= 2 then + MoveCursor(L, 1); + + while (L <= 6) and (P > 0) do begin + Word := Copy(S, 1, P); + if (Length(Text[L]) + Length(Word)-1) > 16 then begin + L := L + 1; + if L <= 2 then + MoveCursor(L, 1); + end; + + if L <= 6 then begin + if L <= 2 then + WriteString(Word); + AddTextArray(L, Word); + end; + + Delete(S, 1, P); + P := Pos(' ', S) + end; + + LineBR := L + 1; + end; + end; +end; + +procedure TLCD.MoveCursorBR(Pos: integer); +{var + I: integer; + L: integer;} +begin + if Enabled then begin + Pos := Pos - (StartPos-1); + if Pos <= Length(Text[1]) then + MoveCursor(1, Pos); + + if Pos > Length(Text[1]) then begin + // bez zawijania +// Pos := Pos - Length(Text[1]); +// MoveCursor(2, Pos); + + // z zawijaniem + Pos := Pos - Length(Text[1]); + ScrollUpBR; + MoveCursor(1, Pos); + end; + end; +end; + +procedure TLCD.ScrollUpBR; +var + T: array[1..5] of string; + SP: integer; + LBR: integer; +begin + if Enabled then begin + T[1] := Text[2]; + T[2] := Text[3]; + T[3] := Text[4]; + T[4] := Text[5]; + T[5] := Text[6]; + SP := StartPos + Length(Text[1]); + LBR := LineBR; + + Clear; + + StartPos := SP; + WriteText(1, T[1]); + WriteText(2, T[2]); + WriteText(3, T[3]); + WriteText(4, T[4]); + WriteText(5, T[5]); + LineBR := LBR-1; + end; +end; + +procedure TLCD.AddTextArray(Line: integer; S: string); +begin + if Enabled then begin + Text[Line] := Text[Line] + S; + end; +end; + +end. + diff --git a/src/classes0/ULanguage.pas b/src/classes0/ULanguage.pas new file mode 100644 index 00000000..d534b4e1 --- /dev/null +++ b/src/classes0/ULanguage.pas @@ -0,0 +1,240 @@ +unit ULanguage; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +type + TLanguageEntry = record + ID: string; + Text: string; + end; + + TLanguageList = record + Name: string; + {FileName: string; } + end; + + TLanguage = class + public + Entry: array of TLanguageEntry; //Entrys of Chosen Language + SEntry: array of TLanguageEntry; //Entrys of Standard Language + CEntry: array of TLanguageEntry; //Constant Entrys e.g. Version + Implode_Glue1, Implode_Glue2: String; + public + List: array of TLanguageList; + + constructor Create; + procedure LoadList; + function Translate(Text: String): String; + procedure ChangeLanguage(Language: String); + procedure AddConst(ID, Text: String); + procedure ChangeConst(ID, Text: String); + function Implode(Pieces: Array of String): String; + end; + +var + Language: TLanguage; + +implementation + +uses UMain, + // UFiles, + UIni, + IniFiles, + Classes, + SysUtils, + {$IFDEF win32} + windows, + {$ENDIF} + ULog; + +//---------- +//Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues +//---------- +constructor TLanguage.Create; +var + I, J: Integer; +begin + inherited; + + LoadList; + + //Set Implode Glues for Backward Compatibility + Implode_Glue1 := ', '; + Implode_Glue2 := ' and '; + + if (Length(List) = 0) then //No Language Files Loaded -> Abort Loading + Log.CriticalError('Could not load any Language File'); + + //Standard Language (If a Language File is Incomplete) + //Then use English Language + for I := 0 to high(List) do //Search for English Language + begin + //English Language Found -> Load + if Uppercase(List[I].Name) = 'ENGLISH' then + begin + ChangeLanguage('English'); + + SetLength(SEntry, Length(Entry)); + for J := low(Entry) to high(Entry) do + SEntry[J] := Entry[J]; + + SetLength(Entry, 0); + + Break; + end; + + if (I = high(List)) then + Log.LogError('English Languagefile missing! No standard Translation loaded'); + end; + //Standard Language END + +end; + +//---------- +//LoadList - Parse the Language Dir searching Translations +//---------- +procedure TLanguage.LoadList; +var + SR: TSearchRec; // for parsing directory +begin + SetLength(List, 0); + SetLength(ILanguage, 0); + + if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then begin + repeat + SetLength(List, Length(List)+1); + SetLength(ILanguage, Length(ILanguage)+1); + SR.Name := ChangeFileExt(SR.Name, ''); + + List[High(List)].Name := SR.Name; + ILanguage[High(ILanguage)] := SR.Name; + + until FindNext(SR) <> 0; + SysUtils.FindClose(SR); + end; // if FindFirst +end; + +//---------- +//ChangeLanguage - Load the specified LanguageFile +//---------- +procedure TLanguage.ChangeLanguage(Language: String); +var + IniFile: TIniFile; + E: integer; // entry + S: TStringList; +begin + SetLength(Entry, 0); + IniFile := TIniFile.Create(LanguagesPath + Language + '.ini'); + S := TStringList.Create; + + IniFile.ReadSectionValues('Text', S); + SetLength(Entry, S.Count); + for E := 0 to high(Entry) do + begin + if S.Names[E] = 'IMPLODE_GLUE1' then + Implode_Glue1 := S.ValueFromIndex[E]+ ' ' + else if S.Names[E] = 'IMPLODE_GLUE2' then + Implode_Glue2 := ' ' + S.ValueFromIndex[E] + ' '; + + Entry[E].ID := S.Names[E]; + Entry[E].Text := S.ValueFromIndex[E]; + end; + + S.Free; + IniFile.Free; +end; + +//---------- +//Translate - Translate the Text +//---------- +Function TLanguage.Translate(Text: String): String; +var + E: integer; // entry +begin + Result := Text; + Text := Uppercase(Result); + + //Const Mod + for E := 0 to high(CEntry) do + if Text = CEntry[E].ID then + begin + Result := CEntry[E].Text; + exit; + end; + //Const Mod End + + for E := 0 to high(Entry) do + if Text = Entry[E].ID then + begin + Result := Entry[E].Text; + exit; + end; + + //Standard Language (If a Language File is Incomplete) + //Then use Standard Language + for E := low(SEntry) to high(SEntry) do + if Text = SEntry[E].ID then + begin + Result := SEntry[E].Text; + Break; + end; + //Standard Language END +end; + +//---------- +//AddConst - Add a Constant ID that will be Translated but not Loaded from the LanguageFile +//---------- +procedure TLanguage.AddConst (ID, Text: String); +begin + SetLength (CEntry, Length(CEntry) + 1); + CEntry[high(CEntry)].ID := ID; + CEntry[high(CEntry)].Text := Text; +end; + +//---------- +//ChangeConst - Change a Constant Value by ID +//---------- +procedure TLanguage.ChangeConst(ID, Text: String); +var + I: Integer; +begin + for I := 0 to high(CEntry) do + begin + if CEntry[I].ID = ID then + begin + CEntry[I].Text := Text; + Break; + end; + end; +end; + +//---------- +//Implode - Connect an Array of Strings with ' and ' or ', ' to one String +//---------- +function TLanguage.Implode(Pieces: Array of String): String; +var + I: Integer; +begin + Result := ''; + //Go through Pieces + for I := low(Pieces) to high(Pieces) do + begin + //Add Value + Result := Result + Pieces[I]; + + //Add Glue + if (I < high(Pieces) - 1) then + Result := Result + Implode_Glue1 + else if (I < high(Pieces)) then + Result := Result + Implode_Glue2; + end; +end; + +end. diff --git a/src/classes0/ULight.pas b/src/classes0/ULight.pas new file mode 100644 index 00000000..a0a399ab --- /dev/null +++ b/src/classes0/ULight.pas @@ -0,0 +1,145 @@ +unit ULight; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +type + TLight = class + private + Enabled: boolean; + Light: array[0..7] of boolean; + LightTime: array[0..7] of real; // time to stop, need to call update to change state + LastTime: real; + public + constructor Create; + procedure Enable; + procedure SetState(State: integer); + procedure AutoSetState; + procedure TurnOn; + procedure TurnOff; + procedure LightOne(Number: integer; Time: real); + procedure Refresh; + end; + +var + Light: TLight; + +const + Data = $378; // default port address + Status = Data + 1; + Control = Data + 2; + +implementation + +uses + SysUtils, + {$IFDEF UseSerialPort} + zlportio, + {$ENDIF} + UTime; + +{$IFDEF FPC} + + function GetTime: TDateTime; + var + SystemTime: TSystemTime; + begin + GetLocalTime(SystemTime); + with SystemTime do + begin + {$IFDEF UNIX} + Result := EncodeTime(Hour, Minute, Second, MilliSecond); + {$ELSE} + Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds); + {$ENDIF} + end; + end; + +{$ENDIF} + + +constructor TLight.Create; +begin + inherited; + Enabled := false; +end; + +procedure TLight.Enable; +begin + Enabled := true; + LastTime := GetTime; +end; + +procedure TLight.SetState(State: integer); +begin + {$IFDEF UseSerialPort} + if Enabled then + PortWriteB($378, State); + {$ENDIF} +end; + +procedure TLight.AutoSetState; +var + State: integer; +begin + if Enabled then begin + State := 0; + if Light[0] then State := State + 2; + if Light[1] then State := State + 1; + // etc + SetState(State); + end; +end; + +procedure TLight.TurnOn; +begin + if Enabled then + SetState(3); +end; + +procedure TLight.TurnOff; +begin + if Enabled then + SetState(0); +end; + +procedure TLight.LightOne(Number: integer; Time: real); +begin + if Enabled then begin + if Light[Number] = false then begin + Light[Number] := true; + AutoSetState; + end; + + LightTime[Number] := GetTime + Time/1000; // [s] + end; +end; + +procedure TLight.Refresh; +var + Time: real; + L: integer; +begin + if Enabled then begin + Time := GetTime; + for L := 0 to 7 do begin + if Light[L] = true then begin + if LightTime[L] > Time then begin + end else begin + Light[L] := false; + end; + end; + end; + LastTime := Time; + AutoSetState; + end; +end; + +end. + + diff --git a/src/classes0/ULog.pas b/src/classes0/ULog.pas new file mode 100644 index 00000000..a9a2f3c4 --- /dev/null +++ b/src/classes0/ULog.pas @@ -0,0 +1,417 @@ +unit ULog; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes; + +(* + * LOG_LEVEL_[TYPE] defines the "minimum" index for logs of type TYPE. Each + * level greater than this BUT less or equal than LOG_LEVEL_[TYPE]_MAX is of this type. + * This means a level "LOG_LEVEL_ERROR >= Level <= LOG_LEVEL_ERROR_MAX" e.g. + * "Level := LOG_LEVEL_ERROR+2" is considered an error level. + * This is nice for debugging if you have more or less important debug messages. + * For example you can assign LOG_LEVEL_DEBUG+10 for the more important ones and + * LOG_LEVEL_DEBUG+20 for less important ones and so on. By changing the log-level + * you can hide the less important ones. + *) +const + LOG_LEVEL_DEBUG_MAX = MaxInt; + LOG_LEVEL_DEBUG = 50; + LOG_LEVEL_INFO_MAX = LOG_LEVEL_DEBUG-1; + LOG_LEVEL_INFO = 40; + LOG_LEVEL_STATUS_MAX = LOG_LEVEL_INFO-1; + LOG_LEVEL_STATUS = 30; + LOG_LEVEL_WARN_MAX = LOG_LEVEL_STATUS-1; + LOG_LEVEL_WARN = 20; + LOG_LEVEL_ERROR_MAX = LOG_LEVEL_WARN-1; + LOG_LEVEL_ERROR = 10; + LOG_LEVEL_CRITICAL_MAX = LOG_LEVEL_ERROR-1; + LOG_LEVEL_CRITICAL = 0; + LOG_LEVEL_NONE = -1; + + // define level that Log(File)Level is initialized with + LOG_LEVEL_DEFAULT = LOG_LEVEL_WARN; + LOG_FILE_LEVEL_DEFAULT = LOG_LEVEL_ERROR; + +type + TLog = class + private + LogFile: TextFile; + LogFileOpened: boolean; + BenchmarkFile: TextFile; + BenchmarkFileOpened: boolean; + + LogLevel: integer; + // level of messages written to the log-file + LogFileLevel: integer; + + procedure LogToFile(const Text: string); + public + BenchmarkTimeStart: array[0..31] of real; + BenchmarkTimeLength: array[0..31] of real;//TDateTime; + + Title: String; //Application Title + + // Write log message to log-file + FileOutputEnabled: Boolean; + + constructor Create; + + // destuctor + destructor Destroy; override; + + // benchmark + procedure BenchmarkStart(Number: integer); + procedure BenchmarkEnd(Number: integer); + procedure LogBenchmark(const Text: string; Number: integer); + + procedure SetLogLevel(Level: integer); + function GetLogLevel(): integer; + + procedure LogMsg(const Text: string; Level: integer); overload; + procedure LogMsg(const Msg, Context: string; Level: integer); overload; {$IFDEF HasInline}inline;{$ENDIF} + procedure LogDebug(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} + procedure LogInfo(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} + procedure LogStatus(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} + procedure LogWarn(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} + procedure LogError(const Text: string); overload; {$IFDEF HasInline}inline;{$ENDIF} + procedure LogError(const Msg, Context: string); overload; {$IFDEF HasInline}inline;{$ENDIF} + //Critical Error (Halt + MessageBox) + procedure LogCritical(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} + procedure CriticalError(const Text: string); {$IFDEF HasInline}inline;{$ENDIF} + + // voice + procedure LogVoice(SoundNr: integer); + // buffer + procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : string); + end; + +procedure DebugWriteln(const aString: String); + +var + Log: TLog; + +implementation + +uses + SysUtils, + DateUtils, + URecord, + UMain, + UTime, + UCommon, + UCommandLine; + +(* + * Write to console if in debug mode (Thread-safe). + * If debug-mode is disabled nothing is done. + *) +procedure DebugWriteln(const aString: string); +begin + {$IFNDEF DEBUG} + if Params.Debug then + begin + {$ENDIF} + ConsoleWriteLn(aString); + {$IFNDEF DEBUG} + end; + {$ENDIF} +end; + + +constructor TLog.Create; +begin + inherited; + LogLevel := LOG_LEVEL_DEFAULT; + LogFileLevel := LOG_FILE_LEVEL_DEFAULT; + FileOutputEnabled := true; +end; + +destructor TLog.Destroy; +begin + if BenchmarkFileOpened then + CloseFile(BenchmarkFile); + //if AnalyzeFileOpened then + // CloseFile(AnalyzeFile); + if LogFileOpened then + CloseFile(LogFile); + inherited; +end; + +procedure TLog.BenchmarkStart(Number: integer); +begin + BenchmarkTimeStart[Number] := USTime.GetTime; //Time; +end; + +procedure TLog.BenchmarkEnd(Number: integer); +begin + BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number]; +end; + +procedure TLog.LogBenchmark(const Text: string; Number: integer); +var + Minutes: integer; + Seconds: integer; + Miliseconds: integer; + + MinutesS: string; + SecondsS: string; + MilisecondsS: string; + + ValueText: string; +begin + if (FileOutputEnabled and Params.Benchmark) then + begin + if not BenchmarkFileOpened then + begin + BenchmarkFileOpened := true; + AssignFile(BenchmarkFile, LogPath + 'Benchmark.log'); + {$I-} + Rewrite(BenchmarkFile); + if IOResult = 0 then + BenchmarkFileOpened := true; + {$I+} + + //If File is opened write Date to Benchmark File + If (BenchmarkFileOpened) then + begin + WriteLn(BenchmarkFile, Title + ' Benchmark File'); + WriteLn(BenchmarkFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); + WriteLn(BenchmarkFile, '-------------------'); + + Flush(BenchmarkFile); + end; + end; + + if BenchmarkFileOpened then + begin + Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000); + Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60; + Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60); + //ValueText := FloatToStr(BenchmarkTimeLength[Number]); + + { + ValueText := FloatToStr(SecondOf(BenchmarkTimeLength[Number]) + + MilliSecondOf(BenchmarkTimeLength[Number])/1000); + if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then + ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText; + WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds'); + } + + if (Minutes = 0) and (Seconds = 0) then begin + MilisecondsS := IntToStr(Miliseconds); + ValueText := MilisecondsS + ' miliseconds'; + end; + + if (Minutes = 0) and (Seconds >= 1) then begin + MilisecondsS := IntToStr(Miliseconds); + while Length(MilisecondsS) < 3 do + MilisecondsS := '0' + MilisecondsS; + + SecondsS := IntToStr(Seconds); + + ValueText := SecondsS + ',' + MilisecondsS + ' seconds'; + end; + + if Minutes >= 1 then begin + MilisecondsS := IntToStr(Miliseconds); + while Length(MilisecondsS) < 3 do + MilisecondsS := '0' + MilisecondsS; + + SecondsS := IntToStr(Seconds); + while Length(SecondsS) < 2 do + SecondsS := '0' + SecondsS; + + MinutesS := IntToStr(Minutes); + + ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes'; + end; + + WriteLn(BenchmarkFile, Text + ': ' + ValueText); + Flush(BenchmarkFile); + end; + end; +end; + +procedure TLog.LogToFile(const Text: string); +begin + if (FileOutputEnabled and not LogFileOpened) then + begin + AssignFile(LogFile, LogPath + 'Error.log'); + {$I-} + Rewrite(LogFile); + if IOResult = 0 then + LogFileOpened := true; + {$I+} + + //If File is opened write Date to Error File + if (LogFileOpened) then + begin + WriteLn(LogFile, Title + ' Error Log'); + WriteLn(LogFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); + WriteLn(LogFile, '-------------------'); + + Flush(LogFile); + end; + end; + + if LogFileOpened then + begin + try + WriteLn(LogFile, Text); + Flush(LogFile); + except + LogFileOpened := false; + end; + end; +end; + +procedure TLog.SetLogLevel(Level: integer); +begin + LogLevel := Level; +end; + +function TLog.GetLogLevel(): integer; +begin + Result := LogLevel; +end; + +procedure TLog.LogMsg(const Text: string; Level: integer); +var + LogMsg: string; +begin + // TODO: what if (LogFileLevel < LogLevel)? Log to file without printing to + // console or do not log at all? At the moment nothing is logged. + if (Level <= LogLevel) then + begin + if (Level <= LOG_LEVEL_CRITICAL_MAX) then + LogMsg := 'CRITICAL: ' + Text + else if (Level <= LOG_LEVEL_ERROR_MAX) then + LogMsg := 'ERROR: ' + Text + else if (Level <= LOG_LEVEL_WARN_MAX) then + LogMsg := 'WARN: ' + Text + else if (Level <= LOG_LEVEL_STATUS_MAX) then + LogMsg := 'STATUS: ' + Text + else if (Level <= LOG_LEVEL_INFO_MAX) then + LogMsg := 'INFO: ' + Text + else + LogMsg := 'DEBUG: ' + Text; + + // output log-message + if (Level <= LogLevel) then + begin + DebugWriteLn(LogMsg); + end; + + // write message to log-file + if (Level <= LogFileLevel) then + begin + LogToFile(LogMsg); + end; + end; + + // exit application on criticial errors (cannot be turned off) + if (Level <= LOG_LEVEL_CRITICAL_MAX) then + begin + // Show information (window) + ShowMessage(Text, mtError); + Halt; + end; +end; + +procedure TLog.LogMsg(const Msg, Context: string; Level: integer); +begin + LogMsg(Msg + ' ['+Context+']', Level); +end; + +procedure TLog.LogDebug(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_DEBUG); +end; + +procedure TLog.LogInfo(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_INFO); +end; + +procedure TLog.LogStatus(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_STATUS); +end; + +procedure TLog.LogWarn(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_WARN); +end; + +procedure TLog.LogError(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_ERROR); +end; + +procedure TLog.LogError(const Text: string); +begin + LogMsg(Text, LOG_LEVEL_ERROR); +end; + +procedure TLog.CriticalError(const Text: string); +begin + LogMsg(Text, LOG_LEVEL_CRITICAL); +end; + +procedure TLog.LogCritical(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_CRITICAL); +end; + +procedure TLog.LogVoice(SoundNr: integer); +var + FS: TFileStream; + FileName: string; + Num: integer; +begin + for Num := 1 to 9999 do begin + FileName := IntToStr(Num); + while Length(FileName) < 4 do + FileName := '0' + FileName; + FileName := LogPath + 'Voice' + FileName + '.raw'; + if not FileExists(FileName) then + break + end; + + FS := TFileStream.Create(FileName, fmCreate); + + AudioInputProcessor.Sound[SoundNr].LogBuffer.Seek(0, soBeginning); + FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].LogBuffer, AudioInputProcessor.Sound[SoundNr].LogBuffer.Size); + + FS.Free; +end; + +procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: string); +var + f : TFileStream; +begin + f := nil; + + try + f := TFileStream.Create( filename, fmCreate); + f.Write( buf^, bufLength); + f.Free; + except + on e : Exception do begin + Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message); + f.Free; + end; + end; +end; + +end. + + diff --git a/src/classes0/ULyrics.pas b/src/classes0/ULyrics.pas new file mode 100644 index 00000000..305cb91f --- /dev/null +++ b/src/classes0/ULyrics.pas @@ -0,0 +1,884 @@ +unit ULyrics; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + gl, + glext, + UTexture, + UThemes, + UMusic; + +type + // stores two textures for enabled/disabled states + TPlayerIconTex = array [0..1] of TTexture; + + PLyricWord = ^TLyricWord; + TLyricWord = record + X: Real; // left corner + Width: Real; // width + Start: Cardinal; // start of the word in quarters (beats) + Length: Cardinal; // length of the word in quarters + Text: String; // text + Freestyle: Boolean; // is freestyle? + end; + ALyricWord = array of TLyricWord; + + TLyricLine = class + public + Text: String; // text + Tex: glUInt; // texture of the text + Width: Real; // width + Size: Byte; // fontsize + Words: ALyricWord; // words in this line + CurWord: Integer; // current active word idx (only valid if line is active) + Start: Integer; // start of this line in quarters (Note: negative start values are possible due to gap) + StartNote: Integer; // start of the first note of this line in quarters + Length: Integer; // length in quarters (from start of first to the end of the last note) + HasFreestyle: Boolean; // one or more word are freestyle? + CountFreestyle: Integer; // how often there is a change from freestyle to non freestyle in this line + Players: Byte; // players that should sing that line (bitset, Player1: 1, Player2: 2, Player3: 4) + LastLine: Boolean; // is this the last line of the song? + + constructor Create(); + destructor Destroy(); override; + procedure Reset(); + end; + + TLyricEngine = class + private + LastDrawBeat: Real; + UpperLine: TLyricLine; // first line displayed (top) + LowerLine: TLyricLine; // second lind displayed (bottom) + QueueLine: TLyricLine; // third line (will be displayed when lower line is finished) + + IndicatorTex: TTexture; // texture for lyric indikator + BallTex: TTexture; // texture of the ball for the lyric effect + + QueueFull: Boolean; // set to true if the queue is full and a line will be replaced with the next AddLine + LCounter: Word; // line counter + + // duet mode - textures for player icons + // FIXME: do not use a fixed player count, use MAX_PLAYERS instead + PlayerIconTex: array[0..5] of TPlayerIconTex; + + //Some helper Procedures for Lyric Drawing + procedure DrawLyrics (Beat: Real); + procedure DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real); + procedure DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real); + procedure DrawBall(XBall, YBall, Alpha:Real); + + public + // positions, line specific settings + UpperLineX: Real; //X Start Pos of UpperLine + UpperLineW: Real; //Width of UpperLine with Icon(s) and Text + UpperLineY: Real; //Y Start Pos of UpperLine + UpperLineSize: Byte; //Max Size of Lyrics Text in UpperLine + + LowerLineX: Real; //X Start Pos of LowerLine + LowerLineW: Real; //Width of LowerLine with Icon(s) and Text + LowerLineY: Real; //Y Start Pos of LowerLine + LowerLineSize: Byte; //Max Size of Lyrics Text in LowerLine + + // display propertys + LineColor_en: TRGBA; //Color of Words in an Enabled Line + LineColor_dis: TRGBA; //Color of Words in a Disabled Line + LineColor_act: TRGBA; //Color of teh active Word + FontStyle: Byte; //Font for the Lyric Text + FontReSize: Boolean; //ReSize Lyrics if they don't fit Screen + + { // currently not used + FadeInEffect: Byte; //Effect for Line Fading in: 0: No Effect; 1: Fade Effect; 2: Move Upwards from Bottom to Pos + FadeOutEffect: Byte; //Effect for Line Fading out: 0: No Effect; 1: Fade Effect; 2: Move Upwards + } + + UseLinearFilter: Boolean; //Should Linear Tex Filter be used + + // song specific settings + BPM: Real; + Resolution: Integer; + + // properties to easily read options of this class + property IsQueueFull: Boolean read QueueFull; // line in queue? + property LineCounter: Word read LCounter; // lines that were progressed so far (after last clear) + + procedure AddLine(Line: PLine); // adds a line to the queue, if there is space + procedure Draw (Beat: Real); // draw the current (active at beat) lyrics + + // clears all cached song specific information + procedure Clear(cBPM: Real = 0; cResolution: Integer = 0); + + function GetUpperLine(): TLyricLine; + function GetLowerLine(): TLyricLine; + + function GetUpperLineIndex(): Integer; + + constructor Create; overload; + constructor Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS: Real); overload; + procedure LoadTextures; + destructor Destroy; override; + end; + +implementation + +uses SysUtils, + USkins, + TextGL, + UGraphic, + UDisplay, + ULog, + math, + UIni; + +//----------- +//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else +//----------- +procedure glColorRGB(Color: TRGB); overload; +begin + glColor3f(Color.R, Color.G, Color.B); +end; + +procedure glColorRGB(Color: TRGB; Alpha: Real); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Alpha); +end; + +procedure glColorRGB(Color: TRGBA); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Color.A); +end; + +procedure glColorRGB(Color: TRGBA; Alpha: Real); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha)); +end; + +{ TLyricLine } + +constructor TLyricLine.Create(); +begin + inherited; + Reset(); +end; + +destructor TLyricLine.Destroy(); +begin + SetLength(Words, 0); + inherited; +end; + +procedure TLyricLine.Reset(); +begin + Start := 0; + StartNote := 0; + Length := 0; + LastLine := False; + + Text := ''; + Width := 0; + + // duet mode: players of that line (default: all) + Players := $FF; + + SetLength(Words, 0); + CurWord := -1; + + HasFreestyle := False; + CountFreestyle := 0; +end; + + +{ TLyricEngine } + +//--------------- +// Create - Constructor, just get Memory +//--------------- +constructor TLyricEngine.Create; +begin + inherited; + + BPM := 0; + Resolution := 0; + LCounter := 0; + QueueFull := False; + + UpperLine := TLyricLine.Create; + LowerLine := TLyricLine.Create; + QueueLine := TLyricLine.Create; + + UseLinearFilter := True; + LastDrawBeat := 0; +end; + +constructor TLyricEngine.Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); +begin + Create; + + UpperLineX := ULX; + UpperLineW := ULW; + UpperLineY := ULY; + UpperLineSize := Trunc(ULS); + + LowerLineX := LLX; + LowerLineW := LLW; + LowerLineY := LLY; + LowerLineSize := Trunc(LLS); + + LoadTextures; +end; + + +//--------------- +// Destroy - Frees Memory +//--------------- +destructor TLyricEngine.Destroy; +begin + UpperLine.Free; + LowerLine.Free; + QueueLine.Free; + inherited; +end; + +//--------------- +// Clear - Clears all cached Song specific Information +//--------------- +procedure TLyricEngine.Clear(cBPM: Real; cResolution: Integer); +begin + BPM := cBPM; + Resolution := cResolution; + LCounter := 0; + QueueFull := False; + + LastDrawBeat:=0; +end; + + +//--------------- +// LoadTextures - Load Player Textures and Create Lyric Textures +//--------------- +procedure TLyricEngine.LoadTextures; +var + I: Integer; + + function CreateLineTex: glUint; + begin + // generate and bind Texture + glGenTextures(1, @Result); + glBindTexture(GL_TEXTURE_2D, Result); + + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + if UseLinearFilter then + begin + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + end; + end; + +begin + + // lyric indicator (bar that indicates when the line start) + IndicatorTex := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); + + // ball for current word hover in ball effect + BallTex := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, 0); + + // duet mode: load player icon + for I := 0 to 5 do + begin + PlayerIconTex[I][0] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0); + PlayerIconTex[I][1] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0); + end; + + // create line textures + UpperLine.Tex := CreateLineTex; + LowerLine.Tex := CreateLineTex; + QueueLine.Tex := CreateLineTex; +end; + + +//--------------- +// AddLine - Adds LyricLine to queue +// The LyricEngine stores three lines in its queue: +// UpperLine: the upper line displayed in the lyrics +// LowerLine: the lower line displayed in the lyrics +// QueueLine: an offscreen line that precedes LowerLine +// If the queue is full the next call to AddLine will replace UpperLine with +// LowerLine, LowerLine with QueueLine and QueueLine with the Line parameter. +//--------------- +procedure TLyricEngine.AddLine(Line: PLine); +var + LyricLine: TLyricLine; + PosX: Real; + I: Integer; + CurWord: PLyricWord; + RenderPass: Integer; + + function CalcWidth(LyricLine: TLyricLine): Real; + begin + Result := glTextWidth(PChar(LyricLine.Text)); + + Result := Result + (LyricLine.CountFreestyle * 10); + + // if the line ends with a freestyle not, then leave the place to finish to draw the text italic + if (LyricLine.Words[High(LyricLine.Words)].Freestyle) then + Result := Result + 12; + end; + +begin + // only add lines, if there is space + if not IsQueueFull then + begin + // set LyricLine to line to write to + if (LineCounter = 0) then + LyricLine := UpperLine + else if (LineCounter = 1) then + LyricLine := LowerLine + else + begin + // now the queue is full + LyricLine := QueueLine; + QueueFull := True; + end; + end + else + begin // rotate lines (round-robin-like) + LyricLine := UpperLine; + UpperLine := LowerLine; + LowerLine := QueueLine; + QueueLine := LyricLine; + end; + + // reset line state + LyricLine.Reset(); + + // check if sentence has notes + if (Line <> nil) and (Length(Line.Note) > 0) then + begin + // copy values from SongLine to LyricLine + LyricLine.Start := Line.Start; + LyricLine.StartNote := Line.Note[0].Start; + LyricLine.Length := Line.Note[High(Line.Note)].Start + + Line.Note[High(Line.Note)].Length - + Line.Note[0].Start; + LyricLine.LastLine := Line.LastLine; + + // copy words + SetLength(LyricLine.Words, Length(Line.Note)); + for I := 0 to High(Line.Note) do + begin + LyricLine.Words[I].Start := Line.Note[I].Start; + LyricLine.Words[I].Length := Line.Note[I].Length; + LyricLine.Words[I].Text := Line.Note[I].Text; + LyricLine.Words[I].Freestyle := Line.Note[I].NoteType = ntFreestyle; + + LyricLine.HasFreestyle := LyricLine.HasFreestyle or LyricLine.Words[I].Freestyle; + LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text; + + if (I > 0) and + LyricLine.Words[I-1].Freestyle and + not LyricLine.Words[I].Freestyle then + begin + Inc(LyricLine.CountFreestyle); + end; + end; + + // set font params + SetFontStyle(FontStyle); + SetFontPos(0, 0); + LyricLine.Size := UpperLineSize; + SetFontSize(LyricLine.Size); + SetFontItalic(False); + SetFontReflection(False, 0); + glColor4f(1, 1, 1, 1); + + // change fontsize to fit the screen + LyricLine.Width := CalcWidth(LyricLine); + while (LyricLine.Width > UpperLineW) do + begin + Dec(LyricLine.Size); + + if (LyricLine.Size <=1) then + Break; + + SetFontSize(LyricLine.Size); + LyricLine.Width := CalcWidth(LyricLine); + end; + + // Offscreen rendering of LyricTexture: + // First we will create a white transparent background to draw on. + // If the text was simply drawn to the screen with blending, the translucent + // parts of the text would be merged with the current color of the background. + // This would result in a texture that partly contains the screen we are + // drawing on. This will be visible in the fonts outline when the LyricTexture + // is drawn to the screen later. + // So we have to draw the text in TWO passes. + // At the first pass we copy the characters to the back-buffer in such a way + // that preceding characters are not repainted by following chars (otherwise + // some characters would be blended twice in the 2nd pass). + // To achieve this we disable blending and enable the depth-test. The z-buffer + // is used as a mask or replacement for the missing stencil-buffer. A z-value + // of 1 means the pixel was not assigned yet, whereas 0 stands for a pixel + // that was already drawn on. In addition we set the depth-func in such a way + // that assigned pixels (0) will not be drawn a second time. + // At the second pass we draw the text with blending and without depth-test. + // This will blend overlapping characters but not the background as it was + // repainted in the first pass. + + glPushAttrib(GL_VIEWPORT_BIT or GL_DEPTH_BUFFER_BIT); + glViewPort(0, 0, 800, 600); + glClearColor(0, 0, 0, 0); + glDepthRange(0, 1); + glClearDepth(1); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + + SetFontZ(0); + + // assure blending is off and the correct depth-func is enabled + glDisable(GL_BLEND); + glDepthFunc(GL_LESS); + + // we need two passes to draw the font onto the screen. + for RenderPass := 0 to 1 do + begin + if (RenderPass = 0) then + begin + // first pass: simply copy each character to the screen without overlapping. + SetFontBlend(false); + glEnable(GL_DEPTH_TEST); + end + else + begin + // second pass: now we will blend overlapping characters. + SetFontBlend(true); + glDisable(GL_DEPTH_TEST); + end; + + PosX := 0; + + // set word positions and line size and draw the line to the back-buffer + for I := 0 to High(LyricLine.Words) do + begin + CurWord := @LyricLine.Words[I]; + + SetFontItalic(CurWord.Freestyle); + + CurWord.X := PosX; + + // Draw Lyrics + SetFontPos(PosX, 0); + glPrint(PChar(CurWord.Text)); + + CurWord.Width := glTextWidth(PChar(CurWord.Text)); + if CurWord.Freestyle then + begin + if (I < High(LyricLine.Words)) and not LyricLine.Words[I+1].Freestyle then + CurWord.Width := CurWord.Width + 10 + else if (I = High(LyricLine.Words)) then + CurWord.Width := CurWord.Width + 12; + end; + PosX := PosX + CurWord.Width; + end; + end; + + // copy back-buffer to texture + glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); + // FIXME: this does not work this way + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 600-64, 1024, 64, 0); + if (glGetError() <> GL_NO_ERROR) then + Log.LogError('Creation of Lyrics-texture failed', 'TLyricEngine.AddLine'); + + // restore OpenGL state + glPopAttrib(); + + // clear buffer (use white to avoid flimmering if no cover/video is available) + glClearColor(1, 1, 1, 1); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + end; // if (Line <> nil) and (Length(Line.Note) > 0) + + // increase the counter + Inc(LCounter); +end; + + +//--------------- +// Draw - Procedure Draws Lyrics; Beat is curent Beat in Quarters +// Draw just manage the Lyrics, drawing is done by a call of DrawLyrics +//--------------- +procedure TLyricEngine.Draw(Beat: Real); +begin + DrawLyrics(Beat); + LastDrawBeat := Beat; +end; + +//--------------- +// DrawLyrics(private) - Helper for Draw; main Drawing procedure +//--------------- +procedure TLyricEngine.DrawLyrics(Beat: Real); +begin + DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, Upperline, Beat); + DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, Lowerline, Beat); +end; + +//--------------- +// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon +//--------------- +procedure TLyricEngine.DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real); +var + IEnabled: Byte; +begin + if Enabled then + IEnabled := 0 + else + IEnabled := 1; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, PlayerIconTex[Player][IEnabled].TexNum); + + glColor4f(1, 1, 1, Alpha); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y + Size); + glTexCoord2f(1, 1); glVertex2f(X + Size, Y + Size); + glTexCoord2f(1, 0); glVertex2f(X + Size, Y); + glEnd; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + +//--------------- +// DrawBall(private) - Helper for Draw; Draws the Ball over the LyricLine if needed +//--------------- +procedure TLyricEngine.DrawBall(XBall, YBall, Alpha: Real); +begin + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, BallTex.TexNum); + + glColor4f(1, 1, 1, Alpha); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(XBall - 10, YBall); + glTexCoord2f(0, 1); glVertex2f(XBall - 10, YBall + 20); + glTexCoord2f(1, 1); glVertex2f(XBall + 10, YBall + 20); + glTexCoord2f(1, 0); glVertex2f(XBall + 10, YBall); + glEnd; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + +//--------------- +// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine +//--------------- +procedure TLyricEngine.DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real); +var + CurWordStart, CurWordEnd: Real; // screen coordinates of current word and the rest of the sentence + FreestyleDiff: Integer; // difference between top and bottom coordiantes for freestyle lyrics + Progress: Real; // progress of singing the current word + LyricX: Real; // left + LyricX2: Real; // right + LyricY: Real; // top + LyricsHeight: Real; // height the lyrics are displayed + Alpha: Real; // alphalevel to fade out at end + CurWord, LastWord: PLyricWord; // current word + + {// duet mode + IconSize: Real; // size of player icons + IconAlpha: Real; // alpha level of player icons + } +begin + // do not draw empty lines + // Note: lines with no words in it do not have a valid texture + if (Length(Line.Words) = 0) or + (Line.Width <= 0) then + begin + Exit; + end; + + // this is actually a bit more than the real font size + // it helps adjusting the "zoom-center" + LyricsHeight := 30.5 * (Line.Size/10); + + { + // duet mode + IconSize := (2 * Size); + IconAlpha := Frac(Beat/(Resolution*4)); + + DrawPlayerIcon (0, True, X, Y + (42 - IconSize) / 2 , IconSize, IconAlpha); + DrawPlayerIcon (1, True, X + IconSize + 1, Y + (42 - IconSize) / 2, IconSize, IconAlpha); + DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y + (42 - IconSize) / 2, IconSize, IconAlpha); + } + + LyricX := X + W/2 - Line.Width/2; + LyricX2 := LyricX + Line.Width; + + // maybe center smaller lines + //LyricY := Y; + LyricY := Y + ((Size / Line.Size - 1) * LyricsHeight) / 2; + + Alpha := 1; + + // check if this line is active (at least its first note must be active) + if (Beat >= Line.StartNote) then + begin + // if this line just got active, CurWord is -1, + // this means we should try to make the first word active + if (Line.CurWord = -1) then + Line.CurWord := 0; + + // check if the current active word is still active. + // Otherwise proceed to the next word if there is one in this line. + // Note: the max. value of Line.CurWord is High(Line.Words) + if (Line.CurWord < High(Line.Words)) and + (Beat >= Line.Words[Line.CurWord + 1].Start) then + begin + Inc(Line.CurWord); + end; + + FreestyleDiff := 0; + + // determine current and last word in this line. + // If the end of the line is reached use the last word as current word. + LastWord := @Line.Words[High(Line.Words)]; + CurWord := @Line.Words[Line.CurWord]; + + // calc the progress of the lyrics effect + Progress := (Beat - CurWord.Start) / CurWord.Length; + if Progress >= 1 then + Progress := 1; + if Progress <= 0 then + Progress := 0; + + // last word of this line finished, but this line did not hide -> fade out + if Line.LastLine and + (Beat > LastWord.Start + LastWord.Length) then + begin + Alpha := 1 - (Beat - (LastWord.Start + LastWord.Length)) / 15; + if (Alpha < 0) then + Alpha := 0; + end; + + // determine the start-/end positions of the fragment of the current word + CurWordStart := CurWord.X; + CurWordEnd := CurWord.X + CurWord.Width; + + // Slide Effect + // simply paint the active texture to the current position + if Ini.LyricsEffect = 2 then + begin + CurWordStart := CurWordStart + CurWord.Width * Progress; + CurWordEnd := CurWordStart; + end; + + if CurWord.Freestyle then + begin + if (Line.CurWord < High(Line.Words)) and + (not Line.Words[Line.CurWord + 1].Freestyle) then + begin + FreestyleDiff := 2; + end + else + begin + FreestyleDiff := 12; + CurWordStart := CurWordStart - 1; + CurWordEnd := CurWordEnd - 2; + end; + end; + + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, Line.Tex); + + // draw sentence up to current word + // type 0: simple lyric effect + // type 3: ball lyric effect + // type 4: shift lyric effect + if (Ini.LyricsEffect in [0, 3, 4]) then + // ball lyric effect - only highlight current word and not that ones before in this line + glColorRGB(LineColor_en, Alpha) + else + glColorRGB(LineColor_act, Alpha); + + glBegin(GL_QUADS); + glTexCoord2f(0, 1); + glVertex2f(LyricX, LyricY); + + glTexCoord2f(0, 1-LyricsHeight/64); + glVertex2f(LyricX, LyricY + LyricsHeight); + + glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64); + glVertex2f(LyricX + CurWordStart, LyricY + LyricsHeight); + + glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); + glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY); + glEnd; + + // draw rest of sentence + glColorRGB(LineColor_en, Alpha); + glBegin(GL_QUADS); + glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); + glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY); + + glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64); + glVertex2f(LyricX + CurWordEnd, LyricY + LyricsHeight); + + glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64); + glVertex2f(LyricX2, LyricY + LyricsHeight); + + glTexCoord2f(Line.Width/1024, 1); + glVertex2f(LyricX2, LyricY); + glEnd; + + // draw active word: + // type 0: simple lyric effect + // type 3: ball lyric effect + // type 4: shift lyric effect + // only change the color of the current word + if (Ini.LyricsEffect in [0, 3, 4]) then + begin + if (Ini.LyricsEffect = 4) then + LyricY := LyricY - 8 * (1-Progress); + + glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); + glBegin(GL_QUADS); + glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); + glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY); + + glTexCoord2f(CurWordStart/1024, 0); + glVertex2f(LyricX + CurWordStart, LyricY + 64); + + glTexCoord2f(CurWordEnd/1024, 0); + glVertex2f(LyricX + CurWordEnd, LyricY + 64); + + glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); + glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY); + glEnd; + + if (Ini.LyricsEffect = 4) then + LyricY := LyricY + 8 * (1-Progress); + end + + // draw active word: + // type 1: zoom lyric effect + // change color and zoom current word + else if Ini.LyricsEffect = 1 then + begin + glPushMatrix; + + glTranslatef(LyricX + CurWordStart + (CurWordEnd-CurWordStart)/2, + LyricY + LyricsHeight/2, 0); + + // set current zoom factor + glScalef(1.0 + (1-Progress) * 0.5, 1.0 + (1-Progress) * 0.5, 1.0); + + glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); + glBegin(GL_QUADS); + glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); + glVertex2f(-(CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2); + + glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64); + glVertex2f(-(CurWordEnd-CurWordStart)/2, LyricsHeight/2); + + glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64); + glVertex2f((CurWordEnd-CurWordStart)/2, LyricsHeight/2); + + glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); + glVertex2f((CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2); + glEnd; + + glPopMatrix; + end; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + // type 3: ball lyric effect + if Ini.LyricsEffect = 3 then + begin + DrawBall(LyricX + CurWordStart + (CurWordEnd-CurWordStart) * Progress, + LyricY - 15 - 15*sin(Progress * Pi), Alpha); + end; + end + else + begin + // this section is called if the whole line can be drawn at once and no + // word has to be emphasized. + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Line.Tex); + + // enable the upper, disable the lower line + if (Line = UpperLine) then + glColorRGB(LineColor_en) + else + glColorRGB(LineColor_dis); + + glBegin(GL_QUADS); + glTexCoord2f(0, 1); + glVertex2f(LyricX, LyricY); + + glTexCoord2f(0, 1-LyricsHeight/64); + glVertex2f(LyricX, LyricY + LyricsHeight); + + glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64); + glVertex2f(LyricX2, LyricY + LyricsHeight); + + glTexCoord2f(Line.Width/1024, 1); + glVertex2f(LyricX2, LyricY); + glEnd; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; +end; + +//--------------- +// GetUpperLine() - Returns a reference to the upper line +//--------------- +function TLyricEngine.GetUpperLine(): TLyricLine; +begin + Result := UpperLine; +end; + +//--------------- +// GetLowerLine() - Returns a reference to the lower line +//--------------- +function TLyricEngine.GetLowerLine(): TLyricLine; +begin + Result := LowerLine; +end; + +//--------------- +// GetUpperLineIndex() - Returns the index of the upper line +//--------------- +function TLyricEngine.GetUpperLineIndex(): Integer; +const + QUEUE_SIZE = 3; +begin + // no line in queue + if (LineCounter <= 0) then + Result := -1 + // no line has been removed from queue yet + else if (LineCounter <= QUEUE_SIZE) then + Result := 0 + // lines have been removed from queue already + else + Result := LineCounter - QUEUE_SIZE; +end; + +end. + diff --git a/src/classes0/UMain.pas b/src/classes0/UMain.pas new file mode 100644 index 00000000..da9df6d3 --- /dev/null +++ b/src/classes0/UMain.pas @@ -0,0 +1,1107 @@ +unit UMain; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes, + SDL, + UMusic, + URecord, + UTime, + UDisplay, + UIni, + ULog, + ULyrics, + UScreenSing, + USong, + gl; + +type + PPLayerNote = ^TPlayerNote; + TPlayerNote = record + Start: integer; + Length: integer; + Detect: real; // accurate place, detected in the note + Tone: real; + Perfect: boolean; // true if the note matches the original one, lit the star + Hit: boolean; // true if the note Hits the Line + end; + + PPLayer = ^TPlayer; + TPlayer = record + Name: string; + + // Index in Teaminfo record + TeamID: Byte; + PlayerID: Byte; + + // Scores + Score: real; + ScoreLine: real; + ScoreGolden: real; + + ScoreInt: integer; + ScoreLineInt: integer; + ScoreGoldenInt: integer; + ScoreTotalInt: integer; + + // LineBonus + ScoreLast: Real;//Last Line Score + + // PerfectLineTwinkle (effect) + LastSentencePerfect: Boolean; + + HighNote: integer; // index of last note (= High(Note)?) + LengthNote: integer; // number of notes (= Length(Note)?). + Note: array of TPlayerNote; + end; + + +var + // Absolute Paths + GamePath: string; + SoundPath: string; + SongPaths: TStringList; + LogPath: string; + ThemePath: string; + SkinsPath: string; + ScreenshotsPath: string; + CoverPaths: TStringList; + LanguagesPath: string; + PluginPath: string; + VisualsPath: string; + ResourcesPath: string; + PlayListPath: string; + + Done: Boolean; + Event: TSDL_event; + // FIXME: ConversionFileName should not be global + ConversionFileName: string; + Restart: boolean; + + // player and music info + Player: array of TPlayer; + PlayersPlay: integer; + + CurrentSong : TSong; + +const + MAX_SONG_SCORE = 10000; // max. achievable points per song + MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song + +function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; +procedure InitializePaths; +procedure AddSongPath(const Path: string); + +Procedure Main; +procedure MainLoop; +procedure CheckEvents; +procedure Sing(Screen: TScreenSing); +procedure NewSentence(Screen: TScreenSing); +procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click +procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection +procedure NewNote(Screen: TScreenSing); // detect note +function GetMidBeat(Time: real): real; +function GetTimeFromBeat(Beat: integer): real; +procedure ClearScores(PlayerNum: integer); + +implementation + +uses + Math, + StrUtils, + USongs, + UJoystick, + UCommandLine, + ULanguage, + //SDL_ttf, + USkins, + UCovers, + UCatCovers, + UDataBase, + UPlaylist, + UDLLManager, + UParty, + UConfig, + UCore, + UCommon, + UGraphic, + UGraphicClasses, + UPluginDefs, + UPlatform, + UThemes; + + + + +procedure Main; +var + WndTitle: string; +begin + try + WndTitle := USDXVersionStr; + + Platform.Init; + + if Platform.TerminateIfAlreadyRunning(WndTitle) then + Exit; + + // fix floating-point exceptions (FPE) + DisableFloatingPointExceptions(); + // fix the locale for string-to-float parsing in C-libs + SetDefaultNumericLocale(); + + // setup separators for parsing + // Note: ThousandSeparator must be set because of a bug in TIniFile.ReadFloat + ThousandSeparator := ','; + DecimalSeparator := '.'; + + //------------------------------ + //StartUp - Create Classes and Load Files + //------------------------------ + + // Initialize SDL + // Without SDL_INIT_TIMER SDL_GetTicks() might return strange values + SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER); + SDL_EnableUnicode(1); + + USTime := TTime.Create; + VideoBGTimer := TRelativeTimer.Create; + + // Commandline Parameter Parser + Params := TCMDParams.Create; + + // Log + Benchmark + Log := TLog.Create; + Log.Title := WndTitle; + Log.FileOutputEnabled := not Params.NoLog; + Log.BenchmarkStart(0); + + // Language + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Paths', 'Initialization'); + InitializePaths; + Log.LogStatus('Load Language', 'Initialization'); + Language := TLanguage.Create; + + // Add Const Values: + Language.AddConst('US_VERSION', USDXVersionStr); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Language', 1); + + { + // SDL_ttf (Not used yet, maybe in version 1.5) + Log.BenchmarkStart(1); + Log.LogStatus('Initialize SDL_ttf', 'Initialization'); + TTF_Init(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing SDL_ttf', 1); + } + + // Skin + Log.BenchmarkStart(1); + Log.LogStatus('Loading Skin List', 'Initialization'); + Skin := TSkin.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Skin List', 1); + + // Ini + Paths + Log.BenchmarkStart(1); + Log.LogStatus('Load Ini', 'Initialization'); + Ini := TIni.Create; + Ini.Load; + + //it's possible that this is the first run, create a .ini file if neccessary + Log.LogStatus('Write Ini', 'Initialization'); + Ini.Save; + + // Load Languagefile + if (Params.Language <> -1) then + Language.ChangeLanguage(ILanguage[Params.Language]) + else + Language.ChangeLanguage(ILanguage[Ini.Language]); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Ini', 1); + + // Sound + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Sound', 'Initialization'); + InitializeSound(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Sound', 1); + + // Lyrics-engine with media reference timer + LyricsState := TLyricsState.Create(); + + // Theme + Log.BenchmarkStart(1); + Log.LogStatus('Load Themes', 'Initialization'); + Theme := TTheme.Create(ThemePath + ITheme[Ini.Theme] + '.ini', Ini.Color); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Themes', 1); + + // Covers Cache + Log.BenchmarkStart(1); + Log.LogStatus('Creating Covers Cache', 'Initialization'); + Covers := TCoverDatabase.Create; + Log.LogBenchmark('Loading Covers Cache Array', 1); + Log.BenchmarkStart(1); + + // Category Covers + Log.BenchmarkStart(1); + Log.LogStatus('Creating Category Covers Array', 'Initialization'); + CatCovers:= TCatCovers.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Category Covers Array', 1); + + // Songs + //Log.BenchmarkStart(1); + Log.LogStatus('Creating Song Array', 'Initialization'); + Songs := TSongs.Create; + //Songs.LoadSongList; + + Log.LogStatus('Creating 2nd Song Array', 'Initialization'); + CatSongs := TCatSongs.Create; + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Songs', 1); + + // PluginManager + Log.BenchmarkStart(1); + Log.LogStatus('PluginManager', 'Initialization'); + DLLMan := TDLLMan.Create; // Load PluginList + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading PluginManager', 1); + + {// Party Mode Manager + Log.BenchmarkStart(1); + Log.LogStatus('PartySession Manager', 'Initialization'); + PartySession := TPartySession.Create; //Load PartySession + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading PartySession Manager', 1); } + + // Graphics + Log.BenchmarkStart(1); + Log.LogStatus('Initialize 3D', 'Initialization'); + Initialize3D(WndTitle); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing 3D', 1); + + // Score Saving System + Log.BenchmarkStart(1); + Log.LogStatus('DataBase System', 'Initialization'); + DataBase := TDataBaseSystem.Create; + + if (Params.ScoreFile = '') then + DataBase.Init (Platform.GetGameUserPath + 'Ultrastar.db') + else + DataBase.Init (Params.ScoreFile); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading DataBase System', 1); + + // Playlist Manager + Log.BenchmarkStart(1); + Log.LogStatus('Playlist Manager', 'Initialization'); + PlaylistMan := TPlaylistManager.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Playlist Manager', 1); + + // GoldenStarsTwinkleMod + Log.BenchmarkStart(1); + Log.LogStatus('Effect Manager', 'Initialization'); + GoldenRec := TEffectManager.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Particle System', 1); + + // Joypad + if (Ini.Joypad = 1) OR (Params.Joypad) then + begin + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Joystick', 'Initialization'); + Joy := TJoy.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Joystick', 1); + end; + + Log.BenchmarkEnd(0); + Log.LogBenchmark('Loading Time', 0); + + Log.LogStatus('Creating Core', 'Initialization'); + {Core := TCore.Create( + USDXShortVersionStr, + MakeVersion(USDX_VERSION_MAJOR, + USDX_VERSION_MINOR, + USDX_VERSION_RELEASE, + chr(0)) + ); } + + Log.LogStatus('Running Core', 'Initialization'); + //Core.Run; + + //------------------------------ + //Start- Mainloop + //------------------------------ + Log.LogStatus('Main Loop', 'Initialization'); + MainLoop; + + finally + //------------------------------ + //Finish Application + //------------------------------ + + // TODO: + // call an uninitialize routine for every initialize step + // or at least use the corresponding Free-Methods + + FinalizeMedia(); + + //TTF_Quit(); + SDL_Quit(); + + if assigned(Log) then + begin + Log.LogStatus('Main Loop', 'Finished'); + Log.Free; + end; + end; +end; + +procedure MainLoop; +var + Delay: integer; +const + MAX_FPS = 100; +begin + Delay := 0; + SDL_EnableKeyRepeat(125, 125); + + CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. + while not Done do + begin + // joypad + if (Ini.Joypad = 1) or (Params.Joypad) then + Joy.Update; + + // keyboard events + CheckEvents; + + // display + done := not Display.Draw; + SwapBuffers; + + // delay + CountMidTime; + + Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid); + + if Delay >= 1 then + SDL_Delay(Delay); // dynamic, maximum is 100 fps + + CountSkipTime; + + // reinitialization of graphics + if Restart then + begin + Reinitialize3D; + Restart := false; + end; + + end; +End; + +procedure CheckEvents; +begin + if Assigned(Display.NextScreen) then + Exit; + + while SDL_PollEvent( @event ) = 1 do + begin + case Event.type_ of + SDL_QUITEV: + begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; + { + SDL_MOUSEBUTTONDOWN: + with Event.button Do + begin + if State = SDL_BUTTON_LEFT Then + begin + // + end; + end; + } + SDL_VIDEORESIZE: + begin + ScreenW := Event.resize.w; + ScreenH := Event.resize.h; + // Note: do NOT call SDL_SetVideoMode on Windows and MacOSX here. + // This would create a new OpenGL render-context and all texture data + // would be invalidated. + // On Linux the mode MUST be resetted, otherwise graphics will be corrupted. + {$IFDEF LINUX} + if boolean( Ini.FullScreen ) then + SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN) + else + SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); + {$ENDIF} + end; + SDL_KEYDOWN: + begin + // remap the "keypad enter" key to the "standard enter" key + if (Event.key.keysym.sym = SDLK_KP_ENTER) then + Event.key.keysym.sym := SDLK_RETURN; + + if (Event.key.keysym.sym = SDLK_F11) or + ((Event.key.keysym.sym = SDLK_RETURN) and + ((Event.key.keysym.modifier and KMOD_ALT) <> 0)) then // toggle full screen + begin + Ini.FullScreen := integer( not boolean( Ini.FullScreen ) ); + + // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to + // reload all texture data (-> whitescreen bug). + // Only Linux is able to handle screen-switching this way. + {$IFDEF LINUX} + if boolean( Ini.FullScreen ) then + begin + SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); + SDL_ShowCursor(0); + end + else + begin + SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); + SDL_ShowCursor(1); + end; + + glViewPort(0, 0, ScreenW, ScreenH); + {$ENDIF} + end + // if print is pressed -> make screenshot and save to screenshot path + else if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then + Display.SaveScreenShot + // if there is a visible popup then let it handle input instead of underlying screen + // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) + else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then + done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True) + else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then + done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True) + else + begin + // check if screen wants to exit + done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True); + + // if screen wants to exit + if done then + begin + // if question option is enabled then show exit popup + if (Ini.AskbeforeDel = 1) then + begin + Display.CurrentScreen^.CheckFadeTo(nil,'MSG_QUIT_USDX'); + end + else // if ask-for-exit is disabled then simply exit + begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; + end; + + end; + end; + SDL_JOYAXISMOTION: + begin + // not implemented + end; + SDL_JOYBUTTONDOWN: + begin + // not implemented + end; + end; // case + end; // while +end; + +function GetTimeForBeats(BPM, Beats: real): real; +begin + Result := 60 / BPM * Beats; +end; + +function GetBeats(BPM, msTime: real): real; +begin + Result := BPM * msTime / 60; +end; + +procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); +var + NewTime: real; +begin + if High(CurrentSong.BPM) = BPMNum then + begin + // last BPM + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); + Time := 0; + end + else + begin + // not last BPM + // count how much time is it for start of the new BPM and store it in NewTime + NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); + + // compare it to remaining time + if (Time - NewTime) > 0 then + begin + // there is still remaining time + CurBeat := CurrentSong.BPM[BPMNum].StartBeat; + Time := Time - NewTime; + end + else + begin + // there is no remaining time + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); + Time := 0; + end; // if + end; // if +end; + +function GetMidBeat(Time: real): real; +var + CurBeat: real; + CurBPM: integer; +begin + // static BPM + if Length(CurrentSong.BPM) = 1 then + begin + Result := Time * CurrentSong.BPM[0].BPM / 60; + end + // variable BPM + else if Length(CurrentSong.BPM) > 1 then + begin + CurBeat := 0; + CurBPM := 0; + while (Time > 0) do + begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + + Result := CurBeat; + end + // invalid BPM + else + begin + Result := 0; + end; +end; + +function GetTimeFromBeat(Beat: integer): real; +var + CurBPM: integer; +begin + // static BPM + if Length(CurrentSong.BPM) = 1 then + begin + Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; + end + // variable BPM + else if Length(CurrentSong.BPM) > 1 then + begin + Result := CurrentSong.GAP / 1000; + CurBPM := 0; + while (CurBPM <= High(CurrentSong.BPM)) and + (Beat > CurrentSong.BPM[CurBPM].StartBeat) do + begin + if (CurBPM < High(CurrentSong.BPM)) and + (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then + begin + // full range + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * + (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); + end; + + if (CurBPM = High(CurrentSong.BPM)) or + (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then + begin + // in the middle + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * + (Beat - CurrentSong.BPM[CurBPM].StartBeat); + end; + Inc(CurBPM); + end; + + { + while (Time > 0) do + begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + } + end + // invalid BPM + else + begin + Result := 0; + end; +end; + +procedure Sing(Screen: TScreenSing); +var + Count: integer; + CountGr: integer; + CP: integer; + Done: real; + N: integer; + CurLine: PLine; + CurNote: PLineFragment; +begin + LyricsState.UpdateBeats(); + + // sentences routines + for CountGr := 0 to 0 do //High(Lines) + begin; + CP := CountGr; + // old parts + LyricsState.OldLine := Lines[CP].Current; + + // choose current parts + for Count := 0 to Lines[CP].High do + begin + if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then + Lines[CP].Current := Count; + end; + + // clean player note if there is a new line + // (optimization on halfbeat time) + if Lines[CP].Current <> LyricsState.OldLine then + NewSentence(Screen); + + end; // for CountGr + + // make some operations on clicks + if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then + NewBeatClick(Screen); + + // make some operations when detecting new voice pitch + if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then + NewBeatDetect(Screen); + + CurLine := @Lines[0].Line[Lines[0].Current]; + + // remove moving text + Done := 1; + for N := 0 to CurLine.HighNote do + begin + CurNote := @CurLine.Note[N]; + if (CurNote.Start <= LyricsState.MidBeat) and + (CurNote.Start + CurNote.Length >= LyricsState.MidBeat) then + begin + Done := (LyricsState.MidBeat - CurNote.Start) / CurNote.Length; + end; + end; +end; + +procedure NewSentence(Screen: TScreenSing); +var + i: Integer; +begin + // clean note of player + for i := 0 to High(Player) do + begin + Player[i].LengthNote := 0; + Player[i].HighNote := -1; + SetLength(Player[i].Note, 0); + end; + + // on sentence change... + Screen.onSentenceChange(Lines[0].Current); +end; + +procedure NewBeatClick; +var + Count: integer; +begin + // beat click + if ((Ini.BeatClick = 1) and + ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then + begin + AudioPlayback.PlaySound(SoundLib.Click); + end; + + for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do + begin + if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then + begin + // click assist + if Ini.ClickAssist = 1 then + AudioPlayback.PlaySound(SoundLib.Click); + + // drum machine + (* + TempBeat := LyricsState.CurrentBeat;// + 2; + if (TempBeat mod 8 = 0) then Music.PlayDrum; + if (TempBeat mod 8 = 4) then Music.PlayClap; + //if (TempBeat mod 4 = 2) then Music.PlayHihat; + if (TempBeat mod 4 <> 0) then Music.PlayHihat; + *) + end; + end; +end; + +procedure NewBeatDetect(Screen: TScreenSing); +begin + NewNote(Screen); +end; + +procedure NewNote(Screen: TScreenSing); +var + LineFragmentIndex: integer; + CurrentLineFragment: PLineFragment; + PlayerIndex: integer; + CurrentSound: TCaptureBuffer; + CurrentPlayer: PPlayer; + LastPlayerNote: PPLayerNote; + Line: PLine; + SentenceIndex: integer; + SentenceMin: integer; + SentenceMax: integer; + SentenceDetected: integer; // sentence of detected note + NoteAvailable: boolean; + NewNote: boolean; + Range: integer; + NoteHit: boolean; + MaxSongPoints: integer; // max. points for the song (without line bonus) + MaxLinePoints: Real; // max. points for the current line +begin + // TODO: add duet mode support + // use Lines[LineSetIndex] with LineSetIndex depending on the current player + + // count min and max sentence range for checking (detection is delayed to the notes we see on the screen) + SentenceMin := Lines[0].Current-1; + if (SentenceMin < 0) then + SentenceMin := 0; + SentenceMax := Lines[0].Current; + + // check for an active note at the current time defined in the lyrics + NoteAvailable := false; + SentenceDetected := SentenceMin; + for SentenceIndex := SentenceMin to SentenceMax do + begin + Line := @Lines[0].Line[SentenceIndex]; + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + // check if line is active + if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and + (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and + (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes + (CurrentLineFragment.Length > 0) then // and make sure the note lengths is at least 1 + begin + SentenceDetected := SentenceIndex; + NoteAvailable := true; + Break; + end; + end; + // TODO: break here, if NoteAvailable is true? We would then use the first instead + // of the last note matching the current beat if notes overlap. But notes + // should not overlap at all. + //if (NoteAvailable) then + // Break; + end; + + // analyze player signals + for PlayerIndex := 0 to PlayersPlay-1 do + begin + CurrentPlayer := @Player[PlayerIndex]; + CurrentSound := AudioInputProcessor.Sound[PlayerIndex]; + LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; + + // analyze buffer + CurrentSound.AnalyzeBuffer; + + // add some noise + // TODO: do we need this? + //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1; + + // add note if possible + if (CurrentSound.ToneValid and NoteAvailable) then + begin + Line := @Lines[0].Line[SentenceDetected]; + + // process until last note + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and + (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then + begin + // compare notes (from song-file and from player) + + // move players tone to proper octave + while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do + CurrentSound.Tone := CurrentSound.Tone - 12; + + while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do + CurrentSound.Tone := CurrentSound.Tone + 12; + + // half size notes patch + NoteHit := false; + + //if Ini.Difficulty = 0 then Range := 2; + //if Ini.Difficulty = 1 then Range := 1; + //if Ini.Difficulty = 2 then Range := 0; + Range := 2 - Ini.Difficulty; + + // check if the player hit the correct tone within the tolerated range + if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then + begin + // adjust the players tone to the correct one + // TODO: do we need to do this? + CurrentSound.Tone := CurrentLineFragment.Tone; + + // half size notes patch + NoteHit := true; + + if (Ini.LineBonus > 0) then + MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS + else + MaxSongPoints := MAX_SONG_SCORE; + + // Note: ScoreValue is the sum of all note values of the song + MaxLinePoints := MaxSongPoints / Lines[0].ScoreValue; + + // FIXME: is this correct? Why do we add the points for a whole line + // if just one note is correct? + case CurrentLineFragment.NoteType of + ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints; + ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints; + end; + + CurrentPlayer.ScoreInt := Floor(CurrentPlayer.Score / 10) * 10; + CurrentPlayer.ScoreGoldenInt := Floor(CurrentPlayer.ScoreGolden / 10) * 10; + + CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt + + CurrentPlayer.ScoreGoldenInt + + CurrentPlayer.ScoreLineInt; + end; + + end; // operation + end; // for + + // check if we have to add a new note or extend the note's length + if (SentenceDetected = SentenceMax) then + begin + // we will add a new note + NewNote := true; + // if last has the same tone + if ((CurrentPlayer.LengthNote > 0) and + (LastPlayerNote.Tone = CurrentSound.Tone) and + ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then + begin + NewNote := false; + end; + + // if is not as new note to control + for LineFragmentIndex := 0 to Line.HighNote do + begin + if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then + NewNote := true; + end; + + // add new note + if NewNote then + begin + // new note + Inc(CurrentPlayer.LengthNote); + Inc(CurrentPlayer.HighNote); + SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote); + + // update player's last note + LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; + with LastPlayerNote^ do + begin + Start := LyricsState.CurrentBeatD; + Length := 1; + Tone := CurrentSound.Tone; // Tone || ToneAbs + Detect := LyricsState.MidBeat; + Hit := NoteHit; // half note patch + end; + end + else + begin + // extend note length + Inc(LastPlayerNote.Length); + end; + + // check for perfect note and then lit the star (on Draw) + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + if (CurrentLineFragment.Start = LastPlayerNote.Start) and + (CurrentLineFragment.Length = LastPlayerNote.Length) and + (CurrentLineFragment.Tone = LastPlayerNote.Tone) then + begin + LastPlayerNote.Perfect := true; + end; + end; + end; // if SentenceDetected = SentenceMax + + end; // if Detected + end; // for PlayerIndex + + //Log.LogStatus('EndBeat', 'NewBeat'); + + // on sentence end -> for LineBonus and display of SingBar (rating pop-up) + if (SentenceDetected >= Low(Lines[0].Line)) and + (SentenceDetected <= High(Lines[0].Line)) then + begin + Line := @Lines[0].Line[SentenceDetected]; + CurrentLineFragment := @Line.Note[Line.HighNote]; + if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then + begin + if assigned(Screen) then + Screen.OnSentenceEnd(SentenceDetected); + end; + end; + +end; + +procedure ClearScores(PlayerNum: integer); +begin + with Player[PlayerNum] do + begin + Score := 0; + ScoreInt := 0; + ScoreLine := 0; + ScoreLineInt := 0; + ScoreGolden := 0; + ScoreGoldenInt := 0; + ScoreTotalInt := 0; + end; +end; + +procedure AddSpecialPath(var PathList: TStringList; const Path: string); +var + I: integer; + PathAbs, OldPathAbs: string; +begin + if (PathList = nil) then + PathList := TStringList.Create; + + if (Path = '') or not DirectoryExists(Path) then + Exit; + + PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path)); + + // check if path or a part of the path was already added + for I := 0 to PathList.Count-1 do + begin + OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[I])); + // check if the new directory is a sub-directory of a previously added one. + // This is also true, if both paths point to the same directories. + if (AnsiStartsText(OldPathAbs, PathAbs)) then + begin + // ignore the new path + Exit; + end; + + // check if a previously added directory is a sub-directory of the new one. + if (AnsiStartsText(PathAbs, OldPathAbs)) then + begin + // replace the old with the new one. + PathList[I] := PathAbs; + Exit; + end; + end; + + PathList.Add(PathAbs); +end; + +procedure AddSongPath(const Path: string); +begin + AddSpecialPath(SongPaths, Path); +end; + +procedure AddCoverPath(const Path: string); +begin + AddSpecialPath(CoverPaths, Path); +end; + +(** + * Initialize a path variable + * After setting paths, make sure that paths exist + *) +function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; +begin + Result := false; + + if (RequestedPath = '') then + Exit; + + // Make sure the directory exists + if (not ForceDirectories(RequestedPath)) then + begin + PathResult := ''; + Exit; + end; + + PathResult := IncludeTrailingPathDelimiter(RequestedPath); + + if (NeedsWritePermission) and + (FileIsReadOnly(RequestedPath)) then + begin + Exit; + end; + + Result := true; +end; + +(** + * Function sets all absolute paths e.g. song path and makes sure the directorys exist + *) +procedure InitializePaths; +begin + // Log directory (must be writable) + if (not FindPath(LogPath, Platform.GetLogPath, true)) then + begin + Log.FileOutputEnabled := false; + Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths'); + end; + + FindPath(SoundPath, Platform.GetGameSharedPath + 'Sounds', false); + FindPath(ThemePath, Platform.GetGameSharedPath + 'Themes', false); + FindPath(SkinsPath, Platform.GetGameSharedPath + 'Themes', false); + FindPath(LanguagesPath, Platform.GetGameSharedPath + 'Languages', false); + FindPath(PluginPath, Platform.GetGameSharedPath + 'Plugins', false); + FindPath(VisualsPath, Platform.GetGameSharedPath + 'Visuals', false); + FindPath(ResourcesPath, Platform.GetGameSharedPath + 'Resources', false); + + // Playlists are not shared as we need one directory to write too + FindPath(PlaylistPath, Platform.GetGameUserPath + 'Playlists', true); + + // Screenshot directory (must be writable) + if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'Screenshots', true)) then + begin + Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths'); + end; + + // Add song paths + AddSongPath(Params.SongPath); + AddSongPath(Platform.GetGameSharedPath + 'Songs'); + AddSongPath(Platform.GetGameUserPath + 'Songs'); + + // Add category cover paths + AddCoverPath(Platform.GetGameSharedPath + 'Covers'); + AddCoverPath(Platform.GetGameUserPath + 'Covers'); +end; + +end. diff --git a/src/classes0/UMediaCore_FFmpeg.pas b/src/classes0/UMediaCore_FFmpeg.pas new file mode 100644 index 00000000..cdd320ac --- /dev/null +++ b/src/classes0/UMediaCore_FFmpeg.pas @@ -0,0 +1,405 @@ +unit UMediaCore_FFmpeg; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UMusic, + avcodec, + avformat, + avutil, + ULog, + sdl; + +type + PPacketQueue = ^TPacketQueue; + TPacketQueue = class + private + FirstListEntry: PAVPacketList; + LastListEntry: PAVPacketList; + PacketCount: integer; + Mutex: PSDL_Mutex; + Condition: PSDL_Cond; + Size: integer; + AbortRequest: boolean; + public + constructor Create(); + destructor Destroy(); override; + + function Put(Packet : PAVPacket): integer; + function PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer; + procedure FreeStatusInfo(var Packet: TAVPacket); + function GetStatusInfo(var Packet: TAVPacket): Pointer; + function Get(var Packet: TAVPacket; Blocking: boolean): integer; + function GetSize(): integer; + procedure Flush(); + procedure Abort(); + function IsAborted(): boolean; + end; + +const + STATUS_PACKET: PChar = 'STATUS_PACKET'; +const + PKT_STATUS_FLAG_EOF = 1; // signal end-of-file + PKT_STATUS_FLAG_FLUSH = 2; // request the decoder to flush its avcodec decode buffers + PKT_STATUS_FLAG_ERROR = 3; // signal an error state + PKT_STATUS_FLAG_EMPTY = 4; // request the decoder to output empty data (silence or black frames) + +type + TMediaCore_FFmpeg = class + private + AVCodecLock: PSDL_Mutex; + public + constructor Create(); + destructor Destroy(); override; + class function GetInstance(): TMediaCore_FFmpeg; + + function GetErrorString(ErrorNum: integer): string; + function FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer ): boolean; + function FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer; + function ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean; + procedure LockAVCodec(); + procedure UnlockAVCodec(); + end; + +implementation + +uses + SysUtils; + +var + Instance: TMediaCore_FFmpeg; + +constructor TMediaCore_FFmpeg.Create(); +begin + inherited; + AVCodecLock := SDL_CreateMutex(); +end; + +destructor TMediaCore_FFmpeg.Destroy(); +begin + SDL_DestroyMutex(AVCodecLock); + inherited; +end; + +class function TMediaCore_FFmpeg.GetInstance(): TMediaCore_FFmpeg; +begin + if (not Assigned(Instance)) then + Instance := TMediaCore_FFmpeg.Create(); + Result := Instance; +end; + +procedure TMediaCore_FFmpeg.LockAVCodec(); +begin + SDL_mutexP(AVCodecLock); +end; + +procedure TMediaCore_FFmpeg.UnlockAVCodec(); +begin + SDL_mutexV(AVCodecLock); +end; + +function TMediaCore_FFmpeg.GetErrorString(ErrorNum: integer): string; +begin + case ErrorNum of + AVERROR_IO: Result := 'AVERROR_IO'; + AVERROR_NUMEXPECTED: Result := 'AVERROR_NUMEXPECTED'; + AVERROR_INVALIDDATA: Result := 'AVERROR_INVALIDDATA'; + AVERROR_NOMEM: Result := 'AVERROR_NOMEM'; + AVERROR_NOFMT: Result := 'AVERROR_NOFMT'; + AVERROR_NOTSUPP: Result := 'AVERROR_NOTSUPP'; + AVERROR_NOENT: Result := 'AVERROR_NOENT'; + AVERROR_PATCHWELCOME: Result := 'AVERROR_PATCHWELCOME'; + else Result := 'AVERROR_#'+inttostr(ErrorNum); + end; +end; + +{ + @param(FormatCtx is a PAVFormatContext returned from av_open_input_file ) + @param(FirstVideoStream is an OUT value of type integer, this is the index of the video stream) + @param(FirstAudioStream is an OUT value of type integer, this is the index of the audio stream) + @returns(@true on success, @false otherwise) +} +function TMediaCore_FFmpeg.FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer): boolean; +var + i: integer; + Stream: PAVStream; +begin + // find the first video stream + FirstAudioStream := -1; + FirstVideoStream := -1; + + for i := 0 to FormatCtx.nb_streams-1 do + begin + Stream := FormatCtx.streams[i]; + + if (Stream.codec.codec_type = CODEC_TYPE_VIDEO) and + (FirstVideoStream < 0) then + begin + FirstVideoStream := i; + end; + + if (Stream.codec.codec_type = CODEC_TYPE_AUDIO) and + (FirstAudioStream < 0) then + begin + FirstAudioStream := i; + end; + end; + + // return true if either an audio- or video-stream was found + Result := (FirstAudioStream > -1) or + (FirstVideoStream > -1) ; +end; + +function TMediaCore_FFmpeg.FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer; +var + i: integer; + StreamIndex: integer; + Stream: PAVStream; +begin + // find the first audio stream + StreamIndex := -1; + + for i := 0 to FormatCtx^.nb_streams-1 do + begin + Stream := FormatCtx^.streams[i]; + + if (Stream.codec^.codec_type = CODEC_TYPE_AUDIO) then + begin + StreamIndex := i; + Break; + end; + end; + + Result := StreamIndex; +end; + +function TMediaCore_FFmpeg.ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean; +begin + case FFmpegFormat of + SAMPLE_FMT_U8: Format := asfU8; + SAMPLE_FMT_S16: Format := asfS16; + SAMPLE_FMT_S24: Format := asfS24; + SAMPLE_FMT_S32: Format := asfS32; + SAMPLE_FMT_FLT: Format := asfFloat; + else begin + Result := false; + Exit; + end; + end; + Result := true; +end; + +{ TPacketQueue } + +constructor TPacketQueue.Create(); +begin + inherited; + + FirstListEntry := nil; + LastListEntry := nil; + PacketCount := 0; + Size := 0; + + Mutex := SDL_CreateMutex(); + Condition := SDL_CreateCond(); +end; + +destructor TPacketQueue.Destroy(); +begin + Flush(); + SDL_DestroyMutex(Mutex); + SDL_DestroyCond(Condition); + inherited; +end; + +procedure TPacketQueue.Abort(); +begin + SDL_LockMutex(Mutex); + + AbortRequest := true; + + SDL_CondBroadcast(Condition); + SDL_UnlockMutex(Mutex); +end; + +function TPacketQueue.IsAborted(): boolean; +begin + SDL_LockMutex(Mutex); + Result := AbortRequest; + SDL_UnlockMutex(Mutex); +end; + +function TPacketQueue.Put(Packet : PAVPacket): integer; +var + CurrentListEntry : PAVPacketList; +begin + Result := -1; + + if (Packet = nil) then + Exit; + + if (PChar(Packet^.data) <> STATUS_PACKET) then + begin + if (av_dup_packet(Packet) < 0) then + Exit; + end; + + CurrentListEntry := av_malloc(SizeOf(TAVPacketList)); + if (CurrentListEntry = nil) then + Exit; + + CurrentListEntry^.pkt := Packet^; + CurrentListEntry^.next := nil; + + SDL_LockMutex(Mutex); + try + if (LastListEntry = nil) then + FirstListEntry := CurrentListEntry + else + LastListEntry^.next := CurrentListEntry; + + LastListEntry := CurrentListEntry; + Inc(PacketCount); + + Size := Size + CurrentListEntry^.pkt.size; + SDL_CondSignal(Condition); + finally + SDL_UnlockMutex(Mutex); + end; + + Result := 0; +end; + +(** + * Adds a status packet (EOF, Flush, etc.) to the end of the queue. + * StatusInfo can be used to pass additional information to the decoder. + * Only assign nil or a valid pointer to data allocated with Getmem() to + * StatusInfo because the pointer will be disposed with Freemem() on a call + * to Flush(). If the packet is removed from the queue it is the decoder's + * responsibility to free the StatusInfo data with FreeStatusInfo(). + *) +function TPacketQueue.PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer; +var + TempPacket: PAVPacket; +begin + // create temp. package + TempPacket := av_malloc(SizeOf(TAVPacket)); + if (TempPacket = nil) then + begin + Result := -1; + Exit; + end; + // init package + av_init_packet(TempPacket^); + TempPacket^.data := Pointer(STATUS_PACKET); + TempPacket^.flags := StatusFlag; + TempPacket^.priv := StatusInfo; + // put a copy of the package into the queue + Result := Put(TempPacket); + // data has been copied -> delete temp. package + av_free(TempPacket); +end; + +procedure TPacketQueue.FreeStatusInfo(var Packet: TAVPacket); +begin + if (Packet.priv <> nil) then + FreeMem(Packet.priv); +end; + +function TPacketQueue.GetStatusInfo(var Packet: TAVPacket): Pointer; +begin + Result := Packet.priv; +end; + +function TPacketQueue.Get(var Packet: TAVPacket; Blocking: boolean): integer; +var + CurrentListEntry: PAVPacketList; +const + WAIT_TIMEOUT = 10; // timeout in ms +begin + Result := -1; + + SDL_LockMutex(Mutex); + try + while (true) do + begin + if (AbortRequest) then + Exit; + + CurrentListEntry := FirstListEntry; + if (CurrentListEntry <> nil) then + begin + FirstListEntry := CurrentListEntry^.next; + if (FirstListEntry = nil) then + LastListEntry := nil; + Dec(PacketCount); + + Size := Size - CurrentListEntry^.pkt.size; + Packet := CurrentListEntry^.pkt; + av_free(CurrentListEntry); + + Result := 1; + Break; + end + else if (not Blocking) then + begin + Result := 0; + Break; + end + else + begin + // block until a new package arrives, + // but do not wait till infinity to avoid deadlocks + if (SDL_CondWaitTimeout(Condition, Mutex, WAIT_TIMEOUT) = SDL_MUTEX_TIMEDOUT) then + begin + Result := 0; + Break; + end; + end; + end; + finally + SDL_UnlockMutex(Mutex); + end; +end; + +function TPacketQueue.GetSize(): integer; +begin + SDL_LockMutex(Mutex); + Result := Size; + SDL_UnlockMutex(Mutex); +end; + +procedure TPacketQueue.Flush(); +var + CurrentListEntry, TempListEntry: PAVPacketList; +begin + SDL_LockMutex(Mutex); + + CurrentListEntry := FirstListEntry; + while(CurrentListEntry <> nil) do + begin + TempListEntry := CurrentListEntry^.next; + // free status data + if (PChar(CurrentListEntry^.pkt.data) = STATUS_PACKET) then + FreeStatusInfo(CurrentListEntry^.pkt); + // free packet data + av_free_packet(@CurrentListEntry^.pkt); + // Note: param must be a pointer to a pointer! + av_freep(@CurrentListEntry); + CurrentListEntry := TempListEntry; + end; + LastListEntry := nil; + FirstListEntry := nil; + PacketCount := 0; + Size := 0; + + SDL_UnlockMutex(Mutex); +end; + +end. diff --git a/src/classes0/UMediaCore_SDL.pas b/src/classes0/UMediaCore_SDL.pas new file mode 100644 index 00000000..252f72a0 --- /dev/null +++ b/src/classes0/UMediaCore_SDL.pas @@ -0,0 +1,38 @@ +unit UMediaCore_SDL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UMusic, + sdl; + +function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean; + +implementation + +function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean; +begin + case Format of + asfU8: SDLFormat := AUDIO_U8; + asfS8: SDLFormat := AUDIO_S8; + asfU16LSB: SDLFormat := AUDIO_U16LSB; + asfS16LSB: SDLFormat := AUDIO_S16LSB; + asfU16MSB: SDLFormat := AUDIO_U16MSB; + asfS16MSB: SDLFormat := AUDIO_S16MSB; + asfU16: SDLFormat := AUDIO_U16; + asfS16: SDLFormat := AUDIO_S16; + else begin + Result := false; + Exit; + end; + end; + Result := true; +end; + +end. diff --git a/src/classes0/UMedia_dummy.pas b/src/classes0/UMedia_dummy.pas new file mode 100644 index 00000000..438b89ab --- /dev/null +++ b/src/classes0/UMedia_dummy.pas @@ -0,0 +1,243 @@ +unit UMedia_dummy; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +implementation + +uses + SysUtils, + math, + UMusic; + +type + TMedia_dummy = class( TInterfacedObject, IVideoPlayback, IVideoVisualization, IAudioPlayback, IAudioInput ) + private + DummyOutputDeviceList: TAudioOutputDeviceList; + public + constructor Create(); + function GetName: string; + + function Init(): boolean; + function Finalize(): boolean; + + function Open(const aFileName : string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure SetPosition(Time: real); + function GetPosition: real; + + procedure SetSyncSource(SyncSource: TSyncSource); + + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); + + // IAudioInput + function InitializeRecord: boolean; + function FinalizeRecord: boolean; + procedure CaptureStart; + procedure CaptureStop; + procedure GetFFTData(var data: TFFTData); + function GetPCMData(var data: TPCMData): Cardinal; + + // IAudioPlayback + function InitializePlayback: boolean; + function FinalizePlayback: boolean; + + function GetOutputDeviceList(): TAudioOutputDeviceList; + procedure FadeIn(Time: real; TargetVolume: single); + procedure SetAppVolume(Volume: single); + procedure SetVolume(Volume: single); + procedure SetLoop(Enabled: boolean); + procedure Rewind; + + function Finished: boolean; + function Length: real; + + function OpenSound(const Filename: string): TAudioPlaybackStream; + procedure CloseSound(var PlaybackStream: TAudioPlaybackStream); + procedure PlaySound(stream: TAudioPlaybackStream); + procedure StopSound(stream: TAudioPlaybackStream); + + function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; + procedure CloseVoiceStream(var VoiceStream: TAudioVoiceStream); + end; + +function TMedia_dummy.GetName: string; +begin + Result := 'dummy'; +end; + +procedure TMedia_dummy.GetFrame(Time: Extended); +begin +end; + +procedure TMedia_dummy.DrawGL(Screen: integer); +begin +end; + +constructor TMedia_dummy.Create(); +begin + inherited; +end; + +function TMedia_dummy.Init(): boolean; +begin + Result := true; +end; + +function TMedia_dummy.Finalize(): boolean; +begin + Result := true; +end; + +function TMedia_dummy.Open(const aFileName : string): boolean; // true if succeed +begin + Result := false; +end; + +procedure TMedia_dummy.Close; +begin +end; + +procedure TMedia_dummy.Play; +begin +end; + +procedure TMedia_dummy.Pause; +begin +end; + +procedure TMedia_dummy.Stop; +begin +end; + +procedure TMedia_dummy.SetPosition(Time: real); +begin +end; + +function TMedia_dummy.GetPosition: real; +begin + Result := 0; +end; + +procedure TMedia_dummy.SetSyncSource(SyncSource: TSyncSource); +begin +end; + +// IAudioInput +function TMedia_dummy.InitializeRecord: boolean; +begin + Result := true; +end; + +function TMedia_dummy.FinalizeRecord: boolean; +begin + Result := true; +end; + +procedure TMedia_dummy.CaptureStart; +begin +end; + +procedure TMedia_dummy.CaptureStop; +begin +end; + +procedure TMedia_dummy.GetFFTData(var data: TFFTData); +begin +end; + +function TMedia_dummy.GetPCMData(var data: TPCMData): Cardinal; +begin + Result := 0; +end; + +// IAudioPlayback +function TMedia_dummy.InitializePlayback: boolean; +begin + SetLength(DummyOutputDeviceList, 1); + DummyOutputDeviceList[0] := TAudioOutputDevice.Create(); + DummyOutputDeviceList[0].Name := '[Dummy Device]'; + Result := true; +end; + +function TMedia_dummy.FinalizePlayback: boolean; +begin + Result := true; +end; + +function TMedia_dummy.GetOutputDeviceList(): TAudioOutputDeviceList; +begin + Result := DummyOutputDeviceList; +end; + +procedure TMedia_dummy.SetAppVolume(Volume: single); +begin +end; + +procedure TMedia_dummy.SetVolume(Volume: single); +begin +end; + +procedure TMedia_dummy.SetLoop(Enabled: boolean); +begin +end; + +procedure TMedia_dummy.FadeIn(Time: real; TargetVolume: single); +begin +end; + +procedure TMedia_dummy.Rewind; +begin +end; + +function TMedia_dummy.Finished: boolean; +begin + Result := false; +end; + +function TMedia_dummy.Length: real; +begin + Result := 60; +end; + +function TMedia_dummy.OpenSound(const Filename: string): TAudioPlaybackStream; +begin + Result := nil; +end; + +procedure TMedia_dummy.CloseSound(var PlaybackStream: TAudioPlaybackStream); +begin +end; + +procedure TMedia_dummy.PlaySound(stream: TAudioPlaybackStream); +begin +end; + +procedure TMedia_dummy.StopSound(stream: TAudioPlaybackStream); +begin +end; + +function TMedia_dummy.CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; +begin + Result := nil; +end; + +procedure TMedia_dummy.CloseVoiceStream(var VoiceStream: TAudioVoiceStream); +begin +end; + +initialization + MediaManager.Add(TMedia_dummy.Create); + +end. diff --git a/src/classes0/UModules.pas b/src/classes0/UModules.pas new file mode 100644 index 00000000..554a24c4 --- /dev/null +++ b/src/classes0/UModules.pas @@ -0,0 +1,26 @@ +unit UModules; + +interface + +{$I switches.inc} + +{********************* + UModules + Unit Contains all used Modules in its uses clausel + and a const with an array of all Modules to load +*********************} + +uses + UCoreModule, + UPluginLoader; + +const + CORE_MODULES_TO_LOAD: Array[0..2] of cCoreModule = ( + TPluginLoader, //First because it has to look if there are Module replacements (Feature o/t Future) + TCoreModule, //Remove this later, just a dummy + TtehPlugins //Represents the Plugins. Last because they may use CoreModules Services etc. + ); + +implementation + +end. \ No newline at end of file diff --git a/src/classes0/UMusic.pas b/src/classes0/UMusic.pas new file mode 100644 index 00000000..6476f629 --- /dev/null +++ b/src/classes0/UMusic.pas @@ -0,0 +1,1233 @@ +unit UMusic; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UTime, + Classes; + +type + TNoteType = (ntFreestyle, ntNormal, ntGolden); + + (** + * TLineFragment represents a fragment of a lyrics line. + * This is a text-fragment (e.g. a syllable) assigned to a note pitch, + * represented by a bar in the sing-screen. + *) + PLineFragment = ^TLineFragment; + TLineFragment = record + Color: integer; + Start: integer; // beat the fragment starts at + Length: integer; // length in beats + Tone: integer; // full range tone + Text: string; // text assigned to this fragment (a syllable, word, etc.) + NoteType: TNoteType; // note-type: golden-note/freestyle etc. + end; + + (** + * TLine represents one lyrics line and consists of multiple + * notes. + *) + PLine = ^TLine; + TLine = record + Start: integer; // the start beat of this line (<> start beat of the first note of this line) + Lyric: string; + LyricWidth: real; // @deprecated: width of the line in pixels. + // Do not use this as the width is not correct. + // Use TLyricsEngine.GetUpperLine().Width instead. + End_: integer; + BaseNote: integer; + HighNote: integer; // index of last note in line (= High(Note)?) + TotalNotes: integer; // value of all notes in the line + LastLine: boolean; + Note: array of TLineFragment; + end; + + (** + * TLines stores sets of lyric lines and information on them. + * Normally just one set is defined but in duet mode it might for example + * contain two sets. + *) + TLines = record + Current: integer; // for drawing of current line + High: integer; // (= High(Line)?) + Number: integer; + Resolution: integer; + NotesGAP: integer; + ScoreValue: integer; + Line: array of TLine; + end; + + (** + * TLyricsState contains all information concerning the + * state of the lyrics, e.g. the current beat or duration of the lyrics. + *) + TLyricsState = class + private + Timer: TRelativeTimer; // keeps track of the current time + public + OldBeat: integer; // previous discovered beat + CurrentBeat: integer; // current beat (rounded) + MidBeat: real; // current beat (float) + + // now we use this for super synchronization! + // only used when analyzing voice + // TODO: change ...D to ...Detect(ed) + OldBeatD: integer; // previous discovered beat + CurrentBeatD: integer; // current discovered beat (rounded) + MidBeatD: real; // current discovered beat (float) + + // we use this for audible clicks + // TODO: Change ...C to ...Click + OldBeatC: integer; // previous discovered beat + CurrentBeatC: integer; + MidBeatC: real; // like CurrentBeatC + + OldLine: integer; // previous displayed sentence + + StartTime: real; // time till start of lyrics (= Gap) + TotalTime: real; // total song time + + constructor Create(); + procedure Pause(); + procedure Resume(); + + procedure Reset(); + procedure UpdateBeats(); + + (** + * current song time (in seconds) used as base-timer for lyrics etc. + *) + function GetCurrentTime(): real; + procedure SetCurrentTime(Time: real); + end; + + +const + FFTSize = 512; // size of FFT data (output: FFTSize/2 values) +type + TFFTData = array[0..(FFTSize div 2)-1] of Single; + +type + PPCMStereoSample = ^TPCMStereoSample; + TPCMStereoSample = array[0..1] of SmallInt; + TPCMData = array[0..511] of TPCMStereoSample; + +type + TStreamStatus = (ssStopped, ssPlaying, ssPaused); +const + StreamStatusStr: array[TStreamStatus] of string = + ('Stopped', 'Playing', 'Paused'); + +type + TAudioSampleFormat = ( + asfU8, asfS8, // unsigned/signed 8 bits + asfU16LSB, asfS16LSB, // unsigned/signed 16 bits (endianness: LSB) + asfU16MSB, asfS16MSB, // unsigned/signed 16 bits (endianness: MSB) + asfU16, asfS16, // unsigned/signed 16 bits (endianness: System) + asfS24, // signed 24 bits (endianness: System) + asfS32, // signed 32 bits (endianness: System) + asfFloat // float + ); + +const + // Size of one sample (one channel only) in bytes + AudioSampleSize: array[TAudioSampleFormat] of integer = ( + 1, 1, // asfU8, asfS8 + 2, 2, // asfU16LSB, asfS16LSB + 2, 2, // asfU16MSB, asfS16MSB + 2, 2, // asfU16, asfS16 + 3, // asfS24 + 4, // asfS32 + 4 // asfFloat + ); + +const + CHANNELMAP_LEFT = 1; + CHANNELMAP_RIGHT = 2; + CHANNELMAP_FRONT = CHANNELMAP_LEFT or CHANNELMAP_RIGHT; + +type + TAudioFormatInfo = class + private + fSampleRate : double; + fChannels : byte; + fFormat : TAudioSampleFormat; + fFrameSize : integer; + + procedure SetChannels(Channels: byte); + procedure SetFormat(Format: TAudioSampleFormat); + procedure UpdateFrameSize(); + function GetBytesPerSec(): double; + public + constructor Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat); + function Copy(): TAudioFormatInfo; + + (** + * Returns the inverse ratio of the size of data in this format to its + * size in a given target format. + * Example: SrcSize*SrcInfo.GetRatio(TgtInfo) = TgtSize + *) + function GetRatio(TargetInfo: TAudioFormatInfo): double; + + property SampleRate: double read fSampleRate write fSampleRate; + property Channels: byte read fChannels write SetChannels; + property Format: TAudioSampleFormat read fFormat write SetFormat; + property FrameSize: integer read fFrameSize; + property BytesPerSec: double read GetBytesPerSec; + end; + +type + TSoundEffect = class + public + EngineData: Pointer; // can be used for engine-specific data + procedure Callback(Buffer: PChar; BufSize: integer); virtual; abstract; + end; + + TVoiceRemoval = class(TSoundEffect) + public + procedure Callback(Buffer: PChar; BufSize: integer); override; + end; + +type + TSyncSource = class + function GetClock(): real; virtual; abstract; + end; + + TAudioProcessingStream = class; + TOnCloseHandler = procedure(Stream: TAudioProcessingStream); + + TAudioProcessingStream = class + protected + OnCloseHandlers: array of TOnCloseHandler; + + function GetLength(): real; virtual; abstract; + function GetPosition(): real; virtual; abstract; + procedure SetPosition(Time: real); virtual; abstract; + function GetLoop(): boolean; virtual; abstract; + procedure SetLoop(Enabled: boolean); virtual; abstract; + + procedure PerformOnClose(); + public + function GetAudioFormatInfo(): TAudioFormatInfo; virtual; abstract; + procedure Close(); virtual; abstract; + + (** + * Adds a new OnClose action handler. + * The handlers are performed in the order they were added. + * If not stated explicitely, member-variables might have been invalidated + * already. So do not use any member (variable/method/...) if you are not + * sure it is valid. + *) + procedure AddOnCloseHandler(Handler: TOnCloseHandler); + + property Length: real read GetLength; + property Position: real read GetPosition write SetPosition; + property Loop: boolean read GetLoop write SetLoop; + end; + + TAudioSourceStream = class(TAudioProcessingStream) + protected + function IsEOF(): boolean; virtual; abstract; + function IsError(): boolean; virtual; abstract; + public + function ReadData(Buffer: PChar; BufferSize: integer): integer; virtual; abstract; + + property EOF: boolean read IsEOF; + property Error: boolean read IsError; + end; + + (* + * State-Chart for playback-stream state transitions + * []: Transition, (): State + * + * /---[Play/FadeIn]--->-\ /-------[Pause]----->-\ + * -[Create]->(Stop) (Play) (Pause) + * \\-<-[Stop/EOF*/Error]-/ \-<---[Play/FadeIn]--// + * \-<------------[Stop/EOF*/Error]--------------/ + * + * *: if not looped, otherwise stream is repeated + * Note: SetPosition() does not change the state. + *) + + TAudioPlaybackStream = class(TAudioProcessingStream) + protected + SyncSource: TSyncSource; + AvgSyncDiff: double; + SourceStream: TAudioSourceStream; + + function GetLatency(): double; virtual; abstract; + function GetStatus(): TStreamStatus; virtual; abstract; + function GetVolume(): single; virtual; abstract; + procedure SetVolume(Volume: single); virtual; abstract; + function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; + procedure FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer); + public + (** + * Opens a SourceStream for playback. + * Note that the caller (not the TAudioPlaybackStream) is responsible to + * free the SourceStream after the Playback-Stream is closed. + * You may use an OnClose-handler to achieve this. GetSourceStream() + * guarantees to deliver this method's SourceStream parameter to + * the OnClose-handler. Freeing SourceStream at OnClose is allowed. + *) + function Open(SourceStream: TAudioSourceStream): boolean; virtual; abstract; + + procedure Play(); virtual; abstract; + procedure Pause(); virtual; abstract; + procedure Stop(); virtual; abstract; + procedure FadeIn(Time: real; TargetVolume: single); virtual; abstract; + + procedure GetFFTData(var data: TFFTData); virtual; abstract; + function GetPCMData(var data: TPCMData): Cardinal; virtual; abstract; + + procedure AddSoundEffect(Effect: TSoundEffect); virtual; abstract; + procedure RemoveSoundEffect(Effect: TSoundEffect); virtual; abstract; + + procedure SetSyncSource(SyncSource: TSyncSource); + function GetSourceStream(): TAudioSourceStream; + + property Status: TStreamStatus read GetStatus; + property Volume: single read GetVolume write SetVolume; + end; + + TAudioDecodeStream = class(TAudioSourceStream) + end; + + TAudioVoiceStream = class(TAudioSourceStream) + protected + FormatInfo: TAudioFormatInfo; + ChannelMap: integer; + public + destructor Destroy; override; + + function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual; + procedure Close(); override; + + procedure WriteData(Buffer: PChar; BufferSize: integer); virtual; abstract; + function GetAudioFormatInfo(): TAudioFormatInfo; override; + + function GetLength(): real; override; + function GetPosition(): real; override; + procedure SetPosition(Time: real); override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + end; + +type + // soundcard output-devices information + TAudioOutputDevice = class + public + Name: string; // soundcard name + end; + TAudioOutputDeviceList = array of TAudioOutputDevice; + +type + IGenericPlayback = Interface + ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] + function GetName: String; + + function Open(const Filename: string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure SetPosition(Time: real); + function GetPosition: real; + + property Position: real read GetPosition write SetPosition; + end; + + IVideoPlayback = Interface( IGenericPlayback ) + ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] + function Init(): boolean; + function Finalize: boolean; + + procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + + end; + + IVideoVisualization = Interface( IVideoPlayback ) + ['{5AC17D60-B34D-478D-B632-EB00D4078017}'] + end; + + IAudioPlayback = Interface( IGenericPlayback ) + ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}'] + function InitializePlayback: boolean; + function FinalizePlayback: boolean; + + function GetOutputDeviceList(): TAudioOutputDeviceList; + + procedure SetAppVolume(Volume: single); + procedure SetVolume(Volume: single); + procedure SetLoop(Enabled: boolean); + + procedure FadeIn(Time: real; TargetVolume: single); + procedure SetSyncSource(SyncSource: TSyncSource); + + procedure Rewind; + function Finished: boolean; + function Length: real; + + // Sounds + // TODO: + // add a TMediaDummyPlaybackStream implementation that will + // be used by the TSoundLib whenever OpenSound() fails, so checking for + // nil-pointers is not neccessary anymore. + // PlaySound/StopSound will be removed then, OpenSound will be renamed to + // CreateSound. + function OpenSound(const Filename: String): TAudioPlaybackStream; + procedure PlaySound(Stream: TAudioPlaybackStream); + procedure StopSound(Stream: TAudioPlaybackStream); + + // Equalizer + procedure GetFFTData(var Data: TFFTData); + + // Interface for Visualizer + function GetPCMData(var Data: TPCMData): Cardinal; + + function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; + end; + + IGenericDecoder = Interface + ['{557B0E9A-604D-47E4-B826-13769F3E10B7}'] + function GetName(): String; + function InitializeDecoder(): boolean; + function FinalizeDecoder(): boolean; + //function IsSupported(const Filename: string): boolean; + end; + + (* + IVideoDecoder = Interface( IGenericDecoder ) + ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}'] + function Open(const Filename: string): TVideoDecodeStream; + end; + *) + + IAudioDecoder = Interface( IGenericDecoder ) + ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}'] + function Open(const Filename: string): TAudioDecodeStream; + end; + + IAudioInput = Interface + ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}'] + function GetName: String; + function InitializeRecord: boolean; + function FinalizeRecord(): boolean; + + procedure CaptureStart; + procedure CaptureStop; + end; + +type + TAudioConverter = class + protected + fSrcFormatInfo: TAudioFormatInfo; + fDstFormatInfo: TAudioFormatInfo; + public + function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; virtual; + destructor Destroy(); override; + + (** + * Converts the InputBuffer and stores the result in OutputBuffer. + * If the result is not -1, InputSize will be set to the actual number of + * input-buffer bytes used. + * Returns the number of bytes written to the output-buffer or -1 if an error occured. + *) + function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; virtual; abstract; + + (** + * Destination/Source size ratio + *) + function GetRatio(): double; virtual; abstract; + + function GetOutputBufferSize(InputSize: integer): integer; virtual; abstract; + property SrcFormatInfo: TAudioFormatInfo read fSrcFormatInfo; + property DstFormatInfo: TAudioFormatInfo read fDstFormatInfo; + end; + +(* TODO +const + SOUNDID_START = 0; + SOUNDID_BACK = 1; + SOUNDID_SWOOSH = 2; + SOUNDID_CHANGE = 3; + SOUNDID_OPTION = 4; + SOUNDID_CLICK = 5; + LAST_SOUNDID = SOUNDID_CLICK; + + BaseSoundFilenames: array[0..LAST_SOUNDID] of string = ( + '%SOUNDPATH%/Common start.mp3', // Start + '%SOUNDPATH%/Common back.mp3', // Back + '%SOUNDPATH%/menu swoosh.mp3', // Swoosh + '%SOUNDPATH%/select music change music 50.mp3', // Change + '%SOUNDPATH%/option change col.mp3', // Option + '%SOUNDPATH%/rimshot022b.mp3' // Click + { + '%SOUNDPATH%/bassdrumhard076b.mp3', // Drum (unused) + '%SOUNDPATH%/hihatclosed068b.mp3', // Hihat (unused) + '%SOUNDPATH%/claps050b.mp3', // Clap (unused) + '%SOUNDPATH%/Shuffle.mp3' // Shuffle (unused) + } + ); +*) + +type + TSoundLibrary = class + private + // TODO + //Sounds: array of TAudioPlaybackStream; + public + // TODO: move sounds to the private section + // and provide IDs instead. + Start: TAudioPlaybackStream; + Back: TAudioPlaybackStream; + Swoosh: TAudioPlaybackStream; + Change: TAudioPlaybackStream; + Option: TAudioPlaybackStream; + Click: TAudioPlaybackStream; + BGMusic: TAudioPlaybackStream; + + constructor Create(); + destructor Destroy(); override; + + procedure LoadSounds(); + procedure UnloadSounds(); + + procedure StartBgMusic(); + procedure PauseBgMusic(); + // TODO + //function AddSound(Filename: string): integer; + //procedure RemoveSound(ID: integer); + //function GetSound(ID: integer): TAudioPlaybackStream; + //property Sound[ID: integer]: TAudioPlaybackStream read GetSound; default; + end; + +var + // TODO: JB --- THESE SHOULD NOT BE GLOBAL + Lines: array of TLines; + LyricsState: TLyricsState; + SoundLib: TSoundLibrary; + + +procedure InitializeSound; +procedure InitializeVideo; +procedure FinalizeMedia; + +function Visualization(): IVideoPlayback; +function VideoPlayback(): IVideoPlayback; +function AudioPlayback(): IAudioPlayback; +function AudioInput(): IAudioInput; +function AudioDecoders(): TInterfaceList; + +function MediaManager: TInterfaceList; + +procedure DumpMediaInterfaces(); + +implementation + +uses + sysutils, + math, + UIni, + UMain, + UCommandLine, + URecord, + ULog; + +var + DefaultVideoPlayback : IVideoPlayback; + DefaultVisualization : IVideoPlayback; + DefaultAudioPlayback : IAudioPlayback; + DefaultAudioInput : IAudioInput; + AudioDecoderList : TInterfaceList; + MediaInterfaceList : TInterfaceList; + + +constructor TAudioFormatInfo.Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat); +begin + inherited Create(); + fChannels := Channels; + fSampleRate := SampleRate; + fFormat := Format; + UpdateFrameSize(); +end; + +procedure TAudioFormatInfo.SetChannels(Channels: byte); +begin + fChannels := Channels; + UpdateFrameSize(); +end; + +procedure TAudioFormatInfo.SetFormat(Format: TAudioSampleFormat); +begin + fFormat := Format; + UpdateFrameSize(); +end; + +function TAudioFormatInfo.GetBytesPerSec(): double; +begin + Result := FrameSize * SampleRate; +end; + +procedure TAudioFormatInfo.UpdateFrameSize(); +begin + fFrameSize := AudioSampleSize[fFormat] * fChannels; +end; + +function TAudioFormatInfo.Copy(): TAudioFormatInfo; +begin + Result := TAudioFormatInfo.Create(Self.Channels, Self.SampleRate, Self.Format); +end; + +function TAudioFormatInfo.GetRatio(TargetInfo: TAudioFormatInfo): double; +begin + Result := (TargetInfo.FrameSize / Self.FrameSize) * + (TargetInfo.SampleRate / Self.SampleRate) +end; + + +function MediaManager: TInterfaceList; +begin + if (not assigned(MediaInterfaceList)) then + MediaInterfaceList := TInterfaceList.Create(); + Result := MediaInterfaceList; +end; + +function VideoPlayback(): IVideoPlayback; +begin + Result := DefaultVideoPlayback; +end; + +function Visualization(): IVideoPlayback; +begin + Result := DefaultVisualization; +end; + +function AudioPlayback(): IAudioPlayback; +begin + Result := DefaultAudioPlayback; +end; + +function AudioInput(): IAudioInput; +begin + Result := DefaultAudioInput; +end; + +function AudioDecoders(): TInterfaceList; +begin + Result := AudioDecoderList; +end; + +procedure FilterInterfaceList(const IID: TGUID; InList, OutList: TInterfaceList); +var + i: integer; + obj: IInterface; +begin + if (not assigned(OutList)) then + Exit; + + OutList.Clear; + for i := 0 to InList.Count-1 do + begin + if assigned(InList[i]) then + begin + // add object to list if it implements the interface searched for + if (InList[i].QueryInterface(IID, obj) = 0) then + OutList.Add(obj); + end; + end; +end; + +procedure InitializeSound; +var + i: integer; + InterfaceList: TInterfaceList; + CurrentAudioDecoder: IAudioDecoder; + CurrentAudioPlayback: IAudioPlayback; + CurrentAudioInput: IAudioInput; +begin + // create a temporary list for interface enumeration + InterfaceList := TInterfaceList.Create(); + + // initialize all audio-decoders first + FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + begin + CurrentAudioDecoder := IAudioDecoder(InterfaceList[i]); + if (not CurrentAudioDecoder.InitializeDecoder()) then + begin + Log.LogError('Initialize failed, Removing - '+ CurrentAudioDecoder.GetName); + MediaManager.Remove(CurrentAudioDecoder); + end; + end; + + // create and setup decoder-list (see AudioDecoders()) + AudioDecoderList := TInterfaceList.Create; + FilterInterfaceList(IAudioDecoder, MediaManager, AudioDecoders); + + // find and initialize playback interface + DefaultAudioPlayback := nil; + FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + begin + CurrentAudioPlayback := IAudioPlayback(InterfaceList[i]); + if (CurrentAudioPlayback.InitializePlayback()) then + begin + DefaultAudioPlayback := CurrentAudioPlayback; + break; + end; + Log.LogError('Initialize failed, Removing - '+ CurrentAudioPlayback.GetName); + MediaManager.Remove(CurrentAudioPlayback); + end; + + // find and initialize input interface + DefaultAudioInput := nil; + FilterInterfaceList(IAudioInput, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + begin + CurrentAudioInput := IAudioInput(InterfaceList[i]); + if (CurrentAudioInput.InitializeRecord()) then + begin + DefaultAudioInput := CurrentAudioInput; + break; + end; + Log.LogError('Initialize failed, Removing - '+ CurrentAudioInput.GetName); + MediaManager.Remove(CurrentAudioInput); + end; + + InterfaceList.Free; + + // Update input-device list with registered devices + AudioInputProcessor.UpdateInputDeviceConfig(); + + // Load in-game sounds + SoundLib := TSoundLibrary.Create; +end; + +procedure InitializeVideo(); +var + i: integer; + InterfaceList: TInterfaceList; + VideoInterface: IVideoPlayback; + VisualInterface: IVideoVisualization; +begin + InterfaceList := TInterfaceList.Create; + + // initialize and set video-playback singleton + DefaultVideoPlayback := nil; + FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + begin + VideoInterface := IVideoPlayback(InterfaceList[i]); + if (VideoInterface.Init()) then + begin + DefaultVideoPlayback := VideoInterface; + break; + end; + Log.LogError('Initialize failed, Removing - '+ VideoInterface.GetName); + MediaManager.Remove(VideoInterface); + end; + + // initialize and set visualization singleton + DefaultVisualization := nil; + FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + begin + VisualInterface := IVideoVisualization(InterfaceList[i]); + if (VisualInterface.Init()) then + begin + DefaultVisualization := VisualInterface; + break; + end; + Log.LogError('Initialize failed, Removing - '+ VisualInterface.GetName); + MediaManager.Remove(VisualInterface); + end; + + InterfaceList.Free; + + // now that we have all interfaces, we can dump them + // TODO: move this to another place + if FindCmdLineSwitch( cMediaInterfaces ) then + begin + DumpMediaInterfaces(); + halt; + end; +end; + +procedure UnloadMediaModules; +var + i: integer; + InterfaceList: TInterfaceList; +begin + FreeAndNil(AudioDecoderList); + DefaultAudioPlayback := nil; + DefaultAudioInput := nil; + DefaultVideoPlayback := nil; + DefaultVisualization := nil; + + // create temporary interface list + InterfaceList := TInterfaceList.Create(); + + // finalize audio playback interfaces (should be done before the decoders) + FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + IAudioPlayback(InterfaceList[i]).FinalizePlayback(); + + // finalize audio input interfaces + FilterInterfaceList(IAudioInput, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + IAudioInput(InterfaceList[i]).FinalizeRecord(); + + // finalize audio decoder interfaces + FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + IAudioDecoder(InterfaceList[i]).FinalizeDecoder(); + + // finalize video interfaces + FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + IVideoPlayback(InterfaceList[i]).Finalize(); + + // finalize audio decoder interfaces + FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + IVideoVisualization(InterfaceList[i]).Finalize(); + + InterfaceList.Free; + + // finally free interfaces (by removing all references to them) + FreeAndNil(MediaInterfaceList); +end; + +procedure FinalizeMedia; +begin + // stop, close and free sounds + SoundLib.Free; + + // stop and close music stream + if (AudioPlayback <> nil) then + AudioPlayback.Close; + + // stop any active captures + if (AudioInput <> nil) then + AudioInput.CaptureStop; + + if (VideoPlayback <> nil) then + VideoPlayback.Close; + + if (Visualization <> nil) then + Visualization.Close; + + UnloadMediaModules(); +end; + +procedure DumpMediaInterfaces(); +begin + writeln( '' ); + writeln( '--------------------------------------------------------------' ); + writeln( ' In-use Media Interfaces ' ); + writeln( '--------------------------------------------------------------' ); + writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); + writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); + writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName ); + writeln( 'Registered Visualization Interface : ' + Visualization.GetName ); + writeln( '--------------------------------------------------------------' ); + writeln( '' ); +end; + + +{ TSoundLibrary } + +constructor TSoundLibrary.Create(); +begin + inherited; + LoadSounds(); +end; + +destructor TSoundLibrary.Destroy(); +begin + UnloadSounds(); + inherited; +end; + +procedure TSoundLibrary.LoadSounds(); +begin + UnloadSounds(); + + Start := AudioPlayback.OpenSound(SoundPath + 'Common start.mp3'); + Back := AudioPlayback.OpenSound(SoundPath + 'Common back.mp3'); + Swoosh := AudioPlayback.OpenSound(SoundPath + 'menu swoosh.mp3'); + Change := AudioPlayback.OpenSound(SoundPath + 'select music change music 50.mp3'); + Option := AudioPlayback.OpenSound(SoundPath + 'option change col.mp3'); + Click := AudioPlayback.OpenSound(SoundPath + 'rimshot022b.mp3'); + + BGMusic := AudioPlayback.OpenSound(SoundPath + 'Bebeto_-_Loop010.mp3'); + + if (BGMusic <> nil) then + BGMusic.Loop := True; +end; + +procedure TSoundLibrary.UnloadSounds(); +begin + FreeAndNil(Start); + FreeAndNil(Back); + FreeAndNil(Swoosh); + FreeAndNil(Change); + FreeAndNil(Option); + FreeAndNil(Click); + FreeAndNil(BGMusic); +end; + +(* TODO +function TSoundLibrary.GetSound(ID: integer): TAudioPlaybackStream; +begin + if ((ID >= 0) and (ID < Length(Sounds))) then + Result := Sounds[ID] + else + Result := nil; +end; +*) + +procedure TSoundLibrary.StartBgMusic(); +begin + if (TBackgroundMusicOption(Ini.BackgroundMusicOption) = bmoOn) and + (Soundlib.BGMusic <> nil) and not (Soundlib.BGMusic.Status = ssPlaying) then + begin + AudioPlayback.PlaySound(Soundlib.BGMusic); + end; +end; + +procedure TSoundLibrary.PauseBgMusic(); +begin + If (Soundlib.BGMusic <> nil) then + begin + Soundlib.BGMusic.Pause; + end; +end; + +{ TVoiceRemoval } + +procedure TVoiceRemoval.Callback(Buffer: PChar; BufSize: integer); +var + FrameIndex, FrameSize: integer; + Value: integer; + Sample: PPCMStereoSample; +begin + FrameSize := 2 * SizeOf(SmallInt); + for FrameIndex := 0 to (BufSize div FrameSize)-1 do + begin + Sample := PPCMStereoSample(Buffer); + // channel difference + Value := Sample[0] - Sample[1]; + // clip + if (Value > High(SmallInt)) then + Value := High(SmallInt) + else if (Value < Low(SmallInt)) then + Value := Low(SmallInt); + // assign result + Sample[0] := Value; + Sample[1] := Value; + // increase to next frame + Inc(Buffer, FrameSize); + end; +end; + + +{ TVoiceRemoval } + +constructor TLyricsState.Create(); +begin + // create a triggered timer, so we can Pause() it, set the time + // and Resume() it afterwards for better synching. + Timer := TRelativeTimer.Create(true); + + // reset state + Reset(); +end; + +procedure TLyricsState.Pause(); +begin + Timer.Pause(); +end; + +procedure TLyricsState.Resume(); +begin + Timer.Resume(); +end; + +procedure TLyricsState.SetCurrentTime(Time: real); +begin + // do not start the timer (if not started already), + // after setting the current time + Timer.SetTime(Time, false); +end; + +function TLyricsState.GetCurrentTime(): real; +begin + Result := Timer.GetTime(); +end; + +(** + * Resets the timer and state of the lyrics. + * The timer will be stopped afterwards so you have to call Resume() + * to start the lyrics timer. + *) +procedure TLyricsState.Reset(); +begin + Pause(); + SetCurrentTime(0); + + StartTime := 0; + TotalTime := 0; + + OldBeat := -1; + MidBeat := -1; + CurrentBeat := -1; + + OldBeatC := -1; + MidBeatC := -1; + CurrentBeatC := -1; + + OldBeatD := -1; + MidBeatD := -1; + CurrentBeatD := -1; +end; + +(** + * Updates the beat information (CurrentBeat/MidBeat/...) according to the + * current lyric time. + *) +procedure TLyricsState.UpdateBeats(); +var + CurLyricsTime: real; +begin + CurLyricsTime := GetCurrentTime(); + + OldBeat := CurrentBeat; + MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000); + CurrentBeat := Floor(MidBeat); + + OldBeatC := CurrentBeatC; + MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000); + CurrentBeatC := Floor(MidBeatC); + + OldBeatD := CurrentBeatD; + // MidBeatD = MidBeat with additional GAP + MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000); + CurrentBeatD := Floor(MidBeatD); +end; + + +{ TAudioConverter } + +function TAudioConverter.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; +begin + fSrcFormatInfo := SrcFormatInfo.Copy(); + fDstFormatInfo := DstFormatInfo.Copy(); + Result := true; +end; + +destructor TAudioConverter.Destroy(); +begin + FreeAndNil(fSrcFormatInfo); + FreeAndNil(fDstFormatInfo); +end; + + +{ TAudioProcessingStream } + +procedure TAudioProcessingStream.AddOnCloseHandler(Handler: TOnCloseHandler); +begin + if (@Handler <> nil) then + begin + SetLength(OnCloseHandlers, System.Length(OnCloseHandlers)+1); + OnCloseHandlers[High(OnCloseHandlers)] := @Handler; + end; +end; + +procedure TAudioProcessingStream.PerformOnClose(); +var i: integer; +begin + for i := 0 to High(OnCloseHandlers) do + begin + OnCloseHandlers[i](Self); + end; +end; + + +{ TAudioPlaybackStream } + +function TAudioPlaybackStream.GetSourceStream(): TAudioSourceStream; +begin + Result := SourceStream; +end; + +procedure TAudioPlaybackStream.SetSyncSource(SyncSource: TSyncSource); +begin + Self.SyncSource := SyncSource; + AvgSyncDiff := -1; +end; + +(* + * Results an adjusted size of the input buffer size to keep the stream in sync + * with the SyncSource. If no SyncSource was assigned to this stream, the + * input buffer size will be returned, so this method will have no effect. + * + * These are the possible cases: + * - Result > BufferSize: stream is behind the sync-source (stream is too slow), + * (Result-BufferSize) bytes of the buffer must be skipped. + * - Result = BufferSize: stream is in sync, + * there is nothing to do. + * - Result < BufferSize: stream is ahead of the sync-source (stream is too fast), + * (BufferSize-Result) bytes of the buffer must be padded. + *) +function TAudioPlaybackStream.Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; +var + TimeDiff: double; + TimeCorrectionFactor: double; +const + AVG_HISTORY_FACTOR = 0.9; + SYNC_THRESHOLD = 0.045; + MAX_SYNC_DIFF_TIME = 0.002; +begin + Result := BufferSize; + + if (not assigned(SyncSource)) then + Exit; + + if (BufferSize <= 0) then + Exit; + + // difference between sync-source and stream position + // (negative if the music-stream's position is ahead of the master clock) + TimeDiff := SyncSource.GetClock() - (Position - GetLatency()); + + // calculate average time difference (some sort of weighted mean). + // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff. + // This means that older diffs are weighted more with a higher history factor + // than with a lower. Do not use a too low history factor. FFmpeg produces + // very instable timestamps (pts) for ogg due to some bugs. They may differ + // +-50ms from the real stream position. Without filtering those glitches we + // would synch without any need, resulting in ugly plopping sounds. + if (AvgSyncDiff = -1) then + AvgSyncDiff := TimeDiff + else + AvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) + + AvgSyncDiff * AVG_HISTORY_FACTOR; + + // check if sync needed + if (Abs(AvgSyncDiff) >= SYNC_THRESHOLD) then + begin + // TODO: use SetPosition if diff is too large (>5s) + if (TimeDiff < 1) then + TimeCorrectionFactor := Sign(TimeDiff)*TimeDiff*TimeDiff + else + TimeCorrectionFactor := TimeDiff; + + // calculate adapted buffer size + // reduce size of data to fetch if music is ahead, increase otherwise + Result := BufferSize + Round(TimeCorrectionFactor * FormatInfo.SampleRate) * FormatInfo.FrameSize; + if (Result < 0) then + Result := 0; + + // reset average + AvgSyncDiff := -1; + end; + + (* + DebugWriteln('Diff: ' + floattostrf(TimeDiff, ffFixed, 15, 3) + + '| SyS: ' + floattostrf(SyncSource.GetClock(), ffFixed, 15, 3) + + '| Pos: ' + floattostrf(Position, ffFixed, 15, 3) + + '| Avg: ' + floattostrf(AvgSyncDiff, ffFixed, 15, 3)); + *) +end; + +(* + * Fills a buffer with copies of the given frame or with 0 if frame. + *) +procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer); +var + i: integer; + FrameCopyCount: integer; +begin + // the buffer must at least contain place for one copy of the frame. + if ((Buffer = nil) or (BufferSize <= 0) or (BufferSize < FrameSize)) then + Exit; + + // no valid frame -> fill with 0 + if ((Frame = nil) or (FrameSize <= 0)) then + begin + FillChar(Buffer[0], BufferSize, 0); + Exit; + end; + + // number of frames to copy + FrameCopyCount := BufferSize div FrameSize; + // insert as many copies of frame into the buffer as possible + for i := 0 to FrameCopyCount-1 do + Move(Frame[0], Buffer[i*FrameSize], FrameSize); +end; + +{ TAudioVoiceStream } + +function TAudioVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; +begin + Self.ChannelMap := ChannelMap; + Self.FormatInfo := FormatInfo.Copy(); + // a voice stream is always mono, reassure the the format is correct + Self.FormatInfo.Channels := 1; + Result := true; +end; + +destructor TAudioVoiceStream.Destroy; +begin + Close(); + inherited; +end; + +procedure TAudioVoiceStream.Close(); +begin + PerformOnClose(); + FreeAndNil(FormatInfo); +end; + +function TAudioVoiceStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + Result := FormatInfo; +end; + +function TAudioVoiceStream.GetLength(): real; +begin + Result := -1; +end; + +function TAudioVoiceStream.GetPosition(): real; +begin + Result := -1; +end; + +procedure TAudioVoiceStream.SetPosition(Time: real); +begin +end; + +function TAudioVoiceStream.GetLoop(): boolean; +begin + Result := false; +end; + +procedure TAudioVoiceStream.SetLoop(Enabled: boolean); +begin +end; + + +end. diff --git a/src/classes0/UParty.pas b/src/classes0/UParty.pas new file mode 100644 index 00000000..01a182b1 --- /dev/null +++ b/src/classes0/UParty.pas @@ -0,0 +1,630 @@ +unit UParty; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{$I switches.inc} + +uses UPartyDefs, UCoreModule, UPluginDefs; + +type + ARounds = Array [0..252] of Integer; //0..252 needed for + PARounds = ^ARounds; + + TRoundInfo = record + Modi: Cardinal; + Winner: Byte; + end; + + TeamOrderEntry = record + Teamnum: Byte; + Score: Byte; + end; + + TeamOrderArray = Array[0..5] of Byte; + + TUS_ModiInfoEx = record + Info: TUS_ModiInfo; + Owner: Integer; + TimesPlayed: Byte; //Helper for setting Round Plugins + end; + + TPartySession = class (TCoreModule) + private + bPartyMode: Boolean; //Is this Party or Singleplayer + CurRound: Byte; + + Modis: Array of TUS_ModiInfoEx; + Teams: TTeamInfo; + + function IsWinner(Player, Winner: Byte): boolean; + procedure GenScores; + function GetRandomPlugin(TeamMode: Boolean): Cardinal; + function GetRandomPlayer(Team: Byte): Byte; + public + //Teams: TTeamInfo; + Rounds: array of TRoundInfo; + + //TCoreModule methods to inherit + Constructor Create; override; + Procedure Info(const pInfo: PModuleInfo); override; + Function Load: Boolean; override; + Function Init: Boolean; override; + Procedure DeInit; override; + Destructor Destroy; override; + + //Register Modi Service + Function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo + + //Start new Party + Function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new Party Mode. Returns Non Zero on Success + Function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen) + Function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before. + Function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played + + Function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading + Function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and does the RoundEnding + + Function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success + Function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success + + Function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... + Function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam + end; + +const + StandardModi = 0; //Modi ID that will be played in non party Mode + +implementation + +uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils; + +{********************* + TPluginLoader + Implentation +*********************} + +//------------- +// Function that gives some Infos about the Module to the Core +//------------- +Procedure TPartySession.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TPartySession'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Manages Party Modi and Party Game'; +end; + +//------------- +// Just the Constructor +//------------- +Constructor TPartySession.Create; +begin + inherited; + //UnSet PartyMode + bPartyMode := False; +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 TPartySession.Load: Boolean; +begin + //Add Register Party Modi Service + Result := True; + Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi); + Core.Services.AddService('Party/StartParty', nil, Self.StartParty); + Core.Services.AddService('Party/GetCurModi', nil, Self.GetCurModi); +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 TPartySession.Init: Boolean; +begin + //Just set Prvate Var to true. + Result := true; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +Procedure TPartySession.DeInit; +begin + //Force DeInit + +end; + +//------------- +//Is Called if this Module will be unloaded and has been created +//Should be used to Free Memory +//------------- +Destructor TPartySession.Destroy; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Modis, 0); + inherited; +end; + +//------------- +// Registers a new Modi. wParam: Pointer to TUS_ModiInfo +// Service for Plugins +//------------- +Function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; +var + Len: Integer; + Info: PUS_ModiInfo; +begin + Info := PModiInfo; + //Copy Info if cbSize is correct + If (Info.cbSize = SizeOf(TUS_ModiInfo)) then + begin + Len := Length(Modis); + SetLength(Modis, Len + 1); + + Modis[Len].Info := Info^; + end + else + Core.ReportError(Integer(PChar('Plugins try to Register Modi with wrong Pointer, or wrong TUS_ModiInfo Record.')), PChar('TPartySession')); + + // FIXME: return a valid result + Result := 0; +end; + +//---------- +// Returns a Number of a Random Plugin +//---------- +Function TPartySession.GetRandomPlugin(TeamMode: Boolean): Cardinal; +var + LowestTP: Byte; + NumPwithLTP: Word; + I: Integer; + R: Word; +begin + Result := StandardModi; //If there are no matching Modis, Play StandardModi + LowestTP := high(Byte); + NumPwithLTP := 0; + + //Search for Plugins not often played yet + For I := 0 to high(Modis) do + begin + if (Modis[I].TimesPlayed < lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + begin + lowestTP := Modis[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + begin + Inc(NumPwithLTP); + end; + end; + + //Create Random No + R := Random(NumPwithLTP); + + //Search for Random Plugin + For I := 0 to high(Modis) do + begin + if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + begin + //Plugin Found + if (R = 0) then + begin + Result := I; + Inc(Modis[I].TimesPlayed); + Break; + end; + + Dec(R); + end; + end; +end; + +//---------- +// Starts new Party Mode. Returns Non Zero on Success +//---------- +Function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; +var + I: Integer; + aiRounds: PARounds; + TeamMode: Boolean; +begin + Result := 0; + If (Teams.NumTeams >= 1) AND (NumRounds < High(Byte)-1) then + begin + bPartyMode := false; + aiRounds := PAofIRounds; + + Try + //Is this Teammode(More then one Player per Team) ? + TeamMode := True; + For I := 0 to Teams.NumTeams-1 do + TeamMode := TeamMode AND (Teams.Teaminfo[I].NumPlayers > 1); + + //Set Rounds + SetLength(Rounds, NumRounds); + + For I := 0 to High(Rounds) do + begin //Set Plugins + If (aiRounds[I] = -1) then + Rounds[I].Modi := GetRandomPlugin(TeamMode) + Else If (aiRounds[I] >= 0) AND (aiRounds[I] <= High(Modis)) AND (TeamMode OR ((Modis[aiRounds[I]].Info.LoadingSettings AND MLS_TeamOnly) = 0)) then + Rounds[I].Modi := aiRounds[I] + Else + Rounds[I].Modi := StandardModi; + + Rounds[I].Winner := High(Byte); //Set Winner to Not Played + end; + + CurRound := High(Byte); //Set CurRound to not defined + + //Return teh true and Set PartyMode + bPartyMode := True; + Result := 1; + + Except + Core.ReportError(Integer(PChar('Can''t start PartyMode.')), PChar('TPartySession')); + end; + end; +end; + +//---------- +// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen) +//---------- +Function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer; +begin + If (bPartyMode) AND (CurRound <= High(Rounds)) then + begin //If PartyMode is enabled: + //Return the Plugin of the Cur Round + Result := Integer(@Modis[Rounds[CurRound].Modi]); + end + else + begin //Return StandardModi + Result := Integer(@Modis[StandardModi]); + end; +end; + +//---------- +// Stops Party Mode. Returns 1 If Partymode was enabled before. And -1 if Change was not possible +//---------- +Function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer; +begin + Result := -1; + If (bPartyMode) then + begin + // to-do : Whitü: Check here if SingScreen is not Shown atm. + bPartyMode := False; + Result := 1; + end + else + Result := 0; +end; + +//---------- +//GetRandomPlayer - Gives back a Random Player to Play next Round +//---------- +function TPartySession.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; +end; + +//---------- +// NextRound - Increases CurRound by 1; Returns num of Round or -1 if last Round is already played +//---------- +Function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer; +var I: Integer; +begin + If ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then + begin //everythings OK! -> Start the Round, maaaaan + Inc(CurRound); + + //Set Players to play this Round + for I := 0 to Teams.NumTeams-1 do + Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); + + // FIXME: return a valid result + Result := 0; + end + else + Result := -1; +end; + +//---------- +//IsWinner - Returns True if the Players Bit is set in the Winner Byte +//---------- +function TPartySession.IsWinner(Player, Winner: Byte): boolean; +var + Bit: Byte; +begin + Bit := 1 shl Player; + + Result := ((Winner AND Bit) = Bit); +end; + +//---------- +//GenScores - Inc Scores for Cur. Round +//---------- +procedure TPartySession.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; + +//---------- +// CallModiInit - Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading +//---------- +Function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer; +begin + If (not bPartyMode) then + begin //Set Rounds if not in PartyMode + SetLength(Rounds, 1); + Rounds[0].Modi := StandardModi; + Rounds[0].Winner := High(Byte); + CurRound := 0; + end; + + Try + //Core. + Except + on E : Exception do + begin + Core.ReportError(Integer(PChar('Error starting Modi: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession')); + If (Rounds[CurRound].Modi = StandardModi) then + begin + Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), PChar('TPartySession')); + Halt; + end + Else //Select StandardModi + begin + Rounds[CurRound].Modi := StandardModi + end; + end; + End; + + // FIXME: return a valid result + Result := 0; +end; + +//---------- +// CallModiDeInit - Calls DeInitProc and does the RoundEnding +//---------- +Function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; +var + I: Integer; + MaxScore: Word; +begin + If (bPartyMode) then + begin + //Get Winner Byte! + if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get Winners from Plugin + Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID) + else + begin //Create winners by Score :/ + Rounds[CurRound].Winner := 0; + MaxScore := 0; + for I := 0 to Teams.NumTeams-1 do + begin + // to-do : recode Percentage stuff + //PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999; + if (Player[I].ScoreTotalInt > MaxScore) then + begin + MaxScore := Player[I].ScoreTotalInt; + Rounds[CurRound].Winner := 1 shl I; + end + else if (Player[I].ScoreTotalInt = MaxScore) AND (Player[I].ScoreTotalInt <> 0) then + begin + Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I); + end; + end; + + + //When nobody has Points -> Everybody loose + if (MaxScore = 0) then + Rounds[CurRound].Winner := 0; + + end; + + //Generate teh Scores + GenScores; + + //Inc Players TimesPlayed + If ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings AND MLS_IncTP) = MLS_IncTP) then + begin + For I := 0 to Teams.NumTeams-1 do + Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed); + end; + end + else if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then + Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID); + + // FIXME: return a valid result + Result := 0; +end; + +//---------- +// GetTeamInfo - Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success +//---------- +Function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; +var Info: ^TTeamInfo; +begin + Result := -1; + Info := pTeamInfo; + If (Info <> nil) then + begin + Try + // to - do : Check Delphi memory management in this case + //Not sure if i had to copy PChars to a new address or if delphi manages this o0 + Info^ := Teams; + Result := 0; + Except + Result := -2; + End; + end; +end; + +//---------- +// SetTeamInfo - Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success +//---------- +Function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; +var + TeamInfobackup: TTeamInfo; + Info: ^TTeamInfo; +begin + Result := -1; + Info := pTeamInfo; + If (Info <> nil) then + begin + Try + TeamInfoBackup := Teams; + // to - do : Check Delphi memory management in this case + //Not sure if i had to copy PChars to a new address or if delphi manages this o0 + Teams := Info^; + Result := 0; + Except + Teams := TeamInfoBackup; + Result := -2; + End; + end; +end; + +//---------- +// GetTeamOrder - Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... +//---------- +Function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; +var + I, J: Integer; + ATeams: array [0..5] of TeamOrderEntry; + TempTeam: TeamOrderEntry; +begin + // to-do : PartyMode: Write this in another way, so that teams with the same scire get the same Placing + //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 + Result := 0; + For I := 0 to Teams.NumTeams-1 do + Result := Result or (ATeams[I].TeamNum Shl I*3); +end; + +//---------- +// GetWinnerString - wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam +//---------- +Function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer; +var + Winners: Array of String; + I: Integer; + ResultStr: String; + S: ^String; +begin + ResultStr := Language.Translate('PARTY_NOBODY'); + + if (wParam <= High(Rounds)) then + begin + if (Rounds[wParam].Winner <> 0) then + begin + if (Rounds[wParam].Winner = 255) then + begin + ResultStr := Language.Translate('PARTY_NOTPLAYEDYET'); + end + else + begin + SetLength(Winners, 0); + for I := 0 to Teams.NumTeams-1 do + begin + if isWinner(I, Rounds[wParam].Winner) then + begin + SetLength(Winners, Length(Winners) + 1); + Winners[high(Winners)] := Teams.TeamInfo[I].Name; + end; + end; + ResultStr := Language.Implode(Winners); + end; + end; + end; + + //Now Return what we have got + If (lParam = nil) then + begin //ReturnString Length + Result := Length(ResultStr); + end + Else + begin //Return String + Try + S := lParam; + S^ := ResultStr; + Result := 0; + Except + Result := -1; + + End; + end; +end; + +end. diff --git a/src/classes0/UPlatform.pas b/src/classes0/UPlatform.pas new file mode 100644 index 00000000..b71ac1b8 --- /dev/null +++ b/src/classes0/UPlatform.pas @@ -0,0 +1,165 @@ +unit UPlatform; + +// Comment by Eddie: +// This unit defines an interface for platform specific utility functions. +// The Interface is implemented in separate files for each platform: +// UPlatformWindows, UPlatformLinux and UPlatformMacOSX. + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes; + +type + TDirectoryEntry = record + Name : WideString; + IsDirectory : boolean; + IsFile : boolean; + end; + + TDirectoryEntryArray = array of TDirectoryEntry; + + TPlatform = class + procedure Init; virtual; + function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; virtual; abstract; + function TerminateIfAlreadyRunning(var WndTitle : string): boolean; virtual; + function FindSongFile(Dir, Mask: WideString): WideString; virtual; + procedure Halt; virtual; + function GetLogPath : WideString; virtual; abstract; + function GetGameSharedPath : WideString; virtual; abstract; + function GetGameUserPath : WideString; virtual; abstract; + function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; virtual; + end; + + function Platform(): TPlatform; + +implementation + +uses + SysUtils, + {$IFDEF MSWINDOWS} + UPlatformWindows, + {$ENDIF} + {$IFDEF LINUX} + UPlatformLinux, + {$ENDIF} + {$IFDEF DARWIN} + UPlatformMacOSX, + {$ENDIF} + ULog; + + +// I have modified it to use the Platform_singleton in this location ( in the implementaiton ) +// so that this variable can NOT be overwritten from anywhere else in the application. +// the accessor function platform, emulates all previous calls to work the same way. +var + Platform_singleton : TPlatform; + +function Platform : TPlatform; +begin + Result := Platform_singleton; +end; + +(** + * Default Init() implementation + *) +procedure TPlatform.Init; +begin +end; + +(** + * Default Halt() implementation + *) +procedure TPlatform.Halt; +begin + // Note: Application.terminate is NOT the same + System.Halt; +end; + +(** + * Default TerminateIfAlreadyRunning() implementation + *) +function TPlatform.TerminateIfAlreadyRunning(var WndTitle : string): Boolean; +begin + Result := false; +end; + +(** + * Default FindSongFile() implementation + *) +function TPlatform.FindSongFile(Dir, Mask: WideString): WideString; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if SysUtils.FindFirst(Dir + Mask, faDirectory, SR) = 0 then + begin + Result := SR.Name; + end; + SysUtils.FindClose(SR); +end; + +function TPlatform.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; +const + COPY_BUFFER_SIZE = 4096; // a good tradeoff between speed and memory consumption +var + SourceFile, TargetFile: TFileStream; + FileCopyBuffer: array [0..COPY_BUFFER_SIZE-1] of byte; // temporary copy-buffer. + NumberOfBytes: integer; // number of bytes read from SourceFile +begin + Result := false; + SourceFile := nil; + TargetFile := nil; + + // if overwrite is disabled return if the target file already exists + if (FailIfExists and FileExists(Target)) then + Exit; + + try + try + // open source and target file (might throw an exception on error) + SourceFile := TFileStream.Create(Source, fmOpenRead); + TargetFile := TFileStream.Create(Target, fmCreate or fmOpenWrite); + + while true do + begin + // read a block from the source file and check for errors or EOF + NumberOfBytes := SourceFile.Read(FileCopyBuffer, SizeOf(FileCopyBuffer)); + if (NumberOfBytes <= 0) then + Break; + // write block to target file and check if everything was written + if (TargetFile.Write(FileCopyBuffer, NumberOfBytes) <> NumberOfBytes) then + Exit; + end; + except + Exit; + end; + finally + SourceFile.Free; + TargetFile.Free; + end; + + Result := true; +end; + + +initialization +{$IFDEF MSWINDOWS} + Platform_singleton := TPlatformWindows.Create; +{$ENDIF} +{$IFDEF LINUX} + Platform_singleton := TPlatformLinux.Create; +{$ENDIF} +{$IFDEF DARWIN} + Platform_singleton := TPlatformMacOSX.Create; +{$ENDIF} + +finalization + Platform_singleton.Free; + +end. diff --git a/src/classes0/UPlatformLinux.pas b/src/classes0/UPlatformLinux.pas new file mode 100644 index 00000000..27fb130e --- /dev/null +++ b/src/classes0/UPlatformLinux.pas @@ -0,0 +1,160 @@ +unit UPlatformLinux; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes, + UPlatform, + UConfig; + +type + TPlatformLinux = class(TPlatform) + private + function GetHomeDir(): string; + public + function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override; + + function GetLogPath : WideString; override; + function GetGameSharedPath : WideString; override; + function GetGameUserPath : WideString; override; + end; + +implementation + +uses + UCommandLine, + BaseUnix, + {$IF FPC_VERSION_INT >= 2002002} + pwd, + {$IFEND} + SysUtils, + ULog; + +function TPlatformLinux.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; +var + i: Integer; + TheDir : pDir; + ADirent : pDirent; + Entry : Longint; + lAttrib : integer; +begin + i := 0; + Filter := LowerCase(Filter); + + TheDir := FpOpenDir( Dir ); + if Assigned(TheDir) then + begin + repeat + ADirent := FpReadDir(TheDir^); + + if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then + begin + lAttrib := FileGetAttr(Dir + ADirent^.d_name); + if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + until (ADirent = nil); + + FpCloseDir(TheDir^); + end; +end; + +function TPlatformLinux.GetLogPath: WideString; +begin + if FindCmdLineSwitch( cUseLocalPaths ) then + begin + Result := ExtractFilePath(ParamStr(0)); + end + else + begin + {$IFDEF UseLocalDirs} + Result := ExtractFilePath(ParamStr(0)); + {$ELSE} + Result := GetGameUserPath() + 'logs' + PathDelim; + {$ENDIF} + end; + + // create non-existing directories + ForceDirectories(Result); +end; + +function TPlatformLinux.GetGameSharedPath: WideString; +begin + if FindCmdLineSwitch( cUseLocalPaths ) then + Result := ExtractFilePath(ParamStr(0)) + else + begin + {$IFDEF UseLocalDirs} + Result := ExtractFilePath(ParamStr(0)); + {$ELSE} + Result := SharedPath + PathDelim; + {$ENDIF} + end; +end; + +function TPlatformLinux.GetGameUserPath: WideString; +begin + if FindCmdLineSwitch( cUseLocalPaths ) then + Result := ExtractFilePath(ParamStr(0)) + else + begin + {$IFDEF UseLocalDirs} + Result := ExtractFilePath(ParamStr(0)); + {$ELSE} + Result := GetHomeDir() + '.'+PathSuffix + PathDelim; + {$ENDIF} + end; +end; + +(** + * Returns the user's home directory terminated by a path delimiter + *) +function TPlatformLinux.GetHomeDir(): string; +{$IF FPC_VERSION_INT >= 2002002} +var + PasswdEntry: PPasswd; +{$IFEND} +begin + Result := ''; + + {$IF FPC_VERSION_INT >= 2002002} + // try to retrieve the info from passwd + PasswdEntry := FpGetpwuid(FpGetuid()); + if (PasswdEntry <> nil) then + Result := PasswdEntry.pw_dir; + {$IFEND} + // fallback if passwd does not contain the path + if (Result = '') then + Result := GetEnvironmentVariable('HOME'); + // add trailing path delimiter (normally '/') + if (Result <> '') then + Result := IncludeTrailingPathDelimiter(Result); + + {$IF FPC_VERSION_INT >= 2002002} + // GetUserDir() is another function that returns a user path. + // It uses env-var HOME or a fallback to a temp-dir. + //Result := GetUserDir(); + {$IFEND} +end; + +end. diff --git a/src/classes0/UPlatformMacOSX.pas b/src/classes0/UPlatformMacOSX.pas new file mode 100644 index 00000000..849c354b --- /dev/null +++ b/src/classes0/UPlatformMacOSX.pas @@ -0,0 +1,294 @@ +unit UPlatformMacOSX; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes, + ULog, + UPlatform; + +type + {** + * @abstract(Provides Mac OS X specific details.) + * @lastmod(August 1, 2008) + * The UPlatformMacOSX unit takes care of setting paths to resource folders. + * + * (Note for non-Maccies: "folder" is the Mac name for directory.) + * + * Note on the resource folders: + * 1. Installation of an application on the mac works as follows: Extract and copy an application + * and if you don't like or need the application anymore you move the folder + * to the trash - and you're done. + * 2. The use folders in the user's home directory is against Apple's guidelines + * and strange to an average user. + * 3. Even worse is using /usr/local/... since all lowercase folders in / are + * not visible to an average user in the Finder, at least not without some "tricks". + * + * The best way would be to store everything within the application bundle. However, this + * requires USDX to offer the handling of the resources. Until this is implemented, the + * second best solution is as follows: + * + * According to Aple guidelines handling of resources and folders should follow these lines: + * + * Acceptable places for files are folders named UltraStarDeluxe either in + * /Library/Application Support/ + * or + * ~/Library/Application Support/ + * + * So + * GetGameSharedPath could return + * /Library/Application Support/UltraStarDeluxe/Resources/. + * GetGameUserPath could return + * ~/Library/Application Support/UltraStarDeluxe/Resources/. + * + * Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources + * is used. So every user needs the complete set of files and folders. + * Future versions may also use shared resources in + * /Library/Application Support/UltraStarDeluxe/Resources. However, this is not + * treated yet in the code outside this unit. + * + * USDX checks, whether GetGameUserPath exists. If not, USDX creates it. + * The existence of needed files is then checked and if a file is missing + * it is copied to there from within the Resources folder in the Application + * bundle, which contains the default files. USDX should not delete files or + * folders in Application Support/UltraStarDeluxe automatically or without + * user confirmation. + *} + TPlatformMacOSX = class(TPlatform) + private + {** + * GetBundlePath returns the path to the application bundle UltraStarDeluxe.app. + *} + function GetBundlePath: WideString; + + {** + * GetApplicationSupportPath returns the path to + * $HOME/Library/Application Support/UltraStarDeluxe/Resources. + *} + function GetApplicationSupportPath: WideString; + + {** + * see the description of @link(Init). + *} + procedure CreateUserFolders(); + + public + {** + * Init simply calls @link(CreateUserFolders), which in turn scans the folder + * UltraStarDeluxe.app/Contents/Resources for all files and folders. + * $HOME/Library/Application Support/UltraStarDeluxe/Resources is then checked + * for their presence and missing ones are copied. + *} + procedure Init; override; + + {** + * DirectoryFindFiles returns all entries of a folder with names and booleans + * about their type, i.e. file or directory. + *} + function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; override; + + {** + * GetLogPath returns the path for log messages. Currently it is set to + * $HOME/Library/Application Support/UltraStarDeluxe/Resources/Log. + *} + function GetLogPath : WideString; override; + + {** + * GetGameSharedPath returns the path for shared resources. Currently it is set to + * /Library/Application Support/UltraStarDeluxe/Resources. + * However it is not used. + *} + function GetGameSharedPath : WideString; override; + + {** + * GetGameUserPath returns the path for user resources. Currently it is set to + * $HOME/Library/Application Support/UltraStarDeluxe/Resources. + * This is where a user can add songs, themes, .... + *} + function GetGameUserPath : WideString; override; + end; + +implementation + +uses + SysUtils, + BaseUnix; + +procedure TPlatformMacOSX.Init; +begin + CreateUserFolders(); +end; + +procedure TPlatformMacOSX.CreateUserFolders(); +var + RelativePath: string; + // BaseDir contains the path to the folder, where a search is performed. + // It is set to the entries in @link(DirectoryList) one after the other. + BaseDir: string; + // OldBaseDir contains the path to the folder, where the search started. + // It is used to return to it, when the search is completed in all folders. + OldBaseDir: string; + // This record contains the result of a file search with FindFirst or FindNext + SearchInfo: TSearchRec; + // These two lists contain all folder and file names found + // within the folder @link(BaseDir). + DirectoryList, FileList: TStringList; + // DirectoryIsFinished contains the index of the folder in @link(DirectoryList), + // which is the last one completely searched. Later folders are still to be + // searched for additional files and folders. + DirectoryIsFinished: longint; + Counter: longint; + + UserPathName: string; +const + // used to construct the @link(UserPathName) + PathName: string = '/Library/Application Support/UltraStarDeluxe/Resources'; +begin + // Get the current folder and save it in OldBaseDir for returning to it, when + // finished. + GetDir(0, OldBaseDir); + + // UltraStarDeluxe.app/Contents/Resources contains all the default files and + // folders. + BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents/Resources'; + ChDir(BaseDir); + + // Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources + // is used. + UserPathName := GetEnvironmentVariable('HOME') + PathName; + + DirectoryIsFinished := 0; + DirectoryList := TStringList.Create(); + FileList := TStringList.Create(); + DirectoryList.Add('.'); + + // create the folder and file lists + repeat + + RelativePath := DirectoryList[DirectoryIsFinished]; + ChDir(BaseDir + '/' + RelativePath); + if (FindFirst('*', faAnyFile, SearchInfo) = 0) then + begin + repeat + if DirectoryExists(SearchInfo.Name) then + begin + if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then + DirectoryList.Add(RelativePath + '/' + SearchInfo.Name); + end + else + Filelist.Add(RelativePath + '/' + SearchInfo.Name); + until (FindNext(SearchInfo) <> 0); + end; + FindClose(SearchInfo); + Inc(DirectoryIsFinished); + until (DirectoryIsFinished = DirectoryList.Count); + + // create missing folders + for Counter := 0 to DirectoryList.Count-1 do + begin + if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then + Log.LogError('Failed to create the folder "'+ UserPathName + '/' + DirectoryList[Counter] +'"', + 'TPlatformMacOSX.CreateUserFolders'); + end; + DirectoryList.Free(); + + // copy missing files + for Counter := 0 to Filelist.Count-1 do + begin + CopyFile(BaseDir + '/' + Filelist[Counter], + UserPathName + '/' + Filelist[Counter], true); + end; + FileList.Free(); + + // go back to the initial folder + ChDir(OldBaseDir); +end; + +function TPlatformMacOSX.GetBundlePath: WideString; +var + i, pos : integer; +begin + // Mac applications are packaged in folders. + // We have to cut the last two folders + // to get the application folder. + + Result := ExtractFilePath(ParamStr(0)); + for i := 1 to 2 do + begin + pos := Length(Result); + repeat + Delete(Result, pos, 1); + pos := Length(Result); + until (pos = 0) or (Result[pos] = '/'); + end; +end; + +function TPlatformMacOSX.GetApplicationSupportPath: WideString; +const + PathName : string = '/Library/Application Support/UltraStarDeluxe/Resources'; +begin + Result := GetEnvironmentVariable('HOME') + PathName + '/'; +end; + +function TPlatformMacOSX.GetLogPath: WideString; +begin + Result := GetApplicationSupportPath + 'Logs'; +end; + +function TPlatformMacOSX.GetGameSharedPath: WideString; +begin + Result := GetApplicationSupportPath; +end; + +function TPlatformMacOSX.GetGameUserPath: WideString; +begin + Result := GetApplicationSupportPath; +end; + +function TPlatformMacOSX.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; +var + i : integer; + TheDir : pdir; + ADirent : pDirent; + lAttrib : integer; +begin + i := 0; + Filter := LowerCase(Filter); + + TheDir := FPOpenDir(Dir); + if Assigned(TheDir) then + repeat + ADirent := FPReadDir(TheDir); + + if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then + begin + lAttrib := FileGetAttr(Dir + ADirent^.d_name); + if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then + begin + SetLength(Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then + begin + SetLength(Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + until ADirent = nil; + + FPCloseDir(TheDir); +end; + +end. diff --git a/src/classes0/UPlatformWindows.pas b/src/classes0/UPlatformWindows.pas new file mode 100644 index 00000000..ee132a7b --- /dev/null +++ b/src/classes0/UPlatformWindows.pas @@ -0,0 +1,236 @@ +unit UPlatformWindows; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +// turn off messages for platform specific symbols +{$WARN SYMBOL_PLATFORM OFF} + +uses + Classes, + UPlatform; + +type + TPlatformWindows = class(TPlatform) + private + function GetSpecialPath(CSIDL: integer): WideString; + public + function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override; + function TerminateIfAlreadyRunning(var WndTitle: String): Boolean; override; + + function GetLogPath: WideString; override; + function GetGameSharedPath: WideString; override; + function GetGameUserPath: WideString; override; + + function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; override; + end; + +implementation + +uses + SysUtils, + ShlObj, + Windows, + UConfig; + +type + TSearchRecW = record + Time: Integer; + Size: Integer; + Attr: Integer; + Name: WideString; + ExcludeAttr: Integer; + FindHandle: THandle; + FindData: TWin32FindDataW; + end; + +function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; forward; +function FindNextW(var F: TSearchRecW): Integer; forward; +procedure FindCloseW(var F: TSearchRecW); forward; +function FindMatchingFileW(var F: TSearchRecW): Integer; forward; +function DirectoryExistsW(const Directory: widestring): Boolean; forward; + +function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; +const + faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; +begin + F.ExcludeAttr := not Attr and faSpecial; +{$IFDEF Delphi} + F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); +{$ELSE} + F.FindHandle := FindFirstFileW(PWideChar(Path), @F.FindData); +{$ENDIF} + if F.FindHandle <> INVALID_HANDLE_VALUE then + begin + Result := FindMatchingFileW(F); + if Result <> 0 then FindCloseW(F); + end else + Result := GetLastError; +end; + +function FindNextW(var F: TSearchRecW): Integer; +begin +{$IFDEF Delphi} + if FindNextFileW(F.FindHandle, F.FindData) then +{$ELSE} + if FindNextFileW(F.FindHandle, @F.FindData) then +{$ENDIF} + Result := FindMatchingFileW(F) + else + Result := GetLastError; +end; + +procedure FindCloseW(var F: TSearchRecW); +begin + if F.FindHandle <> INVALID_HANDLE_VALUE then + begin + Windows.FindClose(F.FindHandle); + F.FindHandle := INVALID_HANDLE_VALUE; + end; +end; + +function FindMatchingFileW(var F: TSearchRecW): Integer; +var + LocalFileTime: TFileTime; +begin + with F do + begin + while FindData.dwFileAttributes and ExcludeAttr <> 0 do +{$IFDEF Delphi} + if not FindNextFileW(FindHandle, FindData) then +{$ELSE} + if not FindNextFileW(FindHandle, @FindData) then +{$ENDIF} + begin + Result := GetLastError; + Exit; + end; + FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); + FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); + Size := FindData.nFileSizeLow; + Attr := FindData.dwFileAttributes; + Name := FindData.cFileName; + end; + Result := 0; +end; + +function DirectoryExistsW(const Directory: widestring): Boolean; +var + Code: Integer; +begin + Code := GetFileAttributesW(PWideChar(Directory)); + Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); +end; + +//------------------------------ +//Start more than One Time Prevention +//------------------------------ +function TPlatformWindows.TerminateIfAlreadyRunning(var WndTitle: String): Boolean; +var + hWnd: THandle; + I: Integer; +begin + Result := false; + hWnd:= FindWindow(nil, PChar(WndTitle)); + //Programm already started + if (hWnd <> 0) then + begin + I := Messagebox(0, PChar('Another Instance of Ultrastar is already running. Continue ?'), PChar(WndTitle), MB_ICONWARNING or MB_YESNO); + if (I = IDYes) then + begin + I := 1; + repeat + Inc(I); + hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I))); + until (hWnd = 0); + WndTitle := WndTitle + ' Instance ' + InttoStr(I); + end + else + Result := true; + end; +end; + +function TPlatformWindows.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; +var + i : Integer; + SR : TSearchRecW; + Attrib : Integer; +begin + i := 0; + Filter := LowerCase(Filter); + + if FindFirstW(Dir + '*', faAnyFile or faDirectory, SR) = 0 then + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + begin + Attrib := FileGetAttr(Dir + SR.name); + if ReturnAllSubDirs and ((Attrib and faDirectory) <> 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := SR.name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(SR.Name)) > 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := SR.Name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + until FindNextW(SR) <> 0; + FindCloseW(SR); +end; + +(** + * Returns the path of a special folder. + * + * Some Folder IDs: + * CSIDL_APPDATA (e.g. C:\Documents and Settings\username\Application Data) + * CSIDL_LOCAL_APPDATA (e.g. C:\Documents and Settings\username\Local Settings\Application Data) + * CSIDL_PROFILE (e.g. C:\Documents and Settings\username) + * CSIDL_PERSONAL (e.g. C:\Documents and Settings\username\My Documents) + * CSIDL_MYMUSIC (e.g. C:\Documents and Settings\username\My Documents\My Music) + *) +function TPlatformWindows.GetSpecialPath(CSIDL: integer): WideString; +var + Buffer: array [0..MAX_PATH-1] of WideChar; +begin +{$IF Defined(Delphi) or (FPC_VERSION_INT >= 2002002)} // >= 2.2.2 + if (SHGetSpecialFolderPathW(0, @Buffer, CSIDL, false)) then + Result := Buffer + else +{$IFEND} + Result := ''; +end; + +function TPlatformWindows.GetLogPath: WideString; +begin + Result := ExtractFilePath(ParamStr(0)); +end; + +function TPlatformWindows.GetGameSharedPath: WideString; +begin + Result := ExtractFilePath(ParamStr(0)); +end; + +function TPlatformWindows.GetGameUserPath: WideString; +begin + //Result := GetSpecialPath(CSIDL_APPDATA) + PathDelim + 'UltraStarDX' + PathDelim; + Result := ExtractFilePath(ParamStr(0)); +end; + +function TPlatformWindows.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; +begin + Result := Windows.CopyFileW(PWideChar(Source), PWideChar(Target), FailIfExists); +end; + +end. diff --git a/src/classes0/UPlaylist.pas b/src/classes0/UPlaylist.pas new file mode 100644 index 00000000..c867c356 --- /dev/null +++ b/src/classes0/UPlaylist.pas @@ -0,0 +1,490 @@ +unit UPlaylist; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + USong; + +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: TSingMode; //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 + inherited; + LoadPlayLists; +end; + +//---------- +//LoadPlayLists - Load list of Playlists from PlayList Folder +//---------- +Procedure TPlayListManager.LoadPlayLists; +var + SR: TSearchRec; + Len: Integer; + PlayListBuffer: TPlayList; +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) + else + begin + // Sort the Playlists - Insertion Sort + PlayListBuffer := Playlists[Len]; + Dec(Len); + while (Len >= 0) AND (CompareText(Playlists[Len].Name, PlayListBuffer.Name) >= 0) do + begin + Playlists[Len+1] := Playlists[Len]; + Dec(Len); + end; + Playlists[Len+1] := PlayListBuffer; + end; + + 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 (Int(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 := smPlayListRandom; + + //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); + + // Sort the Playlists - Insertion Sort + while (Result > 0) AND (CompareText(Playlists[Result - 1].Name, Name) >= 0) do + begin + Dec(Result); + Playlists[Result+1] := Playlists[Result]; + end; + 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 Int(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 (Int(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 (Int(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 + Result := -1; + + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + For I := 0 to high(Playlists[P].Items) do + begin + if (Playlists[P].Items[I].SongID = Int(SongID)) then + begin + Result := I; + Break; + end; + end; +end; + +end. diff --git a/src/classes0/UPluginInterface.pas b/src/classes0/UPluginInterface.pas new file mode 100644 index 00000000..77693d0f --- /dev/null +++ b/src/classes0/UPluginInterface.pas @@ -0,0 +1,156 @@ +unit uPluginInterface; +{********************* + uPluginInterface + Unit fills a TPluginInterface Structur with Method Pointers + Unit Contains all Functions called directly by Plugins +*********************} + +interface + +{$I switches.inc} + +uses uPluginDefs; + +//--------------- +// Methods for Plugin +//--------------- + {******** Hook specific Methods ********} + {Function Creates a new Hookable Event and Returns the Handle + or 0 on Failure. (Name already exists)} + Function CreateHookableEvent (EventName: PChar): THandle; stdcall; + + {Function Destroys an Event and Unhooks all Hooks to this Event. + 0 on success, not 0 on Failure} + Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; + + {Function start calling the Hook Chain + 0 if Chain is called until the End, -1 if Event Handle is not valid + otherwise Return Value of the Hook that breaks the Chain} + Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; + + {Function Hooks an Event by Name. + Returns Hook Handle on Success, otherwise 0} + Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; + + {Function Removes the Hook from the Chain + Returns 0 on Success} + Function UnHookEvent (hHook: THandle): Integer; stdcall; + + {Function Returns Non Zero if a Event with the given Name Exists, + otherwise 0} + Function EventExists (EventName: PChar): Integer; stdcall; + + {******** Service specific Methods ********} + {Function Creates a new Service and Returns the Services Handle + or 0 on Failure. (Name already exists)} + Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; + + {Function Destroys a Service. + 0 on success, not 0 on Failure} + Function DestroyService (hService: THandle): integer; stdcall; + + {Function Calls a Services Proc + Returns Services Return Value or SERVICE_NOT_FOUND on Failure} + Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; + + {Function Returns Non Zero if a Service with the given Name Exists, + otherwise 0} + Function ServiceExists (ServiceName: PChar): Integer; stdcall; + +implementation +uses UCore; + +{******** Hook specific Methods ********} +//--------------- +// Function Creates a new Hookable Event and Returns the Handle +// or 0 on Failure. (Name already exists) +//--------------- +Function CreateHookableEvent (EventName: PChar): THandle; stdcall; +begin + Result := Core.Hooks.AddEvent(EventName); +end; + +//--------------- +// Function Destroys an Event and Unhooks all Hooks to this Event. +// 0 on success, not 0 on Failure +//--------------- +Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; +begin + Result := Core.Hooks.DelEvent(hEvent); +end; + +//--------------- +// Function start calling the Hook Chain +// 0 if Chain is called until the End, -1 if Event Handle is not valid +// otherwise Return Value of the Hook that breaks the Chain +//--------------- +Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; +begin + Result := Core.Hooks.CallEventChain(hEvent, wParam, lParam); +end; + +//--------------- +// Function Hooks an Event by Name. +// Returns Hook Handle on Success, otherwise 0 +//--------------- +Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; +begin + Result := Core.Hooks.AddSubscriber(EventName, HookProc); +end; + +//--------------- +// Function Removes the Hook from the Chain +// Returns 0 on Success +//--------------- +Function UnHookEvent (hHook: THandle): Integer; stdcall; +begin + Result := Core.Hooks.DelSubscriber(hHook); +end; + +//--------------- +// Function Returns Non Zero if a Event with the given Name Exists, +// otherwise 0 +//--------------- +Function EventExists (EventName: PChar): Integer; stdcall; +begin + Result := Core.Hooks.EventExists(EventName); +end; + + {******** Service specific Methods ********} +//--------------- +// Function Creates a new Service and Returns the Services Handle +// or 0 on Failure. (Name already exists) +//--------------- +Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; +begin + Result := Core.Services.AddService(ServiceName, ServiceProc); +end; + +//--------------- +// Function Destroys a Service. +// 0 on success, not 0 on Failure +//--------------- +Function DestroyService (hService: THandle): integer; stdcall; +begin + Result := Core.Services.DelService(hService); +end; + +//--------------- +// Function Calls a Services Proc +// Returns Services Return Value or SERVICE_NOT_FOUND on Failure +//--------------- +Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; +begin + Result := Core.Services.CallService(ServiceName, wParam, lParam); +end; + +//--------------- +// Function Returns Non Zero if a Service with the given Name Exists, +// otherwise 0 +//--------------- +Function ServiceExists (ServiceName: PChar): Integer; stdcall; +begin + Result := Core.Services.ServiceExists(ServiceName); +end; + +end. diff --git a/src/classes0/URecord.pas b/src/classes0/URecord.pas new file mode 100644 index 00000000..8a537dc9 --- /dev/null +++ b/src/classes0/URecord.pas @@ -0,0 +1,766 @@ +unit URecord; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, + Math, + SysUtils, + sdl, + UCommon, + UMusic, + UIni; + +const + BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz) + NumHalftones = 36; // C2-B4 (for Whitney and my high voice) + +type + TCaptureBuffer = class + private + VoiceStream: TAudioVoiceStream; // stream for voice passthrough + AnalysisBufferLock: PSDL_Mutex; + + function GetToneString: string; // converts a tone to its string represenatation; + + procedure BoostBuffer(Buffer: PChar; Size: Cardinal); + procedure ProcessNewBuffer(Buffer: PChar; BufferSize: integer); + + // we call it to analyze sound by checking Autocorrelation + procedure AnalyzeByAutocorrelation; + // use this to check one frequency by Autocorrelation + function AnalyzeAutocorrelationFreq(Freq: real): real; + public + AnalysisBuffer: array[0..4095] of smallint; // newest 4096 samples + AnalysisBufferSize: integer; // number of samples of BufferArray to analyze + + LogBuffer: TMemoryStream; // full buffer + + AudioFormat: TAudioFormatInfo; + + // pitch detection + // TODO: remove ToneValid, set Tone/ToneAbs=-1 if invalid instead + ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise) + Tone: integer; // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11 + ToneAbs: integer; // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1 + + // methods + constructor Create; + destructor Destroy; override; + + procedure Clear; + + // use to analyze sound from buffers to get new pitch + procedure AnalyzeBuffer; + procedure LockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} + procedure UnlockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} + + function MaxSampleVolume: Single; + property ToneString: string READ GetToneString; + end; + +const + DEFAULT_SOURCE_NAME = '[Default]'; + +type + TAudioInputSource = record + Name: string; + end; + + // soundcard input-devices information + TAudioInputDevice = class + public + CfgIndex: integer; // index of this device in Ini.InputDeviceConfig + Name: string; // soundcard name + Source: array of TAudioInputSource; // soundcard input-sources + SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected) + MicSource: integer; // source-index of mic (-1: none detected) + + AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo) + CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data + + destructor Destroy; override; + + procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); + + // TODO: add Open/Close functions so Start/Stop becomes faster + //function Open(): boolean; virtual; abstract; + //function Close(): boolean; virtual; abstract; + function Start(): boolean; virtual; abstract; + function Stop(): boolean; virtual; abstract; + + function GetVolume(): single; virtual; abstract; + procedure SetVolume(Volume: single); virtual; abstract; + end; + + TAudioInputProcessor = class + public + Sound: array of TCaptureBuffer; // sound-buffers for every player + DeviceList: array of TAudioInputDevice; + + constructor Create; + destructor Destroy; override; + + procedure UpdateInputDeviceConfig; + + // handle microphone input + procedure HandleMicrophoneData(Buffer: PChar; Size: Cardinal; + InputDevice: TAudioInputDevice); + end; + + TAudioInputBase = class( TInterfacedObject, IAudioInput ) + private + Started: boolean; + protected + function UnifyDeviceName(const name: string; deviceIndex: integer): string; + public + function GetName: String; virtual; abstract; + function InitializeRecord: boolean; virtual; abstract; + function FinalizeRecord: boolean; virtual; + + procedure CaptureStart; + procedure CaptureStop; + end; + + + TSmallIntArray = array [0..(MaxInt div SizeOf(SmallInt))-1] of SmallInt; + PSmallIntArray = ^TSmallIntArray; + + function AudioInputProcessor(): TAudioInputProcessor; + +implementation + +uses + ULog, + UMain; + +var + singleton_AudioInputProcessor : TAudioInputProcessor = nil; + + +{ Global } + +function AudioInputProcessor(): TAudioInputProcessor; +begin + if singleton_AudioInputProcessor = nil then + singleton_AudioInputProcessor := TAudioInputProcessor.create(); + + result := singleton_AudioInputProcessor; +end; + + +{ TAudioInputDevice } + +destructor TAudioInputDevice.Destroy; +begin + Stop(); + Source := nil; + CaptureChannel := nil; + FreeAndNil(AudioFormat); + inherited Destroy; +end; + +procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); +var + DeviceCfg: PInputDeviceConfig; + OldSound: TCaptureBuffer; +begin + // check bounds + if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then + Exit; + + // reset previously assigned (old) capture-buffer + OldSound := CaptureChannel[ChannelIndex]; + if (OldSound <> nil) then + begin + // close voice stream + FreeAndNil(OldSound.VoiceStream); + // free old audio-format info + FreeAndNil(OldSound.AudioFormat); + end; + + // set audio-format of new capture-buffer + if (Sound <> nil) then + begin + // copy the input-device audio-format ... + Sound.AudioFormat := AudioFormat.Copy; + // and adjust it because capture buffers are always mono + Sound.AudioFormat.Channels := 1; + DeviceCfg := @Ini.InputDeviceConfig[CfgIndex]; + + if (Ini.VoicePassthrough = 1) then + begin + // TODO: map odd players to the left and even players to the right speaker + Sound.VoiceStream := AudioPlayback.CreateVoiceStream(CHANNELMAP_FRONT, AudioFormat); + end; + end; + + // replace old with new buffer (Note: Sound might be nil) + CaptureChannel[ChannelIndex] := Sound; +end; + +{ TSound } + +constructor TCaptureBuffer.Create; +begin + inherited; + LogBuffer := TMemoryStream.Create; + AnalysisBufferLock := SDL_CreateMutex(); + AnalysisBufferSize := Length(AnalysisBuffer); +end; + +destructor TCaptureBuffer.Destroy; +begin + FreeAndNil(LogBuffer); + FreeAndNil(VoiceStream); + FreeAndNil(AudioFormat); + SDL_DestroyMutex(AnalysisBufferLock); + inherited; +end; + +procedure TCaptureBuffer.LockAnalysisBuffer(); +begin + SDL_mutexP(AnalysisBufferLock); +end; + +procedure TCaptureBuffer.UnlockAnalysisBuffer(); +begin + SDL_mutexV(AnalysisBufferLock); +end; + +procedure TCaptureBuffer.Clear; +begin + if assigned(LogBuffer) then + LogBuffer.Clear; + LockAnalysisBuffer(); + FillChar(AnalysisBuffer[0], Length(AnalysisBuffer) * SizeOf(SmallInt), 0); + UnlockAnalysisBuffer(); +end; + +procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PChar; BufferSize: integer); +var + BufferOffset: integer; + SampleCount: integer; + i: integer; +begin + // apply software boost + //BoostBuffer(Buffer, Size); + + // voice passthrough (send data to playback-device) + if (assigned(VoiceStream)) then + VoiceStream.WriteData(Buffer, BufferSize); + + // we assume that samples are in S16Int format + // TODO: support float too + if (AudioFormat.Format <> asfS16) then + Exit; + + // process BufferArray + BufferOffset := 0; + + SampleCount := BufferSize div SizeOf(SmallInt); + + // check if we have more new samples than we can store + if (SampleCount > Length(AnalysisBuffer)) then + begin + // discard the oldest of the new samples + BufferOffset := (SampleCount - Length(AnalysisBuffer)) * SizeOf(SmallInt); + SampleCount := Length(AnalysisBuffer); + end; + + + LockAnalysisBuffer(); + try + + // move old samples to the beginning of the array (if necessary) + for i := 0 to High(AnalysisBuffer)-SampleCount do + AnalysisBuffer[i] := AnalysisBuffer[i+SampleCount]; + + // copy new samples to analysis buffer + Move(Buffer[BufferOffset], AnalysisBuffer[Length(AnalysisBuffer)-SampleCount], + SampleCount * SizeOf(SmallInt)); + + finally + UnlockAnalysisBuffer(); + end; + + + // save capture-data to BufferLong if enabled + if (Ini.SavePlayback = 1) then + begin + // this is just for debugging (approx 15MB per player for a 3min song!!!) + // For an in-game replay-mode we need to compress data so we do not + // waste that much memory. Maybe ogg-vorbis with voice-preset in fast-mode? + // Or we could use a faster but not that efficient lossless compression. + LogBuffer.WriteBuffer(Buffer, BufferSize); + end; +end; + +procedure TCaptureBuffer.AnalyzeBuffer; +var + Volume: single; + MaxVolume: single; + SampleIndex: integer; + Threshold: single; +begin + ToneValid := false; + ToneAbs := -1; + Tone := -1; + + LockAnalysisBuffer(); + try + + // find maximum volume of first 1024 samples + MaxVolume := 0; + for SampleIndex := 0 to 1023 do + begin + Volume := Abs(AnalysisBuffer[SampleIndex]) / -Low(Smallint); + if Volume > MaxVolume then + MaxVolume := Volume; + end; + + Threshold := IThresholdVals[Ini.ThresholdIndex]; + + // check if signal has an acceptable volume (ignore background-noise) + if MaxVolume >= Threshold then + begin + // analyse the current voice pitch + AnalyzeByAutocorrelation; + ToneValid := true; + end; + + finally + UnlockAnalysisBuffer(); + end; +end; + +procedure TCaptureBuffer.AnalyzeByAutocorrelation; +var + ToneIndex: integer; + CurFreq: real; + CurWeight: real; + MaxWeight: real; + MaxTone: integer; +const + HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave) +begin + // prepare to analyze + MaxWeight := -1; + MaxTone := 0; // this is not needed, but it satifies the compiler + + // analyze halftones + // Note: at the lowest tone (~65Hz) and a buffer-size of 4096 + // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be + // too few samples -> use a bigger buffer-size + for ToneIndex := 0 to NumHalftones-1 do + begin + CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex); + CurWeight := AnalyzeAutocorrelationFreq(CurFreq); + + // TODO: prefer higher frequencies (use >= or use downto) + if (CurWeight > MaxWeight) then + begin + // this frequency has a higher weight + MaxWeight := CurWeight; + MaxTone := ToneIndex; + end; + end; + + ToneAbs := MaxTone; + Tone := MaxTone mod 12; +end; + +// result medium difference +function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real; +var + Dist: real; // distance (0=equal .. 1=totally different) between correlated samples + AccumDist: real; // accumulated distances + SampleIndex: integer; // index of sample to analyze + CorrelatingSampleIndex: integer; // index of sample one period ahead + SamplesPerPeriod: integer; // samples in one period +begin + SampleIndex := 0; + SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq); + CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod; + + AccumDist := 0; + + // compare correlating samples + while (CorrelatingSampleIndex < AnalysisBufferSize) do + begin + // calc distance (correlation: 1-dist) to corresponding sample in next period + Dist := Abs(AnalysisBuffer[SampleIndex] - AnalysisBuffer[CorrelatingSampleIndex]) / + High(Word); + AccumDist := AccumDist + Dist; + Inc(SampleIndex); + Inc(CorrelatingSampleIndex); + end; + + // return "inverse" average distance (=correlation) + Result := 1 - AccumDist / AnalysisBufferSize; +end; + +function TCaptureBuffer.MaxSampleVolume: Single; +var + lSampleIndex: Integer; + lMaxVol : Longint; +begin; + LockAnalysisBuffer(); + try + lMaxVol := 0; + for lSampleIndex := 0 to High(AnalysisBuffer) do + begin + if Abs(AnalysisBuffer[lSampleIndex]) > lMaxVol then + lMaxVol := Abs(AnalysisBuffer[lSampleIndex]); + end; + finally + UnlockAnalysisBuffer(); + end; + + result := lMaxVol / -Low(Smallint); +end; + +const + ToneStrings: array[0..11] of string = ( + 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B' + ); + +function TCaptureBuffer.GetToneString: string; +begin + if (ToneValid) then + Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2) + else + Result := '-'; +end; + +procedure TCaptureBuffer.BoostBuffer(Buffer: PChar; Size: Cardinal); +var + i: integer; + Value: Longint; + SampleCount: integer; + SampleBuffer: PSmallIntArray; // buffer handled as array of samples + Boost: byte; +begin + // TODO: set boost per device + { + case Ini.MicBoost of + 0: Boost := 1; + 1: Boost := 2; + 2: Boost := 4; + 3: Boost := 8; + else Boost := 1; + end; + } + Boost := 1; + + // at the moment we will boost SInt16 data only + if (AudioFormat.Format = asfS16) then + begin + // interpret buffer as buffer of bytes + SampleBuffer := PSmallIntArray(Buffer); + SampleCount := Size div AudioFormat.FrameSize; + + // boost buffer + for i := 0 to SampleCount-1 do + begin + Value := SampleBuffer^[i] * Boost; + + // TODO : JB - This will clip the audio... cant we reduce the "Boost" if the data clips ?? + if Value > High(Smallint) then + Value := High(Smallint); + + if Value < Low(Smallint) then + Value := Low(Smallint); + + SampleBuffer^[i] := Value; + end; + end; +end; + + +{ TAudioInputProcessor } + +constructor TAudioInputProcessor.Create; +var + i: integer; +begin + inherited; + SetLength(Sound, 6 {max players});//Ini.Players+1); + for i := 0 to High(Sound) do + Sound[i] := TCaptureBuffer.Create; +end; + +destructor TAudioInputProcessor.Destroy; +var + i: integer; +begin + for i := 0 to High(Sound) do + Sound[i].Free; + SetLength(Sound, 0); + inherited; +end; + +// updates InputDeviceConfig with current input-device information +// See: TIni.LoadInputDeviceCfg() +procedure TAudioInputProcessor.UpdateInputDeviceConfig; +var + deviceIndex: integer; + newDevice: boolean; + deviceIniIndex: integer; + deviceCfg: PInputDeviceConfig; + device: TAudioInputDevice; + channelCount: integer; + channelIndex: integer; + i: integer; +begin + // Input devices - append detected soundcards + for deviceIndex := 0 to High(DeviceList) do + begin + newDevice := true; + //Search for Card in List + for deviceIniIndex := 0 to High(Ini.InputDeviceConfig) do + begin + deviceCfg := @Ini.InputDeviceConfig[deviceIniIndex]; + device := DeviceList[deviceIndex]; + + if (deviceCfg.Name = Trim(device.Name)) then + begin + newDevice := false; + + // store highest channel index as an offset for the new channels + channelIndex := High(deviceCfg.ChannelToPlayerMap); + // add missing channels or remove non-existing ones + SetLength(deviceCfg.ChannelToPlayerMap, device.AudioFormat.Channels); + // initialize added channels to 0 + for i := channelIndex+1 to High(deviceCfg.ChannelToPlayerMap) do + begin + deviceCfg.ChannelToPlayerMap[i] := 0; + end; + + // associate ini-index with device + device.CfgIndex := deviceIniIndex; + break; + end; + end; + + //If not in List -> Add + if newDevice then + begin + // resize list + SetLength(Ini.InputDeviceConfig, Length(Ini.InputDeviceConfig)+1); + deviceCfg := @Ini.InputDeviceConfig[High(Ini.InputDeviceConfig)]; + device := DeviceList[deviceIndex]; + + // associate ini-index with device + device.CfgIndex := High(Ini.InputDeviceConfig); + + deviceCfg.Name := Trim(device.Name); + deviceCfg.Input := 0; + + channelCount := device.AudioFormat.Channels; + SetLength(deviceCfg.ChannelToPlayerMap, channelCount); + + for channelIndex := 0 to channelCount-1 do + begin + // set default at first start of USDX (1st device, 1st channel -> player1) + if ((channelIndex = 0) and (device.CfgIndex = 0)) then + deviceCfg.ChannelToPlayerMap[0] := 1 + else + deviceCfg.ChannelToPlayerMap[channelIndex] := 0; + end; + end; + end; +end; + +{* + * Handles captured microphone input data. + * Params: + * Buffer - buffer of signed 16bit interleaved stereo PCM-samples. + * Interleaved means that a right-channel sample follows a left- + * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...). + * Length - number of bytes in Buffer + * Input - Soundcard-Input used for capture + *} +procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PChar; Size: Cardinal; InputDevice: TAudioInputDevice); +var + MultiChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel) + SingleChannelBuffer: PChar; // temporary buffer for new samples per channel + SingleChannelBufferSize: integer; + ChannelIndex: integer; + CaptureChannel: TCaptureBuffer; + AudioFormat: TAudioFormatInfo; + SampleSize: integer; + SampleCount: integer; + SamplesPerChannel: integer; + i: integer; +begin + AudioFormat := InputDevice.AudioFormat; + SampleSize := AudioSampleSize[AudioFormat.Format]; + SampleCount := Size div SampleSize; + SamplesPerChannel := Size div AudioFormat.FrameSize; + + SingleChannelBufferSize := SamplesPerChannel * SampleSize; + GetMem(SingleChannelBuffer, SingleChannelBufferSize); + + // process channels + for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do + begin + CaptureChannel := InputDevice.CaptureChannel[ChannelIndex]; + // check if a capture buffer was assigned, otherwise there is nothing to do + if (CaptureChannel <> nil) then + begin + // set offset according to channel index + MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize]; + // seperate channel-data from interleaved multi-channel (e.g. stereo) data + for i := 0 to SamplesPerChannel-1 do + begin + Move(MultiChannelBuffer[i*AudioFormat.FrameSize], + SingleChannelBuffer[i*SampleSize], + SampleSize); + end; + CaptureChannel.ProcessNewBuffer(SingleChannelBuffer, SingleChannelBufferSize); + end; + end; + + FreeMem(SingleChannelBuffer); +end; + + +{ TAudioInputBase } + +function TAudioInputBase.FinalizeRecord: boolean; +var + i: integer; +begin + for i := 0 to High(AudioInputProcessor.DeviceList) do + AudioInputProcessor.DeviceList[i].Free(); + AudioInputProcessor.DeviceList := nil; + Result := true; +end; + +{* + * Start capturing on all used input-device. + *} +procedure TAudioInputBase.CaptureStart; +var + S: integer; + DeviceIndex: integer; + ChannelIndex: integer; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; + DeviceUsed: boolean; + Player: integer; +begin + if (Started) then + CaptureStop(); + + // reset buffers + for S := 0 to High(AudioInputProcessor.Sound) do + AudioInputProcessor.Sound[S].Clear; + + // start capturing on each used device + for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do + begin + Device := AudioInputProcessor.DeviceList[DeviceIndex]; + if not assigned(Device) then + continue; + DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex]; + + DeviceUsed := false; + + // check if device is used + for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do + begin + Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1; + if (Player < 0) or (Player >= PlayersPlay) then + begin + Device.LinkCaptureBuffer(ChannelIndex, nil); + end + else + begin + Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]); + DeviceUsed := true; + end; + end; + + // start device if used + if (DeviceUsed) then + begin + //Log.BenchmarkStart(2); + Device.Start(); + //Log.BenchmarkEnd(2); + //Log.LogBenchmark('Device.Start', 2) ; + end; + end; + + Started := true; +end; + +{* + * Stop input-capturing on all soundcards. + *} +procedure TAudioInputBase.CaptureStop; +var + DeviceIndex: integer; + ChannelIndex: integer; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; +begin + for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do + begin + Device := AudioInputProcessor.DeviceList[DeviceIndex]; + if not assigned(Device) then + continue; + + Device.Stop(); + + // disconnect capture buffers + DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex]; + for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do + Device.LinkCaptureBuffer(ChannelIndex, nil); + end; + + Started := false; +end; + +function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string; +var + count: integer; // count of devices with this name + + function IsDuplicate(const name: string): boolean; + var + i: integer; + begin + Result := False; + // search devices with same description + For i := 0 to deviceIndex-1 do + begin + if (AudioInputProcessor.DeviceList[i].Name = name) then + begin + Result := True; + Break; + end; + end; + end; +begin + count := 1; + result := name; + + // if there is another device with the same ID, search for an available name + while (IsDuplicate(result)) do + begin + Inc(count); + // set description + result := name + ' ('+IntToStr(count)+')'; + end; +end; + +end. + + + diff --git a/src/classes0/URingBuffer.pas b/src/classes0/URingBuffer.pas new file mode 100644 index 00000000..ce51e209 --- /dev/null +++ b/src/classes0/URingBuffer.pas @@ -0,0 +1,128 @@ +unit URingBuffer; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils; + +type + TRingBuffer = class + private + RingBuffer: PChar; + BufferCount: integer; + BufferSize: integer; + WritePos: integer; + ReadPos: integer; + public + constructor Create(Size: integer); + destructor Destroy; override; + function Read(Buffer: PChar; Count: integer): integer; + function Write(Buffer: PChar; Count: integer): integer; + procedure Flush(); + end; + +implementation + +uses + Math; + +constructor TRingBuffer.Create(Size: integer); +begin + BufferSize := Size; + + GetMem(RingBuffer, Size); + if (RingBuffer = nil) then + raise Exception.Create('No memory'); +end; + +destructor TRingBuffer.Destroy; +begin + FreeMem(RingBuffer); +end; + +function TRingBuffer.Read(Buffer: PChar; Count: integer): integer; +var + PartCount: integer; +begin + // adjust output count + if (Count > BufferCount) then + begin + //DebugWriteln('Read too much: ' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize)); + Count := BufferCount; + end; + + // check if there is something to do + if (Count <= 0) then + begin + Result := Count; + Exit; + end; + + // copy data to output buffer + + // first step: copy from the area between the read-position and the end of the buffer + PartCount := Min(Count, BufferSize - ReadPos); + Move(RingBuffer[ReadPos], Buffer[0], PartCount); + + // second step: if we need more data, copy from the beginning of the buffer + if (PartCount < Count) then + Move(RingBuffer[0], Buffer[0], Count-PartCount); + + // mark the copied part of the buffer as free + BufferCount := BufferCount - Count; + ReadPos := (ReadPos + Count) mod BufferSize; + + Result := Count; +end; + +function TRingBuffer.Write(Buffer: PChar; Count: integer): integer; +var + PartCount: integer; +begin + // check for a reasonable request + if (Count <= 0) then + begin + Result := Count; + Exit; + end; + + // skip input data if the input buffer is bigger than the ring-buffer + if (Count > BufferSize) then + begin + //DebugWriteln('Write skip data:' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize)); + Buffer := @Buffer[Count - BufferSize]; + Count := BufferSize; + end; + + // first step: copy to the area between the write-position and the end of the buffer + PartCount := Min(Count, BufferSize - WritePos); + Move(Buffer[0], RingBuffer[WritePos], PartCount); + + // second step: copy data to front of buffer + if (PartCount < Count) then + Move(Buffer[PartCount], RingBuffer[0], Count-PartCount); + + // update info + BufferCount := Min(BufferCount + Count, BufferSize); + WritePos := (WritePos + Count) mod BufferSize; + // if the buffer is full, we have to reposition the read-position + if (BufferCount = BufferSize) then + ReadPos := WritePos; + + Result := Count; +end; + +procedure TRingBuffer.Flush(); +begin + ReadPos := 0; + WritePos := 0; + BufferCount := 0; +end; + +end. \ No newline at end of file diff --git a/src/classes0/UServices.pas b/src/classes0/UServices.pas new file mode 100644 index 00000000..6325444c --- /dev/null +++ b/src/classes0/UServices.pas @@ -0,0 +1,358 @@ +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: TwParam; lParam: TlParam): integer; + + Function NametoHash(const ServiceName: TServiceName): Integer; + Function ServiceExists(const ServiceName: PChar): Integer; + end; + +var + ServiceManager: TServiceManager; + +implementation +uses + ULog, + UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +Constructor TServiceManager.Create; +begin + inherited; + + FirstService := nil; + LastService := nil; + + ServiceCache[0] := nil; + ServiceCache[1] := nil; + ServiceCache[2] := nil; + ServiceCache[3] := nil; + + NextCacheItem := 0; + + NextHandle := 1; + + {$IFDEF DEBUG} + debugWriteln('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} + debugWriteln('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); + {$ENDIF} + + //Inc Next Handle + Inc(NextHandle); + end + {$IFDEF DEBUG} + else debugWriteln('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} + debugWriteln('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: TwParam; lParam: TlParam): 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} + debugWriteln('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); + {$ENDIF} +end; + +//------------ +// Generates the Hash for the given Name +//------------ +Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; +// FIXME: check if the non-asm version is fast enough and use it by default if so +{$IF Defined(CPUX86_64)} +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} +asm + { CL: Counter; RAX: Result; RDX: Current Memory Address } + Mov RCX, 14 + Mov RDX, ServiceName {Save Address of String that should be "Hashed"} + Mov RAX, [RDX] + @FoldLoop: ADD RDX, 4 {jump 4 Byte(32 Bit) to the next tile } + ADD RAX, [RDX] {Add the Value of the next 4 Byte of the String to the Hash} + LOOP @FoldLoop {Fold again if there are Chars Left} +end; +{$ELSEIF Defined(CPU386) or Defined(CPUI386)} +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} +asm + { CL: Counter; EAX: Result; EDX: Current Memory Address } + Mov ECX, 14 {Init Counter, Fold 14 Times to get 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; +{$ELSE} +var + i: integer; + ptr: ^integer; +begin + ptr := @ServiceName; + Result := 0; + for i := 1 to 14 do + begin + Result := Result + ptr^; + Inc(ptr); + end; +end; +{$IFEND} + + +//------------ +// 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} + debugWriteln('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} + debugWriteln('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/src/classes0/USingNotes.pas b/src/classes0/USingNotes.pas new file mode 100644 index 00000000..3b268d10 --- /dev/null +++ b/src/classes0/USingNotes.pas @@ -0,0 +1,13 @@ +unit USingNotes; + +interface + +{$I switches.inc} + +{ Dummy Unit atm + For further expantation + Placeholder for Class that will handle the Notes Drawing} + +implementation + +end. diff --git a/src/classes0/USingScores.pas b/src/classes0/USingScores.pas new file mode 100644 index 00000000..77d40b84 --- /dev/null +++ b/src/classes0/USingScores.pas @@ -0,0 +1,973 @@ +unit USingScores; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses UThemes, + gl, + 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 constants 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 + inherited; + + //Clear PopupList Pointers + FirstPopUp := nil; + LastPopUp := nil; + + //Clear Variables + Visible := True; + Enabled := True; + RBVisible := True; + + //Clear Position Index + oPositionCount := 0; + oPlayerCount := 0; + + Settings.Phase1Time := 350; // plop it up . -> [ ] + Settings.Phase2Time := 550; // shift it up ^[ ]^ + Settings.Phase3Time := 200; // increase score [s++] + + Settings.PopUpTex[0].TexNum := 0; + Settings.PopUpTex[1].TexNum := 0; + Settings.PopUpTex[2].TexNum := 0; + Settings.PopUpTex[3].TexNum := 0; + Settings.PopUpTex[4].TexNum := 0; + Settings.PopUpTex[5].TexNum := 0; + Settings.PopUpTex[6].TexNum := 0; + Settings.PopUpTex[7].TexNum := 0; + Settings.PopUpTex[8].TexNum := 0; + + Settings.RatingBar_BG_Tex.TexNum := 0; + Settings.RatingBar_FG_Tex.TexNum := 0; + Settings.RatingBar_Bar_Tex.TexNum := 0; +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 + lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); + lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); + + 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 + MaxPlayersPerScreen := 0; + + 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/src/classes0/USkins.pas b/src/classes0/USkins.pas new file mode 100644 index 00000000..88549c9f --- /dev/null +++ b/src/classes0/USkins.pas @@ -0,0 +1,185 @@ +unit USkins; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +type + TSkinTexture = record + Name: string; + FileName: string; + end; + + TSkinEntry = record + Theme: string; + Name: string; + Path: string; + FileName: string; + Creator: string; // not used yet + end; + + TSkin = class + Skin: array of TSkinEntry; + SkinTexture: array of TSkinTexture; + SkinPath: string; + Color: integer; + constructor Create; + procedure LoadList; + procedure ParseDir(Dir: string); + procedure LoadHeader(FileName: string); + procedure LoadSkin(Name: string); + function GetTextureFileName(TextureName: string): string; + function GetSkinNumber(Name: string): integer; + procedure onThemeChange; + end; + +var + Skin: TSkin; + +implementation + +uses IniFiles, + Classes, + SysUtils, + UMain, + ULog, + UIni; + +constructor TSkin.Create; +begin + inherited; + LoadList; +// LoadSkin('Lisek'); +// SkinColor := Color; +end; + +procedure TSkin.LoadList; +var + SR: TSearchRec; +begin + if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + ParseDir(SkinsPath + SR.Name + PathDelim); + until FindNext(SR) <> 0; + end; // if + FindClose(SR); +end; + +procedure TSkin.ParseDir(Dir: string); +var + SR: TSearchRec; +begin + if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin + repeat + + if (SR.Name <> '.') and (SR.Name <> '..') then + LoadHeader(Dir + SR.Name); + + until FindNext(SR) <> 0; + end; +end; + +procedure TSkin.LoadHeader(FileName: string); +var + SkinIni: TMemIniFile; + S: integer; +begin + SkinIni := TMemIniFile.Create(FileName); + + S := Length(Skin); + SetLength(Skin, S+1); + + Skin[S].Path := IncludeTrailingPathDelimiter(ExtractFileDir(FileName)); + Skin[S].FileName := ExtractFileName(FileName); + Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); + Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); + Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); + + SkinIni.Free; +end; + +procedure TSkin.LoadSkin(Name: string); +var + SkinIni: TMemIniFile; + SL: TStringList; + T: integer; + S: integer; +begin + S := GetSkinNumber(Name); + SkinPath := Skin[S].Path; + + SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); + + SL := TStringList.Create; + SkinIni.ReadSection('Textures', SL); + + SetLength(SkinTexture, SL.Count); + for T := 0 to SL.Count-1 do + begin + SkinTexture[T].Name := SL.Strings[T]; + SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); + end; + + SL.Free; + SkinIni.Free; +end; + +function TSkin.GetTextureFileName(TextureName: string): string; +var + T: integer; +begin + Result := ''; + + for T := 0 to High(SkinTexture) do + begin + if ( SkinTexture[T].Name = TextureName ) AND + ( SkinTexture[T].FileName <> '' ) then + begin + Result := SkinPath + SkinTexture[T].FileName; + end; + end; + + if ( TextureName <> '' ) AND + ( Result <> '' ) THEN + begin + //Log.LogError('', '-----------------------------------------'); + //Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName'); + end; + +{ Result := SkinPath + 'Bar.jpg'; + if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} +end; + +function TSkin.GetSkinNumber(Name: string): integer; +var + S: integer; +begin + Result := 0; // set default to the first available skin + for S := 0 to High(Skin) do + if Skin[S].Name = Name then Result := S; +end; + +procedure TSkin.onThemeChange; +var + S: integer; + Name: String; +begin + Ini.SkinNo:=0; + SetLength(ISkin, 0); + Name := Uppercase(ITheme[Ini.Theme]); + for S := 0 to High(Skin) do + if Name = Uppercase(Skin[S].Theme) then begin + SetLength(ISkin, Length(ISkin)+1); + ISkin[High(ISkin)] := Skin[S].Name; + end; + +end; + +end. diff --git a/src/classes0/USong.pas b/src/classes0/USong.pas new file mode 100644 index 00000000..3517bce6 --- /dev/null +++ b/src/classes0/USong.pas @@ -0,0 +1,1027 @@ +unit USong; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ELSE} + {$IFNDEF DARWIN} + syscall, + {$ENDIF} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + UPlatform, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} + cthreads, + {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} + PseudoThread, + {$ENDIF} + UCatCovers, + UXMLSong; + +type + + TSingMode = ( smNormal, smPartyMode, smPlaylistRandom ); + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: WideString; + Score: integer; + Length: string; + end; + + TSong = class + FileLineNo : integer; //Line which is readed at Last, for error reporting + + procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); + procedure NewSentence(LineNumberP: integer; Param1, Param2: integer); + + function ReadTXTHeader( const aFileName : WideString ): boolean; + function ReadXMLHeader( const aFileName : WideString ): boolean; + public + Path: WideString; + Folder: WideString; // for sorting by folder + fFileName, + FileName: WideString; + + // sorting methods + Category: array of WideString; // TODO: do we need this? + Genre: WideString; + Edition: WideString; + Language: WideString; + + Title: WideString; + Artist: WideString; + + Text: WideString; + Creator: WideString; + + Cover: WideString; + CoverTex: TTexture; + Mp3: WideString; + Background: WideString; + Video: WideString; + VideoGAP: real; + VideoLoaded: boolean; // true if the video has been loaded + NotesGAP: integer; + Start: real; // in seconds + Finish: integer; // in miliseconds + Relative: boolean; + Resolution: integer; + BPM: array of TBPM; + GAP: real; // in miliseconds + + Score: array[0..2] of array of TScore; + + // these are used when sorting is enabled + Visible: boolean; // false if hidden, true if visible + Main: boolean; // false for songs, true for category buttons + OrderNum: integer; // has a number of category for category buttons and songs + OrderTyp: integer; // type of sorting for this button (0=name) + CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs + + SongFile: TextFile; // all procedures in this unit operate on this file + + Base : array[0..1] of integer; + Rel : array[0..1] of integer; + Mult : integer; + MultBPM : integer; + + constructor Create (); overload; + constructor Create ( const aFileName : WideString ); overload; + function LoadSong: boolean; + function LoadXMLSong: boolean; + function Analyse(): boolean; + function AnalyseXML(): boolean; + procedure Clear(); + end; + +implementation + +uses + TextGL, + UIni, + UMusic, //needed for Lines + UMain; //needed for Player + +constructor TSong.Create(); +begin + inherited; +end; + +constructor TSong.Create( const aFileName : WideString ); +begin + inherited Create(); + + Mult := 1; + MultBPM := 4; + fFileName := aFileName; + + if fileexists( aFileName ) then + begin + self.Path := ExtractFilePath( aFileName ); + self.Folder := ExtractFilePath( aFileName ); + self.FileName := ExtractFileName( aFileName ); + (* + if ReadTXTHeader( aFileName ) then + begin + LoadSong(); + end + else + begin + Log.LogError('Error Loading SongHeader, abort Song Loading'); + Exit; + end; + *) + end; +end; + +//Load TXT Song +function TSong.LoadSong(): boolean; + +var + TempC: char; + Text: string; + CP: integer; // Current Player (0 or 1) + Count: integer; + Both: boolean; + Param1: integer; + Param2: integer; + Param3: integer; + ParamS: string; + I: integer; +begin + Result := false; + + if not FileExists(Path + PathDelim + FileName) then + begin + Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()'); + exit; + end; + + MultBPM := 4; // multiply beat-count of note by 4 + Mult := 1; // accuracy of measurement of note + Base[0] := 100; // high number + Lines[0].ScoreValue := 0; + self.Relative := false; + Rel[0] := 0; + CP := 0; + Both := false; + + if Length(Player) = 2 then + Both := true; + + try + // Open song file for reading..... + FileMode := fmOpenRead; + AssignFile(SongFile, fFileName); + Reset(SongFile); + + //Clear old Song Header + if (self.Path = '') then + self.Path := ExtractFilePath(FileName); + + if (self.FileName = '') then + self.Filename := ExtractFileName(FileName); + + Result := False; + + Reset(SongFile); + FileLineNo := 0; + //Search for Note Begining + repeat + ReadLn(SongFile, Text); + Inc(FileLineNo); + + if (EoF(SongFile)) then + begin //Song File Corrupted - No Notes + CloseFile(SongFile); + Log.LogError('Could not load txt File, no Notes found: ' + FileName); + Result := False; + Exit; + end; + Read(SongFile, TempC); + until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); + + SetLength(Lines, 2); + for Count := 0 to High(Lines) do + begin + SetLength(Lines[Count].Line, 1); + Lines[Count].High := 0; + Lines[Count].Number := 1; + Lines[Count].Current := 0; + Lines[Count].Resolution := self.Resolution; + Lines[Count].NotesGAP := self.NotesGAP; + Lines[Count].Line[0].HighNote := -1; + Lines[Count].Line[0].LastLine := False; + end; + + // TempC := ':'; + // TempC := Text[1]; // read from backup variable, don't use default ':' value + + while (TempC <> 'E') AND (not EOF(SongFile)) do + begin + + if (TempC = ':') or (TempC = '*') or (TempC = 'F') then + begin + // read notes + Read(SongFile, Param1); + Read(SongFile, Param2); + Read(SongFile, Param3); + Read(SongFile, ParamS); + + + //Check for ZeroNote + if Param2 = 0 then Log.LogError('Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamS+'" -> Note ignored!') else + begin + // add notes + if not Both then + // P1 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) + else begin + // P1 + P2 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); + ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); + end; + end; //Zeronote check + end; // if + + if TempC = '-' then + begin + // reads sentence + Read(SongFile, Param1); + if self.Relative then Read(SongFile, Param2); // read one more data for relative system + + // new sentence + if not Both then + // P1 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) + else begin + // P1 + P2 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); + NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); + end; + end; // if + + if TempC = 'B' then + begin + SetLength(self.BPM, Length(self.BPM) + 1); + Read(SongFile, self.BPM[High(self.BPM)].StartBeat); + self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0]; + + Read(SongFile, Text); + self.BPM[High(self.BPM)].BPM := StrToFloat(Text); + self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM; + end; + + + if not Both then + begin + Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP]; + Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric)); + //Total Notes Patch + Lines[CP].Line[Lines[CP].High].TotalNotes := 0; + for I := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do + begin + if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; + + if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; + end; + //Total Notes Patch End + end else begin + for Count := 0 to High(Lines) do + begin + Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count]; + Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric)); + //Total Notes Patch + Lines[Count].Line[Lines[Count].High].TotalNotes := 0; + for I := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do + begin + if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length; + if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length; + end; + //Total Notes Patch End + end; + end; + Read(SongFile, TempC); + Inc(FileLineNo); + end; // while} + + for Count := 0 to High(Lines) do + begin + Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; + end; + + CloseFile(SongFile); + except + try + CloseFile(SongFile); + except + + end; + + Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo)); + exit; + end; + + Result := true; +end; + +//Load XML Song +function TSong.LoadXMLSong(): boolean; +var + //TempC: char; + Text: string; + CP: integer; // Current Player (0 or 1) + Count: integer; + Both: boolean; + Param1: integer; + Param2: integer; + Param3: integer; + ParamS: string; + I,J,X: integer; + + NoteType: Char; + SentenceEnd, Rest, Time: Integer; + Parser: TParser; +begin + Result := false; + + if not FileExists(Path + PathDelim + FileName) then + begin + Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()'); + exit; + end; + + MultBPM := 4; // multiply beat-count of note by 4 + Mult := 1; // accuracy of measurement of note + Base[0] := 100; // high number + Lines[0].ScoreValue := 0; + self.Relative := false; + Rel[0] := 0; + CP := 0; + Both := false; + + if Length(Player) = 2 then + Both := true; + + Parser := TParser.Create; + Parser.Settings.DashReplacement := '~'; + + for Count := 0 to High(Lines) do + begin + SetLength(Lines[Count].Line, 1); + Lines[Count].High := 0; + Lines[Count].Number := 1; + Lines[Count].Current := 0; + Lines[Count].Resolution := self.Resolution; + Lines[Count].NotesGAP := self.NotesGAP; + Lines[Count].Line[0].HighNote := -1; + Lines[Count].Line[0].LastLine := False; + end; + +//Try to Parse the Song + + if Parser.ParseSong(Path + PathDelim + FileName) then + begin +// Writeln('XML Inputfile Parsed succesful'); + //Start write parsed information to Song + //Notes Part + for I := 0 to High(Parser.SongInfo.Sentences) do + begin + //Add Notes + for J := 0 to High(Parser.SongInfo.Sentences[I].Notes) do + begin + case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of + NT_Normal: NoteType := ':'; + NT_Golden: NoteType := '*'; + NT_Freestyle: NoteType := 'F'; + end; + + Param1:=Parser.SongInfo.Sentences[I].Notes[J].Start; //Note Start + Param2:=Parser.SongInfo.Sentences[I].Notes[J].Duration; //Note Duration + Param3:=Parser.SongInfo.Sentences[I].Notes[J].Tone; //Note Tone + ParamS:=' ' + Parser.SongInfo.Sentences[I].Notes[J].Lyric; //Note Lyric + + if not Both then + // P1 + ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) + else + begin + // P1 + P2 + ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); + ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); + end; + + if not Both then + begin + Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP]; + Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric)); + //Total Notes Patch + Lines[CP].Line[Lines[CP].High].TotalNotes := 0; + for X := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do + begin + if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; + + if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; + end; + //Total Notes Patch End + end + else + begin + for Count := 0 to High(Lines) do + begin + Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count]; + Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric)); + //Total Notes Patch + Lines[Count].Line[Lines[Count].High].TotalNotes := 0; + for X := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do + begin + if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; + if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; + + end; + //Total Notes Patch End + end; + end; { end of for loop } + + end; //J Forloop + + //Add Sentence break + if (I < High(Parser.SongInfo.Sentences)) then + begin + + SentenceEnd := Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Start + Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Duration; + Rest := Parser.SongInfo.Sentences[I+1].Notes[0].Start - SentenceEnd; + + //Calculate Time + case Rest of + 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; + 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1; + 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2; + else + if (Rest >= 4) then + Time := SentenceEnd + 2 + else //Sentence overlapping :/ + Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; + end; + // new sentence + if not Both then + // P1 + NewSentence(0, (Time + Rel[0]) * Mult, Param2) + else + begin + // P1 + P2 + NewSentence(0, (Time + Rel[0]) * Mult, Param2); + NewSentence(1, (Time + Rel[1]) * Mult, Param2); + end; + + end; + end; + //End write parsed information to Song + Parser.Free; + end + else + begin + Log.LogError('Could not parse Inputfile: ' + Path + PathDelim + FileName); + exit; + end; + + for Count := 0 to High(Lines) do + begin + Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; + end; + + Result := true; +end; + +function TSong.ReadXMLHeader(const aFileName : WideString): boolean; +var + Line, Identifier, Value: string; + Temp : word; + Done : byte; + Parser : TParser; +begin + Result := true; + Done := 0; + +//Parse XML + Parser := TParser.Create; + Parser.Settings.DashReplacement := '~'; + + + if Parser.ParseSong(self.Path + self.FileName) then + begin + //----------- + //Required Attributes + //----------- + + //Title + self.Title := Parser.SongInfo.Header.Title; + + //Add Title Flag to Done + Done := Done or 1; + + //Artist + self.Artist := Parser.SongInfo.Header.Artist; + + //Add Artist Flag to Done + Done := Done or 2; + + //MP3 File //Test if Exists + self.Mp3 := platform.FindSongFile(Path, '*.mp3'); + if (FileExists(self.Path + self.Mp3)) then + //Add Mp3 Flag to Done + Done := Done or 4; + + //Beats per Minute + SetLength(self.BPM, 1); + self.BPM[0].StartBeat := 0; + + self.BPM[0].BPM := (Parser.SongInfo.Header.BPM * Parser.SongInfo.Header.Resolution/4 ) * Mult * MultBPM; + + if self.BPM[0].BPM <> 0 then + //Add BPM Flag to Done + Done := Done or 8; + + //--------- + //Additional Header Information + //--------- + + // Gap + self.GAP := Parser.SongInfo.Header.Gap; + + //Cover Picture + self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); + + //Background Picture + self.Background := platform.FindSongFile(Path, '*[BG].jpg'); + + // Video File + // self.Video := Value + + // Video Gap + // self.VideoGAP := song_StrtoFloat( Value ) + + //Genre Sorting + self.Genre := Parser.SongInfo.Header.Genre; + + //Edition Sorting + self.Edition := Parser.SongInfo.Header.Edition; + + //Year Sorting + //Parser.SongInfo.Header.Year + + //Language Sorting + self.Language := Parser.SongInfo.Header.Language; + end else + Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName); + + Parser.Free; + + //Check if all Required Values are given + if (Done <> 15) then + begin + Result := False; + if (Done and 8) = 0 then //No BPM Flag + Log.LogError('BPM Tag Missing: ' + self.FileName) + else if (Done and 4) = 0 then //No MP3 Flag + Log.LogError('MP3 Tag/File Missing: ' + self.FileName) + else if (Done and 2) = 0 then //No Artist Flag + Log.LogError('Artist Tag Missing: ' + self.FileName) + else if (Done and 1) = 0 then //No Title Flag + Log.LogError('Title Tag Missing: ' + self.FileName) + else //unknown Error + Log.LogError('File Incomplete or not SingStar XML (B - '+ inttostr(Done) +'): ' + aFileName); + end; + +end; + + +function TSong.ReadTXTHeader(const aFileName : WideString): boolean; + + function song_StrtoFloat( aValue : string ) : Extended; + var + lValue : string; +// lOldDecimalSeparator : Char; // Auto Removed, Unused Variable + begin + lValue := aValue; + + if (Pos(',', lValue) <> 0) then + lValue[Pos(',', lValue)] := '.'; + + Result := StrToFloatDef(lValue, 0); + end; + +var + Line, Identifier, Value: string; + Temp : word; + Done : byte; +begin + Result := true; + Done := 0; + + //Read first Line + ReadLn (SongFile, Line); + + if (Length(Line)<=0) then + begin + Log.LogError('File Starts with Empty Line: ' + aFileName); + Result := False; + Exit; + end; + + //Read Lines while Line starts with # or its empty + while ( Length(Line) = 0 ) or + ( Line[1] = '#' ) do + begin + //Increase Line Number + Inc (FileLineNo); + Temp := Pos(':', Line); + + //Line has a Seperator-> Headerline + if (Temp <> 0) then + begin + //Read Identifier and Value + Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks + Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); + + //Check the Identifier (If Value is given) + if (Length(Value) <> 0) then + begin + + //----------- + //Required Attributes + //----------- + + {$IFDEF UTF8_FILENAMES} + if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then + Value := Utf8Encode(Value); + {$ENDIF} + + //Title + if (Identifier = 'TITLE') then + begin + self.Title := Value; + + //Add Title Flag to Done + Done := Done or 1; + end + + //Artist + else if (Identifier = 'ARTIST') then + begin + self.Artist := Value; + + //Add Artist Flag to Done + Done := Done or 2; + end + + //MP3 File //Test if Exists + else if (Identifier = 'MP3') AND + (FileExists(self.Path + Value)) then + begin + self.Mp3 := Value; + + //Add Mp3 Flag to Done + Done := Done or 4; + end + + //Beats per Minute + else if (Identifier = 'BPM') then + begin + SetLength(self.BPM, 1); + self.BPM[0].StartBeat := 0; + + self.BPM[0].BPM := song_StrtoFloat( Value ) * Mult * MultBPM; + + if self.BPM[0].BPM <> 0 then + begin + //Add BPM Flag to Done + Done := Done or 8; + end; + end + + //--------- + //Additional Header Information + //--------- + + // Gap + else if (Identifier = 'GAP') then + self.GAP := song_StrtoFloat( Value ) + + //Cover Picture + else if (Identifier = 'COVER') then + self.Cover := Value + + //Background Picture + else if (Identifier = 'BACKGROUND') then + self.Background := Value + + // Video File + else if (Identifier = 'VIDEO') then + begin + if (FileExists(self.Path + Value)) then + self.Video := Value + else + Log.LogError('Can''t find Video File in Song: ' + aFileName); + end + + // Video Gap + else if (Identifier = 'VIDEOGAP') then + self.VideoGAP := song_StrtoFloat( Value ) + + //Genre Sorting + else if (Identifier = 'GENRE') then + self.Genre := Value + + //Edition Sorting + else if (Identifier = 'EDITION') then + self.Edition := Value + + //Creator Tag + else if (Identifier = 'CREATOR') then + self.Creator := Value + + //Language Sorting + else if (Identifier = 'LANGUAGE') then + self.Language := Value + + // Song Start + else if (Identifier = 'START') then + self.Start := song_StrtoFloat( Value ) + + // Song Ending + else if (Identifier = 'END') then + TryStrtoInt(Value, self.Finish) + + // Resolution + else if (Identifier = 'RESOLUTION') then + TryStrtoInt(Value, self.Resolution) + + // Notes Gap + else if (Identifier = 'NOTESGAP') then + TryStrtoInt(Value, self.NotesGAP) + // Relative Notes + else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then + self.Relative := True; + + end; + end; + + if not EOf(SongFile) then + ReadLn (SongFile, Line) + else + begin + Result := False; + Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName); + break; + end; + + end; + + if self.Cover = '' then + self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); + + //Check if all Required Values are given + if (Done <> 15) then + begin + Result := False; + if (Done and 8) = 0 then //No BPM Flag + Log.LogError('BPM Tag Missing: ' + self.FileName) + else if (Done and 4) = 0 then //No MP3 Flag + Log.LogError('MP3 Tag/File Missing: ' + self.FileName) + else if (Done and 2) = 0 then //No Artist Flag + Log.LogError('Artist Tag Missing: ' + self.FileName) + else if (Done and 1) = 0 then //No Title Flag + Log.LogError('Title Tag Missing: ' + self.FileName) + else //unknown Error + Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName); + end; + +end; + +procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); +//var +// Space: boolean; // Auto Removed, Unused Variable +begin + case Ini.Solmization of + 1: // european + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' si '; + end; + end; + 2: // japanese + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' so '; + 9..10: LyricS := ' la '; + 11: LyricS := ' shi '; + end; + end; + 3: // american + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' ti '; + end; + end; + end; // case + + with Lines[LineNumber].Line[Lines[LineNumber].High] do + begin + SetLength(Note, Length(Note) + 1); + HighNote := High(Note); + + Note[HighNote].Start := StartP; + if HighNote = 0 then + begin + if Lines[LineNumber].Number = 1 then + Start := -100; +// Start := Note[HighNote].Start; + end; + + Note[HighNote].Length := DurationP; + + // back to the normal system with normal, golden and now freestyle notes + case TypeP of + 'F': Note[HighNote].NoteType := ntFreestyle; + ':': Note[HighNote].NoteType := ntNormal; + '*': Note[HighNote].NoteType := ntGolden; + end; + + if (Note[HighNote].NoteType = ntGolden) then + Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; + + if (Note[HighNote].NoteType <> ntFreestyle) then + Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; + + Note[HighNote].Tone := NoteP; + if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone; + + Note[HighNote].Text := Copy(LyricS, 2, 100); + Lyric := Lyric + Note[HighNote].Text; + + End_ := Note[HighNote].Start + Note[HighNote].Length; + end; // with +end; + +procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer); +var + I: integer; +begin + + // stara czesc //Alter Satz //Update Old Part + Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP]; + Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(PChar(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric)); + + //Total Notes Patch + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0; + for I := low(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) to high(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) do + begin + if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType = ntGolden) then + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; + + if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType <> ntFreestyle) then + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; + end; + //Total Notes Patch End + + + // nowa czesc //Neuer Satz //Update New Part + SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1); + Lines[LineNumberP].High := Lines[LineNumberP].High + 1; + Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1; + Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1; + + if self.Relative then + begin + Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; + Rel[LineNumberP] := Rel[LineNumberP] + Param2; + end + else + Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; + + Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := False; + + Base[LineNumberP] := 100; // high number +end; + +procedure TSong.clear(); +begin + //Main Information + Title := ''; + Artist := ''; + + //Sortings: + Genre := 'Unknown'; + Edition := 'Unknown'; + Language := 'Unknown'; //Language Patch + + //Required Information + Mp3 := ''; + {$IFDEF FPC} + setlength( BPM, 0 ); + {$ELSE} + BPM := nil; + {$ENDIF} + + GAP := 0; + Start := 0; + Finish := 0; + + //Additional Information + Background := ''; + Cover := ''; + Video := ''; + VideoGAP := 0; + NotesGAP := 0; + Resolution := 4; + Creator := ''; + +end; + +function TSong.Analyse(): boolean; +begin + Result := False; + + //Reset LineNo + FileLineNo := 0; + + //Open File and set File Pointer to the beginning + AssignFile(SongFile, self.Path + self.FileName); + + try + Reset(SongFile); + + //Clear old Song Header + self.clear; + + //Read Header + Result := self.ReadTxTHeader( FileName ) + + //And Close File + finally + CloseFile(SongFile); + end; +end; + + +function TSong.AnalyseXML(): boolean; +begin + Result := False; + + //Reset LineNo + FileLineNo := 0; + + //Clear old Song Header + self.clear; + + //Read Header + Result := self.ReadXMLHeader( FileName ); + +end; + +end. diff --git a/src/classes0/USongs.pas b/src/classes0/USongs.pas new file mode 100644 index 00000000..710cd44f --- /dev/null +++ b/src/classes0/USongs.pas @@ -0,0 +1,806 @@ +unit USongs; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{$IFDEF DARWIN} + {$IFDEF DEBUG} + {$DEFINE USE_PSEUDO_THREAD} + {$ENDIF} +{$ENDIF} + +uses + {$IFDEF MSWINDOWS} + Windows, + DirWatch, + {$ELSE} + {$IFNDEF DARWIN} + syscall, + {$ENDIF} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + UPlatform, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} + cthreads, + {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} + PseudoThread, + {$ENDIF} + USong, + UCatCovers; + +type + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: widestring; + Score: integer; + Length: string; + end; + + {$IFDEF USE_PSEUDO_THREAD} + TSongs = class( TPseudoThread ) + {$ELSE} + TSongs = class( TThread ) + {$ENDIF} + private + fNotify, fWatch : longint; + fParseSongDirectory : boolean; + fProcessing : boolean; + {$ifdef MSWINDOWS} + fDirWatch : TDirectoryWatch; + {$endif} + procedure int_LoadSongList; + procedure DoDirChanged(Sender: TObject); + protected + procedure Execute; override; + public + SongList : TList; // array of songs + Selected : integer; // selected song index + constructor Create(); + destructor Destroy(); override; + + + procedure LoadSongList; // load all songs + procedure BrowseDir(Dir: widestring); // should return number of songs in the future + procedure BrowseTXTFiles(Dir: widestring); + procedure BrowseXMLFiles(Dir: widestring); + procedure Sort(Order: integer); + function FindSongFile(Dir, Mask: widestring): widestring; + property Processing : boolean read fProcessing; + end; + + + TCatSongs = class + Song: array of TSong; // array of categories with songs + Selected: integer; // selected song index + Order: integer; // order type (0=title) + CatNumShow: integer; // Category Number being seen + CatCount: integer; //Number of Categorys + + procedure SortSongs(); + procedure Refresh; // refreshes arrays by recreating them from Songs array + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: string; const fType: Byte): Cardinal; + end; + +var + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs + +const + IN_ACCESS = $00000001; //* File was accessed */ + IN_MODIFY = $00000002; //* File was modified */ + IN_ATTRIB = $00000004; //* Metadata changed */ + IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ + IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ + IN_OPEN = $00000020; //* File was opened */ + IN_MOVED_FROM = $00000040; //* File was moved from X */ + IN_MOVED_TO = $00000080; //* File was moved to Y */ + IN_CREATE = $00000100; //* Subfile was created */ + IN_DELETE = $00000200; //* Subfile was deleted */ + IN_DELETE_SELF = $00000400; //* Self was deleted */ + + +implementation + +uses StrUtils, + UGraphic, + UCovers, + UFiles, + UMain, + UIni; + +constructor TSongs.Create(); +begin + // do not start thread BEFORE initialization (suspended = true) + inherited Create(true); + Self.FreeOnTerminate := true; + + SongList := TList.Create(); + + // FIXME: threaded loading does not work this way. + // It will just cause crashes but nothing else at the moment. + (* + {$ifdef MSWINDOWS} + fDirWatch := TDirectoryWatch.create(nil); + fDirWatch.OnChange := DoDirChanged; + fDirWatch.Directory := SongPath; + fDirWatch.WatchSubDirs := true; + fDirWatch.active := true; + {$ENDIF} + + // now we can start the thread + Resume(); + *) + + // until it is fixed, simply load the song-list + int_LoadSongList(); +end; + +destructor TSongs.Destroy(); +begin + FreeAndNil( SongList ); + inherited; +end; + +procedure TSongs.DoDirChanged(Sender: TObject); +begin + LoadSongList(); +end; + +procedure TSongs.Execute(); +var + fChangeNotify : THandle; +begin +{$IFDEF USE_PSEUDO_THREAD} + int_LoadSongList(); +{$ELSE} + fParseSongDirectory := true; + + while not terminated do + begin + + if fParseSongDirectory then + begin + Log.LogStatus('Calling int_LoadSongList', 'TSongs.Execute'); + int_LoadSongList(); + end; + + Suspend(); + end; +{$ENDIF} +end; + +procedure TSongs.int_LoadSongList; +var + I: integer; +begin + try + fProcessing := true; + + Log.LogStatus('Searching For Songs', 'SongList'); + + // browse directories + for I := 0 to SongPaths.Count-1 do + BrowseDir(SongPaths[I]); + + if assigned( CatSongs ) then + CatSongs.Refresh; + + if assigned( CatCovers ) then + CatCovers.Load; + + //if assigned( Covers ) then + // Covers.Load; + + if assigned(ScreenSong) then + begin + ScreenSong.GenerateThumbnails(); + ScreenSong.OnShow; // refresh ScreenSong + end; + + finally + Log.LogStatus('Search Complete', 'SongList'); + + fParseSongDirectory := false; + fProcessing := false; + end; +end; + + +procedure TSongs.LoadSongList; +begin + fParseSongDirectory := true; + Resume(); +end; + +procedure TSongs.BrowseDir(Dir: widestring); +begin + BrowseTXTFiles(Dir); + BrowseXMLFiles(Dir); +end; + +procedure TSongs.BrowseTXTFiles(Dir: widestring); +var + i : integer; + Files : TDirectoryEntryArray; + lSong : TSong; +begin + + Files := Platform.DirectoryFindFiles( Dir, '.txt', true); + + for i := 0 to Length(Files)-1 do + begin + if Files[i].IsDirectory then + begin + BrowseTXTFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call + end + else + begin + lSong := TSong.create( Dir + Files[i].Name ); + + if lSong.Analyse then + SongList.add( lSong ) + else + begin + Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); + freeandnil( lSong ); + end; + + end; + end; + SetLength( Files, 0); + +end; + +procedure TSongs.BrowseXMLFiles(Dir: widestring); +var + i : integer; + Files : TDirectoryEntryArray; + lSong : TSong; +begin + + Files := Platform.DirectoryFindFiles( Dir, '.xml', true); + + for i := 0 to Length(Files)-1 do + begin + if Files[i].IsDirectory then + begin + BrowseXMLFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call + end + else + begin + lSong := TSong.create( Dir + Files[i].Name ); + + if lSong.AnalyseXML then + SongList.add( lSong ) + else + begin + Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); + freeandnil( lSong ); + end; + + end; + end; + SetLength( Files, 0); + +end; + +(* + * Comparison functions for sorting + *) + +function CompareByEdition(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Edition, TSong(Song2).Edition); +end; + +function CompareByGenre(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Genre, TSong(Song2).Genre); +end; + +function CompareByTitle(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Title, TSong(Song2).Title); +end; + +function CompareByArtist(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Artist, TSong(Song2).Artist); +end; + +function CompareByFolder(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Folder, TSong(Song2).Folder); +end; + +function CompareByLanguage(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Language, TSong(Song2).Language); +end; + +procedure TSongs.Sort(Order: integer); +var + CompareFunc: TListSortCompare; +begin + // FIXME: what is the difference between artist and artist2, etc.? + case Order of + sEdition: // by edition + CompareFunc := CompareByEdition; + sGenre: // by genre + CompareFunc := CompareByGenre; + sTitle: // by title + CompareFunc := CompareByTitle; + sArtist: // by artist + CompareFunc := CompareByArtist; + sFolder: // by folder + CompareFunc := CompareByFolder; + sTitle2: // by title2 + CompareFunc := CompareByTitle; + sArtist2: // by artist2 + CompareFunc := CompareByArtist; + sLanguage: // by Language + CompareFunc := CompareByLanguage; + else + Log.LogCritical('Unsupported comparison', 'TSongs.Sort'); + Exit; // suppress warning + end; // case + + // Note: Do not use TList.Sort() as it uses QuickSort which is instable. + // For example, if a list is sorted by title first and + // by artist afterwards, the songs of an artist will not be sorted by title anymore. + // The stable MergeSort guarantees to maintain this order. + MergeSort(SongList, CompareFunc); +end; + +function TSongs.FindSongFile(Dir, Mask: widestring): widestring; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if FindFirst(Dir + Mask, faDirectory, SR) = 0 then + begin + Result := SR.Name; + end; // if + FindClose(SR); +end; + +procedure TCatSongs.SortSongs(); +begin + case Ini.Sorting of + sEdition: begin + Songs.Sort(sTitle); + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sTitle); + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sTitle); + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sTitle); + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: begin + Songs.Sort(sTitle); + end; + sArtist: begin + Songs.Sort(sTitle); + Songs.Sort(sArtist); + end; + sTitle2: begin + Songs.Sort(sArtist2); + Songs.Sort(sTitle2); + end; + sArtist2: begin + Songs.Sort(sTitle2); + Songs.Sort(sArtist2); + end; + end; // case +end; + +procedure TCatSongs.Refresh; +var + SongIndex: integer; + CurSong: TSong; + CatIndex: integer; // index of current song in Song + Letter: char; // current letter for sorting using letter + CurCategory: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + LetterTmp: char; + CatNumber: integer; // Number of Song in Category + + procedure AddCategoryButton(const CategoryName: string); + var + PrevCatBtnIndex: integer; + begin + Inc(Order); + CatIndex := Length(Song); + SetLength(Song, CatIndex+1); + Song[CatIndex] := TSong.Create(); + Song[CatIndex].Artist := '[' + CategoryName + ']'; + Song[CatIndex].Main := true; + Song[CatIndex].OrderTyp := 0; + Song[CatIndex].OrderNum := Order; + Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName); + Song[CatIndex].Visible := true; + + // set number of songs in previous category + PrevCatBtnIndex := CatIndex - CatNumber - 1; + if ((PrevCatBtnIndex >= 0) and Song[PrevCatBtnIndex].Main) then + Song[PrevCatBtnIndex].CatNumber := CatNumber; + + CatNumber := 0; + end; + +begin + CatNumShow := -1; + + SortSongs(); + + CurCategory := ''; + Order := 0; + CatNumber := 0; + + // Note: do NOT set Letter to ' ', otherwise no category-button will be + // created for songs beginning with ' ' if songs of this category exist. + // TODO: trim song-properties so ' ' will not occur as first chararcter. + Letter := #0; + + // clear song-list + for SongIndex := 0 to Songs.SongList.Count-1 do + begin + // free category buttons + // Note: do NOT delete songs, they are just references to Songs.SongList entries + CurSong := TSong(Songs.SongList[SongIndex]); + if (CurSong.Main) then + CurSong.Free; + end; + SetLength(Song, 0); + + for SongIndex := 0 to Songs.SongList.Count-1 do + begin + CurSong := TSong(Songs.SongList[SongIndex]); + // if tabs are on, add section buttons for each new section + if (Ini.Tabs = 1) then + begin + if (Ini.Sorting = sEdition) and + (CompareText(CurCategory, CurSong.Edition) <> 0) then + begin + CurCategory := CurSong.Edition; + + // TODO: remove this block if it is not needed anymore + { + if CurSection = 'Singstar Part 2' then CoverName := 'Singstar'; + if CurSection = 'Singstar German' then CoverName := 'Singstar'; + if CurSection = 'Singstar Spanish' then CoverName := 'Singstar'; + if CurSection = 'Singstar Italian' then CoverName := 'Singstar'; + if CurSection = 'Singstar French' then CoverName := 'Singstar'; + if CurSection = 'Singstar 80s Polish' then CoverName := 'Singstar 80s'; + } + + // add Category Button + AddCategoryButton(CurCategory); + end + + else if (Ini.Sorting = sGenre) and + (CompareText(CurCategory, CurSong.Genre) <> 0) then + begin + CurCategory := CurSong.Genre; + // add Genre Button + AddCategoryButton(CurCategory); + end + + else if (Ini.Sorting = sLanguage) and + (CompareText(CurCategory, CurSong.Language) <> 0) then + begin + CurCategory := CurSong.Language; + // add Language Button + AddCategoryButton(CurCategory); + end + + else if (Ini.Sorting = sTitle) and + (Length(CurSong.Title) >= 1) and + (Letter <> UpperCase(CurSong.Title)[1]) then + begin + Letter := Uppercase(CurSong.Title)[1]; + // add a letter Category Button + AddCategoryButton(Letter); + end + + else if (Ini.Sorting = sArtist) and + (Length(CurSong.Artist) >= 1) and + (Letter <> UpperCase(CurSong.Artist)[1]) then + begin + Letter := UpperCase(CurSong.Artist)[1]; + // add a letter Category Button + AddCategoryButton(Letter); + end + + else if (Ini.Sorting = sFolder) and + (CompareText(CurCategory, CurSong.Folder) <> 0) then + begin + CurCategory := CurSong.Folder; + // add folder tab + AddCategoryButton(CurCategory); + end + + else if (Ini.Sorting = sTitle2) and + (Length(CurSong.Title) >= 1) then + begin + // pack all numbers into a category named '#' + if (CurSong.Title[1] >= '0') and (CurSong.Title[1] <= '9') then + LetterTmp := '#' + else + LetterTmp := UpperCase(CurSong.Title)[1]; + + if (Letter <> LetterTmp) then + begin + Letter := LetterTmp; + // add a letter Category Button + AddCategoryButton(Letter); + end; + end + + else if (Ini.Sorting = sArtist2) and + (Length(CurSong.Artist)>=1) then + begin + // pack all numbers into a category named '#' + if (CurSong.Artist[1] >= '0') and (CurSong.Artist[1] <= '9') then + LetterTmp := '#' + else + LetterTmp := UpperCase(CurSong.Artist)[1]; + + if (Letter <> LetterTmp) then + begin + Letter := LetterTmp; + // add a letter Category Button + AddCategoryButton(Letter); + end; + end; + end; + + CatIndex := Length(Song); + SetLength(Song, CatIndex+1); + + Inc(CatNumber); // increase number of songs in category + + // copy reference to current song + Song[CatIndex] := CurSong; + + // set song's category info + CurSong.OrderNum := Order; // assigns category + CurSong.CatNumber := CatNumber; + + if (Ini.Tabs = 0) then + CurSong.Visible := true + else if (Ini.Tabs = 1) then + CurSong.Visible := false; + + { + if (Ini.Tabs = 1) and (Order = 1) then + begin + //open first tab + CurSong.Visible := true; + end; + CurSong.Visible := true; + } + end; + + // set CatNumber of last category + if (Ini.Tabs_at_startup = 1) and (High(Song) >= 1) then + begin + // set number of songs in previous category + SongIndex := CatIndex - CatNumber; + if ((SongIndex >= 0) and Song[SongIndex].Main) then + Song[SongIndex].CatNumber := CatNumber; + end; + + // update number of categories + CatCount := Order; +end; + +procedure TCatSongs.ShowCategory(Index: integer); +var + S: integer; // song +begin + CatNumShow := Index; + for S := 0 to high(CatSongs.Song) do + begin +{ + if (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false; +} +// KMS: This should be the same, but who knows :-) + CatSongs.Song[S].Visible := ( (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) ); + end; +end; + +procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category +var + S: integer; // song +begin + for S := 0 to high(CatSongs.Song) do + begin + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false // hides all at now + end; +end; + +procedure TCatSongs.ClickCategoryButton(Index: integer); +var + Num, S: integer; +begin + Num := CatSongs.Song[Index].OrderNum; + if Num <> CatNumShow then + begin + ShowCategory(Num); + end + else + begin + ShowCategoryList; + end; +end; + +//Hide Categorys when in Category Hack +procedure TCatSongs.ShowCategoryList; +var + Num, S: integer; +begin + // Hide All Songs Show All Cats + for S := 0 to high(CatSongs.Song) do + CatSongs.Song[S].Visible := CatSongs.Song[S].Main; + CatSongs.Selected := CatNumShow; //Show last shown Category + CatNumShow := -1; +end; +//Hide Categorys when in Category Hack End + +//Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +var + I: integer; +begin + Result := -1; + I := SearchFrom + 1; + while not CatSongs.Song[I].Visible do + begin + Inc (I); + if (I>high(CatSongs.Song)) then + I := low(CatSongs.Song); + if (I = SearchFrom) then //Make One Round and no song found->quit + break; + end; +end; +//Wrong song selected when tabs on bug End + +(** + * Returns the number of visible songs. + *) +function TCatSongs.VisibleSongs: integer; +var + SongIndex: integer; +begin + Result := 0; + for SongIndex := 0 to High(CatSongs.Song) do + begin + if (CatSongs.Song[SongIndex].Visible) then + Inc(Result); + end; +end; + +(** + * Returns the index of a song in the subset of all visible songs. + * If all songs are visible, the result will be equal to the Index parameter. + *) +function TCatSongs.VisibleIndex(Index: integer): integer; +var + SongIndex: integer; +begin + Result := 0; + for SongIndex := 0 to Index-1 do + begin + if (CatSongs.Song[SongIndex].Visible) then + Inc(Result); + end; +end; + +function TCatSongs.SetFilter(FilterStr: string; const fType: Byte): Cardinal; +var + I, J: integer; + cString: string; + SearchStr: array of string; +begin + {fType: 0: All + 1: Title + 2: Artist} + FilterStr := Trim(FilterStr); + if FilterStr<>'' then + begin + Result := 0; + //Create Search Array + SetLength(SearchStr, 1); + I := Pos (' ', FilterStr); + while (I <> 0) do + begin + SetLength (SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I-1); + if (cString <> ' ') and (cString <> '') then + SearchStr[High(SearchStr)-1] := cString; + Delete (FilterStr, 1, I); + + I := Pos (' ', FilterStr); + end; + //Copy last Word + if (FilterStr <> ' ') and (FilterStr <> '') then + SearchStr[High(SearchStr)] := FilterStr; + + for I:=0 to High(Song) do + begin + if not Song[i].Main then + begin + case fType of + 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + 1: cString := Song[I].Title; + 2: cString := Song[I].Artist; + end; + Song[i].Visible:=True; + //Look for every Searched Word + for J := 0 to High(SearchStr) do + begin + Song[i].Visible := Song[i].Visible and AnsiContainsText(cString, SearchStr[J]) + end; + if Song[i].Visible then + Inc(Result); + end + else + Song[i].Visible:=False; + end; + CatNumShow := -2; + end + else + begin + for i:=0 to High(Song) do + begin + Song[i].Visible := (Ini.Tabs=1) = Song[i].Main; + CatNumShow := -1; + end; + Result := 0; + end; +end; + +// ----------------------------------------------------------------------------- + +end. diff --git a/src/classes0/UTextClasses.pas b/src/classes0/UTextClasses.pas new file mode 100644 index 00000000..9a12e1f5 --- /dev/null +++ b/src/classes0/UTextClasses.pas @@ -0,0 +1,60 @@ +unit UTextClasses; + +interface + +{$I switches.inc} + +uses + gl, + SDL, + UTexture, + Classes, +// SDL_ttf, + ULog; + +{ +// okay i just outline what should be here, so we can create a nice and clean implementation of sdl_ttf +// based up on this uml: http://jnr.sourceforge.net/fusion_images/www_FRS.png +// thanks to Bob Pendelton and Koshmaar! +// (1) let's start with a glyph, this represents one character in a word + +type + TGlyph = record + character : Char; // unsigned char, uchar is something else in delphi + glyphsSolid[8] : GlyphTexture; // fast, but not that + glyphsBlended[8] : GlyphTexture; // slower than solid, but it look's more pretty + +//this class has a method, which should be a deconstructor (mog is on his way to understand the principles of oop :P) + deconstructor procedure ReleaseTextures(); +end; + +// (2) okay, we now need the stuff that's even beneath this glyph - we're right at the birth of text in here :P + + GlyphTexture = record + textureID : GLuint; // we need this for caching the letters, if the texture wasn't created before create it, should be very fast because of this one + width, + height : Cardinal; + charWidth, + charHeight : Integer; + advance : Integer; // don't know yet for what this one is +} + +{ +// after the glyph is done, we now start to build whole words - this one is pretty important, and does most of the work we need + TGlyphsContainer = record + glyphs array of TGlyph; + FontName array of string; + refCount : uChar; // unsigned char, uchar is something else in delphi + font : PTTF_font; + size, + lineSkip : Cardinal; // vertical distance between multi line text output + descent : Integer; + + + +} + + +implementation + +end. diff --git a/src/classes0/UTexture.pas b/src/classes0/UTexture.pas new file mode 100644 index 00000000..4879760a --- /dev/null +++ b/src/classes0/UTexture.pas @@ -0,0 +1,525 @@ +unit UTexture; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + gl, + glu, + glext, + Classes, + SysUtils, + UCommon, + SDL, + SDL_Image; + +type + PTexture = ^TTexture; + TTexture = record + TexNum: GLuint; + X: real; + Y: real; + Z: real; + W: real; + H: real; + ScaleW: real; // for dynamic scalling while leaving width constant + ScaleH: real; // for dynamic scalling while leaving height constant + Rot: real; // 0 - 2*pi + Int: real; // intensity + ColR: real; + ColG: real; + ColB: real; + TexW: real; // percentage of width to use [0..1] + TexH: real; // percentage of height to use [0..1] + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // experimental for handling cache images. maybe it's useful for dynamic skins + end; + +type + TTextureType = ( + TEXTURE_TYPE_PLAIN, // Plain (alpha = 1) + TEXTURE_TYPE_TRANSPARENT, // Alpha is used + TEXTURE_TYPE_COLORIZED // Alpha is used; Hue of the HSV color-model will be replaced by a new value + ); + +const + TextureTypeStr: array[TTextureType] of string = ( + 'Plain', + 'Transparent', + 'Colorized' + ); + +function TextureTypeToStr(TexType: TTextureType): string; +function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType; + +procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType); + +type + PTextureEntry = ^TTextureEntry; + TTextureEntry = record + Name: string; + Typ: TTextureType; + Color: Cardinal; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; // Full-size texture + TextureCache: TTexture; // Thumbnail texture + end; + + TTextureDatabase = class + private + Texture: array of TTextureEntry; + public + procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); + function FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer; + end; + + TTextureUnit = class + private + TextureDatabase: TTextureDatabase; + public + Limit: integer; + + procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload; + procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean = false); overload; + function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload; + function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload; + function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload; + function LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload; + function LoadTexture(const Identifier: string): TTexture; overload; + function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; + procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload; + procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload; + //procedure FlushTextureDatabase(); + + constructor Create; + destructor Destroy; override; + end; + +var + Texture: TTextureUnit; + +implementation + +uses + DateUtils, + StrUtils, + Math, + ULog, + UCovers, + UThemes, + UImage; + +procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType); +var + TempSurface: PSDL_Surface; + NeededPixFmt: PSDL_Pixelformat; +begin + if (Typ = TEXTURE_TYPE_PLAIN) then + NeededPixFmt := @PixelFmt_RGB + else if (Typ = TEXTURE_TYPE_TRANSPARENT) or + (Typ = TEXTURE_TYPE_COLORIZED) then + NeededPixFmt := @PixelFmt_RGBA + else + NeededPixFmt := @PixelFmt_RGB; + + if not PixelformatEquals(TexSurface^.format, NeededPixFmt) then + begin + TempSurface := TexSurface; + TexSurface := SDL_ConvertSurface(TempSurface, NeededPixFmt, SDL_SWSURFACE); + SDL_FreeSurface(TempSurface); + end; +end; + +{ TTextureDatabase } + +procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); +var + TextureIndex: integer; +begin + TextureIndex := FindTexture(Tex.Name, Typ, Color); + if (TextureIndex = -1) then + begin + TextureIndex := Length(Texture); + SetLength(Texture, TextureIndex+1); + + Texture[TextureIndex].Name := Tex.Name; + Texture[TextureIndex].Typ := Typ; + Texture[TextureIndex].Color := Color; + end; + + if (Cache) then + Texture[TextureIndex].TextureCache := Tex + else + Texture[TextureIndex].Texture := Tex; +end; + +function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer; +var + TextureIndex: integer; + CurrentTexture: PTextureEntry; +begin + Result := -1; + for TextureIndex := 0 to High(Texture) do + begin + CurrentTexture := @Texture[TextureIndex]; + if (CurrentTexture.Name = Name) and + (CurrentTexture.Typ = Typ) then + begin + // colorized textures must match in their color too + if (CurrentTexture.Typ <> TEXTURE_TYPE_COLORIZED) or + (CurrentTexture.Color = Color) then + begin + Result := TextureIndex; + Break; + end; + end; + end; +end; + + +{ TTextureUnit } + +constructor TTextureUnit.Create; +begin + inherited Create; + TextureDatabase := TTextureDatabase.Create; +end; + +destructor TTextureUnit.Destroy; +begin + TextureDatabase.Free; + inherited Destroy; +end; + + +procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean); +begin + TextureDatabase.AddTexture(Tex, Typ, 0, Cache); +end; + +procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); +begin + TextureDatabase.AddTexture(Tex, Typ, Color, Cache); +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; +begin + // FIXME: what is the FromRegistry parameter supposed to do? + Result := LoadTexture(Identifier, Typ, Col); +end; + +function TTextureUnit.LoadTexture(const Identifier: string): TTexture; +begin + Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0); +end; + +function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; +var + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + ActTex: GLuint; +begin + // zero texture data + FillChar(Result, SizeOf(Result), 0); + + // load texture data into memory + TexSurface := LoadImage(Identifier); + if not assigned(TexSurface) then + begin + Log.LogError('Could not load texture: "' + Identifier +' '+ TextureTypeToStr(Typ) +'"', + 'TTextureUnit.LoadTexture'); + Exit; + end; + + // convert pixel format as needed + AdjustPixelFormat(TexSurface, Typ); + + // adjust texture size (scale down, if necessary) + newWidth := TexSurface.W; + newHeight := TexSurface.H; + + if (newWidth > Limit) then + newWidth := Limit; + + if (newHeight > Limit) then + newHeight := Limit; + + if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then + ScaleImage(TexSurface, newWidth, newHeight); + + // now we might colorize the whole thing + if (Typ = TEXTURE_TYPE_COLORIZED) then + ColorizeImage(TexSurface, Col); + + // save actual dimensions of our texture + oldWidth := newWidth; + oldHeight := newHeight; + + // make texture dimensions be powers of 2 + newWidth := Round(Power(2, Ceil(Log2(newWidth)))); + newHeight := Round(Power(2, Ceil(Log2(newHeight)))); + if (newHeight <> oldHeight) or (newWidth <> oldWidth) then + FitImage(TexSurface, newWidth, newHeight); + + // at this point we have the image in memory... + // scaled to be at most 1024x1024 pixels large + // scaled so that dimensions are powers of 2 + // and converted to either RGB or RGBA + + // if we got a Texture of Type Plain, Transparent or Colorized, + // then we're done manipulating it + // and could now create our openGL texture from it + + // prepare OpenGL texture + glGenTextures(1, @ActTex); + + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + // load data into gl texture + if (Typ = TEXTURE_TYPE_TRANSPARENT) or + (Typ = TEXTURE_TYPE_COLORIZED) then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + else //if Typ = TEXTURE_TYPE_PLAIN then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + // setup texture struct + with Result do + begin + X := 0; + Y := 0; + Z := 0; + W := 0; + H := 0; + ScaleW := 1; + ScaleH := 1; + Rot := 0; + TexNum := ActTex; + TexW := oldWidth / newWidth; + TexH := oldHeight / newHeight; + + Int := 1; + ColR := 1; + ColG := 1; + ColB := 1; + Alpha := 1; + + // new test - default use whole texure, taking TexW and TexH as const and changing these + TexX1 := 0; + TexY1 := 0; + TexX2 := 1; + TexY2 := 1; + + Name := Identifier; + end; + + SDL_FreeSurface(TexSurface); +end; + +function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean): TTexture; +begin + Result := GetTexture(Name, Typ, 0, FromCache); +end; + +function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture; +var + TextureIndex: integer; + CoverIndex: integer; +begin + if (Name = '') then + begin + // zero texture data + FillChar(Result, SizeOf(Result), 0); + Exit; + end; + + if (FromCache) then + begin + (* + // use cache texture + CoverIndex := Covers.FindCover(Name); + + if TextureDatabase.Texture[TextureIndex].TextureCache.TexNum = 0 then + begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[TextureIndex].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[CoverIndex].Width, Covers.Cover[CoverIndex].Height, 24); + end; + *) + + // use texture + TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col); + if (TextureIndex > -1) then + Result := TextureDatabase.Texture[TextureIndex].TextureCache; + Exit; + end; + + // find texture entry in database + TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col); + if (TextureIndex = -1) then + begin + // create texture entry in database + TextureIndex := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, TextureIndex+1); + + TextureDatabase.Texture[TextureIndex].Name := Name; + TextureDatabase.Texture[TextureIndex].Typ := Typ; + TextureDatabase.Texture[TextureIndex].Color := Col; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[TextureIndex].Texture.TexNum := 0; + TextureDatabase.Texture[TextureIndex].TextureCache.TexNum := 0; + end; + + // load full texture + if (TextureDatabase.Texture[TextureIndex].Texture.TexNum = 0) then + TextureDatabase.Texture[TextureIndex].Texture := LoadTexture(false, Name, Typ, Col); + + // use texture + Result := TextureDatabase.Texture[TextureIndex].Texture; +end; + +function TTextureUnit.CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; +var + Error: integer; + ActTex: GLuint; +begin + glGenTextures(1, @ActTex); // ActText = new texture number + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data); + + { + if Mipmapping then + begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then + Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture'); + end; + } + + Result.X := 0; + Result.Y := 0; + Result.Z := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := 1; + Result.TexH := 1; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); +begin + UnloadTexture(Name, Typ, 0, FromCache); +end; + +procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := TextureDatabase.FindTexture(Name, Typ, Col); + + if not FromCache then + begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum > 0 then + begin + glDeleteTextures(1, PGLuint(@TexNum)); + TextureDatabase.Texture[T].Texture.TexNum := 0; + //Log.LogError('Unload texture no '+IntToStr(TexNum)); + end; + end + else + begin + TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; + if TexNum > 0 then + begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].TextureCache.TexNum := 0; + //Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +(* This needs some work +procedure TTextureUnit.FlushTextureDatabase(); +var + i: integer; + Tex: ^TTexture; +begin + for i := 0 to High(TextureDatabase.Texture) do + begin + // only delete non-cached entries + if (TextureDatabase.Texture[i].Texture.TexNum > 0) then + begin + Tex := @TextureDatabase.Texture[i].Texture; + glDeleteTextures(1, PGLuint(Tex^.TexNum)); + Tex^.TexNum := 0; + end; + end; +end; +*) + +function TextureTypeToStr(TexType: TTextureType): string; +begin + Result := TextureTypeStr[TexType]; +end; + +function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType; +var + TexType: TTextureType; + UpCaseStr: string; +begin + UpCaseStr := UpperCase(TypeStr); + for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do + begin + if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then + begin + Result := TexType; + Exit; + end; + end; + Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType'); + Result := TEXTURE_TYPE_PLAIN; +end; + +end. diff --git a/src/classes0/UThemes.pas b/src/classes0/UThemes.pas new file mode 100644 index 00000000..fca75c24 --- /dev/null +++ b/src/classes0/UThemes.pas @@ -0,0 +1,2234 @@ +unit UThemes; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + ULog, + IniFiles, + SysUtils, + Classes, + UTexture; + +type + TRGB = record + R: single; + G: single; + B: single; + end; + + TRGBA = record + R, G, B, A: Double; + end; + + TThemeBackground = record + Tex: string; + end; + + TThemeStatic = record + X: integer; + Y: integer; + Z: real; + W: integer; + H: integer; + Color: string; + ColR: real; + ColG: real; + ColB: real; + Tex: string; + Typ: TTextureType; + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + //Reflection + Reflection: boolean; + Reflectionspacing: Real; + end; + AThemeStatic = array of TThemeStatic; + + TThemeText = record + X: integer; + Y: integer; + W: integer; + Z: real; + Color: string; + ColR: real; + ColG: real; + ColB: real; + Font: integer; + Size: integer; + Align: integer; + Text: string; + //Reflection + Reflection: boolean; + ReflectionSpacing: Real; + end; + AThemeText = array of TThemeText; + + TThemeButton = record + Text: AThemeText; + X: integer; + Y: integer; + Z: Real; + W: integer; + H: integer; + Color: string; + ColR: real; + ColG: real; + ColB: real; + Int: real; + DColor: string; + DColR: real; + DColG: real; + DColB: real; + DInt: real; + Tex: string; + Typ: TTextureType; + + Visible: Boolean; + + //Reflection Mod + Reflection: boolean; + Reflectionspacing: Real; + //Fade Mod + SelectH: integer; + SelectW: integer; + Fade: boolean; + FadeText: boolean; + DeSelectReflectionspacing : Real; + FadeTex: string; + FadeTexPos: integer; + + //Button Collection Mod + Parent: Byte; //Number of the Button Collection this Button is assigned to. IF 0: No Assignement + end; + + //Button Collection Mod + TThemeButtonCollection = record + Style: TThemeButton; + ChildCount: Byte; //No of assigned Childs + FirstChild: Byte; //No of Child on whose Interaction Position the Button should be + end; + + AThemeButtonCollection = array of TThemeButtonCollection; + PAThemeButtonCollection = ^AThemeButtonCollection; + + TThemeSelectSlide = record + Tex: string; + TexSBG: string; + X: integer; + Y: integer; + W: integer; + H: integer; + Z: real; + + TextSize: integer; + + //SBGW Mod + SBGW: integer; + + Text: string; + ColR, ColG, ColB, Int: real; + DColR, DColG, DColB, DInt: real; + TColR, TColG, TColB, TInt: real; + TDColR, TDColG, TDColB, TDInt: real; + SBGColR, SBGColG, SBGColB, SBGInt: real; + SBGDColR, SBGDColG, SBGDColB, SBGDInt: real; + STColR, STColG, STColB, STInt: real; + STDColR, STDColG, STDColB, STDInt: real; + SkipX: integer; + end; + + PThemeBasic = ^TThemeBasic; + TThemeBasic = class + Background: TThemeBackground; + Text: AThemeText; + Static: AThemeStatic; + + //Button Collection Mod + ButtonCollection: AThemeButtonCollection; + end; + + TThemeLoading = class(TThemeBasic) + StaticAnimation: TThemeStatic; + TextLoading: TThemeText; + end; + + TThemeMain = class(TThemeBasic) + ButtonSolo: TThemeButton; + ButtonMulti: TThemeButton; + ButtonStat: TThemeButton; + ButtonEditor: TThemeButton; + ButtonOptions: TThemeButton; + ButtonExit: TThemeButton; + + TextDescription: TThemeText; + TextDescriptionLong: TThemeText; + Description: array[0..5] of string; + DescriptionLong: array[0..5] of string; + end; + + TThemeName = class(TThemeBasic) + ButtonPlayer: array[1..6] of TThemeButton; + end; + + TThemeLevel = class(TThemeBasic) + ButtonEasy: TThemeButton; + ButtonMedium: TThemeButton; + ButtonHard: TThemeButton; + end; + + TThemeSong = class(TThemeBasic) + TextArtist: TThemeText; + TextTitle: TThemeText; + TextNumber: TThemeText; + + //Video Icon Mod + VideoIcon: TThemeStatic; + + //Show Cat in TopLeft Mod + TextCat: TThemeText; + StaticCat: TThemeStatic; + + //Cover Mod + Cover: record + Reflections: Boolean; + X: Integer; + Y: Integer; + Z: Integer; + W: Integer; + H: Integer; + Style: Integer; + end; + + //Equalizer Mod + Equalizer: record + Visible: Boolean; + Direction: Boolean; + Alpha: real; + X: Integer; + Y: Integer; + Z: Real; + W: Integer; + H: Integer; + Space: Integer; + Bands: Integer; + Length: Integer; + ColR, ColG, ColB: Real; + end; + + + //Party and Non Party specific Statics and Texts + StaticParty: AThemeStatic; + TextParty: AThemeText; + + StaticNonParty: AThemeStatic; + TextNonParty: AThemeText; + + //Party Mode + StaticTeam1Joker1: TThemeStatic; + StaticTeam1Joker2: TThemeStatic; + StaticTeam1Joker3: TThemeStatic; + StaticTeam1Joker4: TThemeStatic; + StaticTeam1Joker5: TThemeStatic; + StaticTeam2Joker1: TThemeStatic; + StaticTeam2Joker2: TThemeStatic; + StaticTeam2Joker3: TThemeStatic; + StaticTeam2Joker4: TThemeStatic; + StaticTeam2Joker5: TThemeStatic; + StaticTeam3Joker1: TThemeStatic; + StaticTeam3Joker2: TThemeStatic; + StaticTeam3Joker3: TThemeStatic; + StaticTeam3Joker4: TThemeStatic; + StaticTeam3Joker5: TThemeStatic; + + + end; + + TThemeSing = class(TThemeBasic) + + //TimeBar mod + StaticTimeProgress: TThemeStatic; + TextTimeText : TThemeText; + //eoa TimeBar mod + + StaticP1: TThemeStatic; + TextP1: TThemeText; + StaticP1ScoreBG: TThemeStatic; //Static for ScoreBG + TextP1Score: TThemeText; + + //moveable singbar mod + StaticP1SingBar: TThemeStatic; + StaticP1ThreePSingBar: TThemeStatic; + StaticP1TwoPSingBar: TThemeStatic; + StaticP2RSingBar: TThemeStatic; + StaticP2MSingBar: TThemeStatic; + StaticP3SingBar: TThemeStatic; + //eoa moveable singbar + + //added for ps3 skin + //game in 2/4 player modi + StaticP1TwoP: TThemeStatic; + StaticP1TwoPScoreBG: TThemeStatic; //Static for ScoreBG + TextP1TwoP: TThemeText; + TextP1TwoPScore: TThemeText; + //game in 3/6 player modi + StaticP1ThreeP: TThemeStatic; + StaticP1ThreePScoreBG: TThemeStatic; //Static for ScoreBG + TextP1ThreeP: TThemeText; + TextP1ThreePScore: TThemeText; + //eoa + + StaticP2R: TThemeStatic; + StaticP2RScoreBG: TThemeStatic; //Static for ScoreBG + TextP2R: TThemeText; + TextP2RScore: TThemeText; + + StaticP2M: TThemeStatic; + StaticP2MScoreBG: TThemeStatic; //Static for ScoreBG + TextP2M: TThemeText; + TextP2MScore: TThemeText; + + StaticP3R: TThemeStatic; + StaticP3RScoreBG: TThemeStatic; //Static for ScoreBG + TextP3R: TThemeText; + TextP3RScore: TThemeText; + + //Linebonus Translations + LineBonusText: Array [0..8] of String; + + //Pause Popup + PausePopUp: TThemeStatic; + end; + + TThemeScore = class(TThemeBasic) + TextArtist: TThemeText; + TextTitle: TThemeText; + + TextArtistTitle: TThemeText; + + PlayerStatic: array[1..6] of AThemeStatic; + PlayerTexts: array[1..6] of AThemeText; + + TextName: array[1..6] of TThemeText; + TextScore: array[1..6] of TThemeText; + + TextNotes: array[1..6] of TThemeText; + TextNotesScore: array[1..6] of TThemeText; + TextLineBonus: array[1..6] of TThemeText; + TextLineBonusScore: array[1..6] of TThemeText; + TextGoldenNotes: array[1..6] of TThemeText; + TextGoldenNotesScore: array[1..6] of TThemeText; + TextTotal: array[1..6] of TThemeText; + TextTotalScore: array[1..6] of TThemeText; + + StaticBoxLightest: array[1..6] of TThemeStatic; + StaticBoxLight: array[1..6] of TThemeStatic; + StaticBoxDark: array[1..6] of TThemeStatic; + + StaticRatings: array[1..6] of TThemeStatic; + + StaticBackLevel: array[1..6] of TThemeStatic; + StaticBackLevelRound: array[1..6] of TThemeStatic; + StaticLevel: array[1..6] of TThemeStatic; + StaticLevelRound: array[1..6] of TThemeStatic; + +// Description: array[0..5] of string;} + end; + + TThemeTop5 = class(TThemeBasic) + TextLevel: TThemeText; + TextArtistTitle: TThemeText; + + StaticNumber: AThemeStatic; + TextNumber: AThemeText; + TextName: AThemeText; + TextScore: AThemeText; + end; + + TThemeOptions = class(TThemeBasic) + ButtonGame: TThemeButton; + ButtonGraphics: TThemeButton; + ButtonSound: TThemeButton; + ButtonLyrics: TThemeButton; + ButtonThemes: TThemeButton; + ButtonRecord: TThemeButton; + ButtonAdvanced: TThemeButton; + ButtonExit: TThemeButton; + + TextDescription: TThemeText; + Description: array[0..7] of string; + end; + + TThemeOptionsGame = class(TThemeBasic) + SelectPlayers: TThemeSelectSlide; + SelectDifficulty: TThemeSelectSlide; + SelectLanguage: TThemeSelectSlide; + SelectTabs: TThemeSelectSlide; + SelectSorting: TThemeSelectSlide; + SelectDebug: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsGraphics = class(TThemeBasic) + SelectFullscreen: TThemeSelectSlide; + SelectResolution: TThemeSelectSlide; + SelectDepth: TThemeSelectSlide; + SelectVisualizer: TThemeSelectSlide; + SelectOscilloscope: TThemeSelectSlide; + SelectLineBonus: TThemeSelectSlide; + SelectMovieSize: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsSound = class(TThemeBasic) + SelectMicBoost: TThemeSelectSlide; + SelectBackgroundMusic: TThemeSelectSlide; + SelectClickAssist: TThemeSelectSlide; + SelectBeatClick: TThemeSelectSlide; + SelectThreshold: TThemeSelectSlide; + SelectSlidePreviewVolume: TThemeSelectSlide; + SelectSlidePreviewFading: TThemeSelectSlide; + SelectSlideVoicePassthrough: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsLyrics = class(TThemeBasic) + SelectLyricsFont: TThemeSelectSlide; + SelectLyricsEffect: TThemeSelectSlide; +// SelectSolmization: TThemeSelectSlide; + SelectNoteLines: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsThemes = class(TThemeBasic) + SelectTheme: TThemeSelectSlide; + SelectSkin: TThemeSelectSlide; + SelectColor: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsRecord = class(TThemeBasic) + SelectSlideCard: TThemeSelectSlide; + SelectSlideInput: TThemeSelectSlide; + SelectSlideChannel: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsAdvanced = class(TThemeBasic) + SelectLoadAnimation: TThemeSelectSlide; + SelectEffectSing: TThemeSelectSlide; + SelectScreenFade: TThemeSelectSlide; + SelectLineBonus: TThemeSelectSlide; + SelectAskbeforeDel: TThemeSelectSlide; + SelectOnSongClick: TThemeSelectSlide; + SelectPartyPopup: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + //Error- and Check-Popup + TThemeError = class(TThemeBasic) + Button1: TThemeButton; + TextError: TThemeText; + end; + + TThemeCheck = class(TThemeBasic) + Button1: TThemeButton; + Button2: TThemeButton; + TextCheck: TThemeText; + end; + + + //ScreenSong Menue + TThemeSongMenu = class(TThemeBasic) + Button1: TThemeButton; + Button2: TThemeButton; + Button3: TThemeButton; + Button4: TThemeButton; + + SelectSlide3: TThemeSelectSlide; + + TextMenu: TThemeText; + end; + + TThemeSongJumpTo = class(TThemeBasic) + ButtonSearchText: TThemeButton; + SelectSlideType: TThemeSelectSlide; + TextFound: TThemeText; + + //Translated Texts + Songsfound: String; + NoSongsfound: String; + CatText: String; + IType: array [0..2] of String; + end; + + //Party Screens + TThemePartyNewRound = class(TThemeBasic) + TextRound1: TThemeText; + TextRound2: TThemeText; + TextRound3: TThemeText; + TextRound4: TThemeText; + TextRound5: TThemeText; + TextRound6: TThemeText; + TextRound7: TThemeText; + TextWinner1: TThemeText; + TextWinner2: TThemeText; + TextWinner3: TThemeText; + TextWinner4: TThemeText; + TextWinner5: TThemeText; + TextWinner6: TThemeText; + TextWinner7: TThemeText; + TextNextRound: TThemeText; + TextNextRoundNo: TThemeText; + TextNextPlayer1: TThemeText; + TextNextPlayer2: TThemeText; + TextNextPlayer3: TThemeText; + + StaticRound1: TThemeStatic; + StaticRound2: TThemeStatic; + StaticRound3: TThemeStatic; + StaticRound4: TThemeStatic; + StaticRound5: TThemeStatic; + StaticRound6: TThemeStatic; + StaticRound7: TThemeStatic; + + TextScoreTeam1: TThemeText; + TextScoreTeam2: TThemeText; + TextScoreTeam3: TThemeText; + TextNameTeam1: TThemeText; + TextNameTeam2: TThemeText; + TextNameTeam3: TThemeText; + TextTeam1Players: TThemeText; + TextTeam2Players: TThemeText; + TextTeam3Players: TThemeText; + + StaticTeam1: TThemeStatic; + StaticTeam2: TThemeStatic; + StaticTeam3: TThemeStatic; + StaticNextPlayer1: TThemeStatic; + StaticNextPlayer2: TThemeStatic; + StaticNextPlayer3: TThemeStatic; + end; + + TThemePartyScore = class(TThemeBasic) + TextScoreTeam1: TThemeText; + TextScoreTeam2: TThemeText; + TextScoreTeam3: TThemeText; + TextNameTeam1: TThemeText; + TextNameTeam2: TThemeText; + TextNameTeam3: TThemeText; + StaticTeam1: TThemeStatic; + StaticTeam1BG: TThemeStatic; + StaticTeam1Deco: TThemeStatic; + StaticTeam2: TThemeStatic; + StaticTeam2BG: TThemeStatic; + StaticTeam2Deco: TThemeStatic; + StaticTeam3: TThemeStatic; + StaticTeam3BG: TThemeStatic; + StaticTeam3Deco: TThemeStatic; + + DecoTextures: record + ChangeTextures: Boolean; + + FirstTexture: String; + FirstTyp: TTextureType; + FirstColor: String; + + SecondTexture: String; + SecondTyp: TTextureType; + SecondColor: String; + + ThirdTexture: String; + ThirdTyp: TTextureType; + ThirdColor: String; + end; + + + TextWinner: TThemeText; + end; + + TThemePartyWin = class(TThemeBasic) + TextScoreTeam1: TThemeText; + TextScoreTeam2: TThemeText; + TextScoreTeam3: TThemeText; + TextNameTeam1: TThemeText; + TextNameTeam2: TThemeText; + TextNameTeam3: TThemeText; + StaticTeam1: TThemeStatic; + StaticTeam1BG: TThemeStatic; + StaticTeam1Deco: TThemeStatic; + StaticTeam2: TThemeStatic; + StaticTeam2BG: TThemeStatic; + StaticTeam2Deco: TThemeStatic; + StaticTeam3: TThemeStatic; + StaticTeam3BG: TThemeStatic; + StaticTeam3Deco: TThemeStatic; + + TextWinner: TThemeText; + end; + + TThemePartyOptions = class(TThemeBasic) + SelectLevel: TThemeSelectSlide; + SelectPlayList: TThemeSelectSlide; + SelectPlayList2: TThemeSelectSlide; + SelectRounds: TThemeSelectSlide; + SelectTeams: TThemeSelectSlide; + SelectPlayers1: TThemeSelectSlide; + SelectPlayers2: TThemeSelectSlide; + SelectPlayers3: TThemeSelectSlide; + + {ButtonNext: TThemeButton; + ButtonPrev: TThemeButton;} + end; + + TThemePartyPlayer = class(TThemeBasic) + Team1Name: TThemeButton; + Player1Name: TThemeButton; + Player2Name: TThemeButton; + Player3Name: TThemeButton; + Player4Name: TThemeButton; + + Team2Name: TThemeButton; + Player5Name: TThemeButton; + Player6Name: TThemeButton; + Player7Name: TThemeButton; + Player8Name: TThemeButton; + + Team3Name: TThemeButton; + Player9Name: TThemeButton; + Player10Name: TThemeButton; + Player11Name: TThemeButton; + Player12Name: TThemeButton; + + {ButtonNext: TThemeButton; + ButtonPrev: TThemeButton;} + end; + + //Stats Screens + TThemeStatMain = class(TThemeBasic) + ButtonScores: TThemeButton; + ButtonSingers: TThemeButton; + ButtonSongs: TThemeButton; + ButtonBands: TThemeButton; + ButtonExit: TThemeButton; + + TextOverview: TThemeText; + end; + + TThemeStatDetail = class(TThemeBasic) + ButtonNext: TThemeButton; + ButtonPrev: TThemeButton; + ButtonReverse: TThemeButton; + ButtonExit: TThemeButton; + + TextDescription: TThemeText; + TextPage: TThemeText; + TextList: AThemeText; + + Description: array[0..3] of string; + DescriptionR: array[0..3] of string; + FormatStr: array[0..3] of string; + PageStr: String; + end; + + //Playlist Translations + TThemePlaylist = record + CatText: string; + end; + + TTheme = class + private + {$IFDEF THEMESAVE} + ThemeIni: TIniFile; + {$ELSE} + ThemeIni: TMemIniFile; + {$ENDIF} + + LastThemeBasic: TThemeBasic; + procedure create_theme_objects(); + public + + Loading: TThemeLoading; + Main: TThemeMain; + Name: TThemeName; + Level: TThemeLevel; + Song: TThemeSong; + Sing: TThemeSing; + Score: TThemeScore; + Top5: TThemeTop5; + Options: TThemeOptions; + OptionsGame: TThemeOptionsGame; + OptionsGraphics: TThemeOptionsGraphics; + OptionsSound: TThemeOptionsSound; + OptionsLyrics: TThemeOptionsLyrics; + OptionsThemes: TThemeOptionsThemes; + OptionsRecord: TThemeOptionsRecord; + OptionsAdvanced: TThemeOptionsAdvanced; + //error and check popup + ErrorPopup: TThemeError; + CheckPopup: TThemeCheck; + //ScreenSong extensions + SongMenu: TThemeSongMenu; + SongJumpto: TThemeSongJumpTo; + //Party Screens: + PartyNewRound: TThemePartyNewRound; + PartyScore: TThemePartyScore; + PartyWin: TThemePartyWin; + PartyOptions: TThemePartyOptions; + PartyPlayer: TThemePartyPlayer; + + //Stats Screens: + StatMain: TThemeStatMain; + StatDetail: TThemeStatDetail; + + Playlist: TThemePlaylist; + + ILevel: array[0..2] of String; + + constructor Create(FileName: string); overload; // Initialize theme system + constructor Create(FileName: string; Color: integer); overload; // Initialize theme system with color + function LoadTheme(FileName: string; sColor: integer): boolean; // Load some theme settings from file + + procedure LoadColors; + + procedure ThemeLoadBasic(Theme: TThemeBasic; Name: string); + procedure ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string); + procedure ThemeLoadText(var ThemeText: TThemeText; Name: string); + procedure ThemeLoadTexts(var ThemeText: AThemeText; Name: string); + procedure ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string); + procedure ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string); + procedure ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection = nil); + procedure ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string); + procedure ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string); + procedure ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); + + procedure ThemeSave(FileName: string); + procedure ThemeSaveBasic(Theme: TThemeBasic; Name: string); + procedure ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string); + procedure ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string); + procedure ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string); + procedure ThemeSaveText(ThemeText: TThemeText; Name: string); + procedure ThemeSaveTexts(ThemeText: AThemeText; Name: string); + procedure ThemeSaveButton(ThemeButton: TThemeButton; Name: string); + + end; + + TColor = record + Name: string; + RGB: TRGB; + end; + +function ColorExists(Name: string): integer; +procedure LoadColor(var R, G, B: real; ColorName: string); +function GetSystemColor(Color: integer): TRGB; +function ColorSqrt(RGB: TRGB): TRGB; + +var + //Skin: TSkin; + Theme: TTheme; + Color: array of TColor; + +implementation + +uses + UCommon, + ULanguage, + USkins, + UIni; + +constructor TTheme.Create(FileName: string); +begin + Create(FileName, 0); +end; + +constructor TTheme.Create(FileName: string; Color: integer); +begin + inherited Create(); + + Loading := TThemeLoading.Create; + Main := TThemeMain.Create; + Name := TThemeName.Create; + Level := TThemeLevel.Create; + Song := TThemeSong.Create; + Sing := TThemeSing.Create; + Score := TThemeScore.Create; + Top5 := TThemeTop5.Create; + Options := TThemeOptions.Create; + OptionsGame := TThemeOptionsGame.Create; + OptionsGraphics := TThemeOptionsGraphics.Create; + OptionsSound := TThemeOptionsSound.Create; + OptionsLyrics := TThemeOptionsLyrics.Create; + OptionsThemes := TThemeOptionsThemes.Create; + OptionsRecord := TThemeOptionsRecord.Create; + OptionsAdvanced := TThemeOptionsAdvanced.Create; + + ErrorPopup := TThemeError.Create; + CheckPopup := TThemeCheck.Create; + + SongMenu := TThemeSongMenu.Create; + SongJumpto := TThemeSongJumpto.Create; + //Party Screens + PartyNewRound := TThemePartyNewRound.Create; + PartyWin := TThemePartyWin.Create; + PartyScore := TThemePartyScore.Create; + PartyOptions := TThemePartyOptions.Create; + PartyPlayer := TThemePartyPlayer.Create; + + //Stats Screens: + StatMain := TThemeStatMain.Create; + StatDetail := TThemeStatDetail.Create; + + LoadTheme(FileName, Color); + +end; + + +function TTheme.LoadTheme(FileName: string; sColor: integer): boolean; +var + I: integer; + Path: string; +begin + Result := false; + + create_theme_objects(); + + Log.LogStatus('Loading: '+ FileName, 'TTheme.LoadTheme'); + + FileName := AdaptFilePaths( FileName ); + + if not FileExists(FileName) then + begin + Log.LogError('Theme does not exist ('+ FileName +')', 'TTheme.LoadTheme'); + end; + + if FileExists(FileName) then + begin + Result := true; + + {$IFDEF THEMESAVE} + ThemeIni := TIniFile.Create(FileName); + {$ELSE} + ThemeIni := TMemIniFile.Create(FileName); + {$ENDIF} + + if ThemeIni.ReadString('Theme', 'Name', '') <> '' then + begin + + {Skin.SkinName := ThemeIni.ReadString('Theme', 'Name', 'Singstar'); + Skin.SkinPath := 'Skins\' + Skin.SkinName + '\'; + Skin.SkinReg := false; } + Skin.Color := sColor; + + Skin.LoadSkin(ISkin[Ini.SkinNo]); + + LoadColors; + +// ThemeIni.Free; +// ThemeIni := TIniFile.Create('Themes\Singstar\Main.ini'); + + // Loading + ThemeLoadBasic(Loading, 'Loading'); + ThemeLoadText(Loading.TextLoading, 'LoadingTextLoading'); + ThemeLoadStatic(Loading.StaticAnimation, 'LoadingStaticAnimation'); + + // Main + ThemeLoadBasic(Main, 'Main'); + + ThemeLoadText(Main.TextDescription, 'MainTextDescription'); + ThemeLoadText(Main.TextDescriptionLong, 'MainTextDescriptionLong'); + ThemeLoadButton(Main.ButtonSolo, 'MainButtonSolo'); + ThemeLoadButton(Main.ButtonMulti, 'MainButtonMulti'); + ThemeLoadButton(Main.ButtonStat, 'MainButtonStats'); + ThemeLoadButton(Main.ButtonEditor, 'MainButtonEditor'); + ThemeLoadButton(Main.ButtonOptions, 'MainButtonOptions'); + ThemeLoadButton(Main.ButtonExit, 'MainButtonExit'); + + //Main Desc Text Translation Start + + Main.Description[0] := Language.Translate('SING_SING'); + Main.DescriptionLong[0] := Language.Translate('SING_SING_DESC'); + Main.Description[1] := Language.Translate('SING_MULTI'); + Main.DescriptionLong[1] := Language.Translate('SING_MULTI_DESC'); + Main.Description[2] := Language.Translate('SING_STATS'); + Main.DescriptionLong[2] := Language.Translate('SING_STATS_DESC'); + Main.Description[3] := Language.Translate('SING_EDITOR'); + Main.DescriptionLong[3] := Language.Translate('SING_EDITOR_DESC'); + Main.Description[4] := Language.Translate('SING_GAME_OPTIONS'); + Main.DescriptionLong[4] := Language.Translate('SING_GAME_OPTIONS_DESC'); + Main.Description[5] := Language.Translate('SING_EXIT'); + Main.DescriptionLong[5] := Language.Translate('SING_EXIT_DESC'); + + //Main Desc Text Translation End + + Main.TextDescription.Text := Main.Description[0]; + Main.TextDescriptionLong.Text := Main.DescriptionLong[0]; + + // Name + ThemeLoadBasic(Name, 'Name'); + + for I := 1 to 6 do + ThemeLoadButton(Name.ButtonPlayer[I], 'NameButtonPlayer'+IntToStr(I)); + + // Level + ThemeLoadBasic(Level, 'Level'); + + ThemeLoadButton(Level.ButtonEasy, 'LevelButtonEasy'); + ThemeLoadButton(Level.ButtonMedium, 'LevelButtonMedium'); + ThemeLoadButton(Level.ButtonHard, 'LevelButtonHard'); + + + // Song + ThemeLoadBasic(Song, 'Song'); + + ThemeLoadText(Song.TextArtist, 'SongTextArtist'); + ThemeLoadText(Song.TextTitle, 'SongTextTitle'); + ThemeLoadText(Song.TextNumber, 'SongTextNumber'); + + //Video Icon Mod + ThemeLoadStatic(Song.VideoIcon, 'SongVideoIcon'); + + //Show Cat in TopLeft Mod + ThemeLoadStatic(Song.StaticCat, 'SongStaticCat'); + ThemeLoadText(Song.TextCat, 'SongTextCat'); + + //Load Cover Pos and Size from Theme Mod + Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 300); + Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 190); + Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 300); + Song.Cover.H := ThemeIni.ReadInteger('SongCover', 'H', 200); + Song.Cover.Style := ThemeIni.ReadInteger('SongCover', 'Style', 4); + Song.Cover.Reflections := (ThemeIni.ReadInteger('SongCover', 'Reflections', 0) = 1); + //Load Cover Pos and Size from Theme Mod End + + //Load Equalizer Pos and Size from Theme Mod + Song.Equalizer.Visible := (ThemeIni.ReadInteger('SongEqualizer', 'Visible', 0) = 1); + Song.Equalizer.Direction := (ThemeIni.ReadInteger('SongEqualizer', 'Direction', 0) = 1); + Song.Equalizer.Alpha := ThemeIni.ReadInteger('SongEqualizer', 'Alpha', 1); + Song.Equalizer.Space := ThemeIni.ReadInteger('SongEqualizer', 'Space', 1); + Song.Equalizer.X := ThemeIni.ReadInteger('SongEqualizer', 'X', 0); + Song.Equalizer.Y := ThemeIni.ReadInteger('SongEqualizer', 'Y', 0); + Song.Equalizer.Z := ThemeIni.ReadInteger('SongEqualizer', 'Z', 1); + Song.Equalizer.W := ThemeIni.ReadInteger('SongEqualizer', 'PieceW', 8); + Song.Equalizer.H := ThemeIni.ReadInteger('SongEqualizer', 'PieceH', 8); + Song.Equalizer.Bands := ThemeIni.ReadInteger('SongEqualizer', 'Bands', 5); + Song.Equalizer.Length := ThemeIni.ReadInteger('SongEqualizer', 'Length', 12); + + //Color + I := ColorExists(ThemeIni.ReadString('SongEqualizer', 'Color', 'Black')); + if I >= 0 then begin + Song.Equalizer.ColR := Color[I].RGB.R; + Song.Equalizer.ColG := Color[I].RGB.G; + Song.Equalizer.ColB := Color[I].RGB.B; + end + else begin + Song.Equalizer.ColR := 0; + Song.Equalizer.ColG := 0; + Song.Equalizer.ColB := 0; + end; + //Load Equalizer Pos and Size from Theme Mod End + + //Party and Non Party specific Statics and Texts + ThemeLoadStatics (Song.StaticParty, 'SongStaticParty'); + ThemeLoadTexts (Song.TextParty, 'SongTextParty'); + + ThemeLoadStatics (Song.StaticNonParty, 'SongStaticNonParty'); + ThemeLoadTexts (Song.TextNonParty, 'SongTextNonParty'); + + //Party Mode + ThemeLoadStatic(Song.StaticTeam1Joker1, 'SongStaticTeam1Joker1'); + ThemeLoadStatic(Song.StaticTeam1Joker2, 'SongStaticTeam1Joker2'); + ThemeLoadStatic(Song.StaticTeam1Joker3, 'SongStaticTeam1Joker3'); + ThemeLoadStatic(Song.StaticTeam1Joker4, 'SongStaticTeam1Joker4'); + ThemeLoadStatic(Song.StaticTeam1Joker5, 'SongStaticTeam1Joker5'); + + ThemeLoadStatic(Song.StaticTeam2Joker1, 'SongStaticTeam2Joker1'); + ThemeLoadStatic(Song.StaticTeam2Joker2, 'SongStaticTeam2Joker2'); + ThemeLoadStatic(Song.StaticTeam2Joker3, 'SongStaticTeam2Joker3'); + ThemeLoadStatic(Song.StaticTeam2Joker4, 'SongStaticTeam2Joker4'); + ThemeLoadStatic(Song.StaticTeam2Joker5, 'SongStaticTeam2Joker5'); + + ThemeLoadStatic(Song.StaticTeam3Joker1, 'SongStaticTeam3Joker1'); + ThemeLoadStatic(Song.StaticTeam3Joker2, 'SongStaticTeam3Joker2'); + ThemeLoadStatic(Song.StaticTeam3Joker3, 'SongStaticTeam3Joker3'); + ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4'); + ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5'); + + + // Sing + ThemeLoadBasic(Sing, 'Sing'); + + //TimeBar mod + ThemeLoadStatic(Sing.StaticTimeProgress, 'SingTimeProgress'); + ThemeLoadText(Sing.TextTimeText, 'SingTimeText'); + //eoa TimeBar mod + + //moveable singbar mod + ThemeLoadStatic(Sing.StaticP1SingBar, 'SingP1SingBar'); + ThemeLoadStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar'); + ThemeLoadStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar'); + ThemeLoadStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar'); + ThemeLoadStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar'); + ThemeLoadStatic(Sing.StaticP3SingBar, 'SingP3SingBar'); + //eoa moveable singbar + + ThemeLoadStatic(Sing.StaticP1, 'SingP1Static'); + ThemeLoadText(Sing.TextP1, 'SingP1Text'); + ThemeLoadStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); + ThemeLoadText(Sing.TextP1Score, 'SingP1TextScore'); + //Added for ps3 skin + //This one is shown in 2/4P mode + //if it exists, otherwise the one Player equivaltents are used + if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then + begin + ThemeLoadStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic'); + ThemeLoadText(Sing.TextP1TwoP, 'SingP1TwoPText'); + ThemeLoadStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2'); + ThemeLoadText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore'); + end + else + begin + Sing.StaticP1TwoP := Sing.StaticP1; + Sing.TextP1TwoP := Sing.TextP1; + Sing.StaticP1TwoPScoreBG := Sing.StaticP1ScoreBG; + Sing.TextP1TwoPScore := Sing.TextP1Score; + end; + + //This one is shown in 3/6P mode + //if it exists, otherwise the one Player equivaltents are used + if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then + begin + ThemeLoadStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic'); + ThemeLoadText(Sing.TextP1ThreeP, 'SingP1ThreePText'); + ThemeLoadStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2'); + ThemeLoadText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore'); + end + else + begin + Sing.StaticP1ThreeP := Sing.StaticP1; + Sing.TextP1ThreeP := Sing.TextP1; + Sing.StaticP1ThreePScoreBG := Sing.StaticP1ScoreBG; + Sing.TextP1ThreePScore := Sing.TextP1Score; + end; + //eoa + ThemeLoadStatic(Sing.StaticP2R, 'SingP2RStatic'); + ThemeLoadText(Sing.TextP2R, 'SingP2RText'); + ThemeLoadStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); + ThemeLoadText(Sing.TextP2RScore, 'SingP2RTextScore'); + + ThemeLoadStatic(Sing.StaticP2M, 'SingP2MStatic'); + ThemeLoadText(Sing.TextP2M, 'SingP2MText'); + ThemeLoadStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); + ThemeLoadText(Sing.TextP2MScore, 'SingP2MTextScore'); + + ThemeLoadStatic(Sing.StaticP3R, 'SingP3RStatic'); + ThemeLoadText(Sing.TextP3R, 'SingP3RText'); + ThemeLoadStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); + ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore'); + + //Line Bonus Texts + Sing.LineBonusText[0] := Language.Translate('POPUP_AWFUL'); + Sing.LineBonusText[1] := Sing.LineBonusText[0]; + Sing.LineBonusText[2] := Language.Translate('POPUP_POOR'); + Sing.LineBonusText[3] := Language.Translate('POPUP_BAD'); + Sing.LineBonusText[4] := Language.Translate('POPUP_NOTBAD'); + Sing.LineBonusText[5] := Language.Translate('POPUP_GOOD'); + Sing.LineBonusText[6] := Language.Translate('POPUP_GREAT'); + Sing.LineBonusText[7] := Language.Translate('POPUP_AWESOME'); + Sing.LineBonusText[8] := Language.Translate('POPUP_PERFECT'); + + //PausePopup + ThemeLoadStatic(Sing.PausePopUp, 'PausePopUpStatic'); + + // Score + ThemeLoadBasic(Score, 'Score'); + + ThemeLoadText(Score.TextArtist, 'ScoreTextArtist'); + ThemeLoadText(Score.TextTitle, 'ScoreTextTitle'); + ThemeLoadText(Score.TextArtistTitle, 'ScoreTextArtistTitle'); + + for I := 1 to 6 do begin + ThemeLoadStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); + ThemeLoadTexts(Score.PlayerTexts[I], 'ScorePlayer' + IntToStr(I) + 'Text'); + + ThemeLoadText(Score.TextName[I], 'ScoreTextName' + IntToStr(I)); + ThemeLoadText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I)); + ThemeLoadText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I)); + ThemeLoadText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I)); + ThemeLoadText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I)); + ThemeLoadText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I)); + ThemeLoadText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I)); + ThemeLoadText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I)); + ThemeLoadText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I)); + ThemeLoadText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I)); + + ThemeLoadStatic(Score.StaticBoxLightest[I], 'ScoreStaticBoxLightest' + IntToStr(I)); + ThemeLoadStatic(Score.StaticBoxLight[I], 'ScoreStaticBoxLight' + IntToStr(I)); + ThemeLoadStatic(Score.StaticBoxDark[I], 'ScoreStaticBoxDark' + IntToStr(I)); + + ThemeLoadStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I)); + ThemeLoadStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I)); + ThemeLoadStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I)); + ThemeLoadStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I)); + + ThemeLoadStatic(Score.StaticRatings[I], 'ScoreStaticRatingPicture' + IntToStr(I)); + end; + + // Top5 + ThemeLoadBasic(Top5, 'Top5'); + + ThemeLoadText(Top5.TextLevel, 'Top5TextLevel'); + ThemeLoadText(Top5.TextArtistTitle, 'Top5TextArtistTitle'); + ThemeLoadStatics(Top5.StaticNumber, 'Top5StaticNumber'); + ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber'); + ThemeLoadTexts(Top5.TextName, 'Top5TextName'); + ThemeLoadTexts(Top5.TextScore, 'Top5TextScore'); + + // Options + ThemeLoadBasic(Options, 'Options'); + + ThemeLoadButton(Options.ButtonGame, 'OptionsButtonGame'); + ThemeLoadButton(Options.ButtonGraphics, 'OptionsButtonGraphics'); + ThemeLoadButton(Options.ButtonSound, 'OptionsButtonSound'); + ThemeLoadButton(Options.ButtonLyrics, 'OptionsButtonLyrics'); + ThemeLoadButton(Options.ButtonThemes, 'OptionsButtonThemes'); + ThemeLoadButton(Options.ButtonRecord, 'OptionsButtonRecord'); + ThemeLoadButton(Options.ButtonAdvanced, 'OptionsButtonAdvanced'); + ThemeLoadButton(Options.ButtonExit, 'OptionsButtonExit'); + + Options.Description[0] := Language.Translate('SING_OPTIONS_GAME_DESC'); + Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS_DESC'); + Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND_DESC'); + Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS_DESC'); + Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES_DESC'); + Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD_DESC'); + Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED_DESC'); + Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT'); + + ThemeLoadText(Options.TextDescription, 'OptionsTextDescription'); + Options.TextDescription.Text := Options.Description[0]; + + // Options Game + ThemeLoadBasic(OptionsGame, 'OptionsGame'); + + ThemeLoadSelectSlide(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers'); + ThemeLoadSelectSlide(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty'); + ThemeLoadSelectSlide(OptionsGame.SelectLanguage, 'OptionsGameSelectSlideLanguage'); + ThemeLoadSelectSlide(OptionsGame.SelectTabs, 'OptionsGameSelectTabs'); + ThemeLoadSelectSlide(OptionsGame.SelectSorting, 'OptionsGameSelectSlideSorting'); + ThemeLoadSelectSlide(OptionsGame.SelectDebug, 'OptionsGameSelectDebug'); + ThemeLoadButton(OptionsGame.ButtonExit, 'OptionsGameButtonExit'); + + // Options Graphics + ThemeLoadBasic(OptionsGraphics, 'OptionsGraphics'); + + ThemeLoadSelectSlide(OptionsGraphics.SelectFullscreen, 'OptionsGraphicsSelectFullscreen'); + ThemeLoadSelectSlide(OptionsGraphics.SelectResolution, 'OptionsGraphicsSelectSlideResolution'); + ThemeLoadSelectSlide(OptionsGraphics.SelectDepth, 'OptionsGraphicsSelectDepth'); + ThemeLoadSelectSlide(OptionsGraphics.SelectVisualizer, 'OptionsGraphicsSelectVisualizer'); + ThemeLoadSelectSlide(OptionsGraphics.SelectOscilloscope, 'OptionsGraphicsSelectOscilloscope'); + ThemeLoadSelectSlide(OptionsGraphics.SelectLineBonus, 'OptionsGraphicsSelectLineBonus'); + ThemeLoadSelectSlide(OptionsGraphics.SelectMovieSize, 'OptionsGraphicsSelectMovieSize'); + ThemeLoadButton(OptionsGraphics.ButtonExit, 'OptionsGraphicsButtonExit'); + + // Options Sound + ThemeLoadBasic(OptionsSound, 'OptionsSound'); + + ThemeLoadSelectSlide(OptionsSound.SelectBackgroundMusic, 'OptionsSoundSelectBackgroundMusic'); + ThemeLoadSelectSlide(OptionsSound.SelectMicBoost, 'OptionsSoundSelectMicBoost'); + ThemeLoadSelectSlide(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist'); + ThemeLoadSelectSlide(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick'); + ThemeLoadSelectSlide(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold'); + //Song Preview + ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume'); + ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading'); + ThemeLoadSelectSlide(OptionsSound.SelectSlideVoicePassthrough, 'OptionsSoundSelectVoicePassthrough'); + + ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); + + // Options Lyrics + ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); + + ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); + ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); + //ThemeLoadSelectSlide(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); + ThemeLoadSelectSlide(OptionsLyrics.SelectNoteLines, 'OptionsLyricsSelectNoteLines'); + ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit'); + + // Options Themes + ThemeLoadBasic(OptionsThemes, 'OptionsThemes'); + + ThemeLoadSelectSlide(OptionsThemes.SelectTheme, 'OptionsThemesSelectTheme'); + ThemeLoadSelectSlide(OptionsThemes.SelectSkin, 'OptionsThemesSelectSkin'); + ThemeLoadSelectSlide(OptionsThemes.SelectColor, 'OptionsThemesSelectColor'); + ThemeLoadButton(OptionsThemes.ButtonExit, 'OptionsThemesButtonExit'); + + // Options Record + ThemeLoadBasic(OptionsRecord, 'OptionsRecord'); + + ThemeLoadSelectSlide(OptionsRecord.SelectSlideCard, 'OptionsRecordSelectSlideCard'); + ThemeLoadSelectSlide(OptionsRecord.SelectSlideInput, 'OptionsRecordSelectSlideInput'); + ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannel, 'OptionsRecordSelectSlideChannel'); + ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit'); + + //Options Advanced + ThemeLoadBasic(OptionsAdvanced, 'OptionsAdvanced'); + + ThemeLoadSelectSlide(OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectPartyPopup, 'OptionsAdvancedSelectPartyPopup'); + ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit'); + + //error and check popup + ThemeLoadBasic (ErrorPopup, 'ErrorPopup'); + ThemeLoadButton(ErrorPopup.Button1, 'ErrorPopupButton1'); + ThemeLoadText (ErrorPopup.TextError,'ErrorPopupText'); + ThemeLoadBasic (CheckPopup, 'CheckPopup'); + ThemeLoadButton(CheckPopup.Button1, 'CheckPopupButton1'); + ThemeLoadButton(CheckPopup.Button2, 'CheckPopupButton2'); + ThemeLoadText(CheckPopup.TextCheck , 'CheckPopupText'); + + //Song Menu + ThemeLoadBasic (SongMenu, 'SongMenu'); + ThemeLoadButton(SongMenu.Button1, 'SongMenuButton1'); + ThemeLoadButton(SongMenu.Button2, 'SongMenuButton2'); + ThemeLoadButton(SongMenu.Button3, 'SongMenuButton3'); + ThemeLoadButton(SongMenu.Button4, 'SongMenuButton4'); + ThemeLoadSelectSlide(SongMenu.SelectSlide3, 'SongMenuSelectSlide3'); + + ThemeLoadText(SongMenu.TextMenu, 'SongMenuTextMenu'); + + //Song Jumpto + ThemeLoadBasic (SongJumpto, 'SongJumpto'); + ThemeLoadButton(SongJumpto.ButtonSearchText, 'SongJumptoButtonSearchText'); + ThemeLoadSelectSlide(SongJumpto.SelectSlideType, 'SongJumptoSelectSlideType'); + ThemeLoadText(SongJumpto.TextFound, 'SongJumptoTextFound'); + //Translations + SongJumpto.IType[0] := Language.Translate('SONG_JUMPTO_TYPE1'); + SongJumpto.IType[1] := Language.Translate('SONG_JUMPTO_TYPE2'); + SongJumpto.IType[2] := Language.Translate('SONG_JUMPTO_TYPE3'); + SongJumpto.SongsFound := Language.Translate('SONG_JUMPTO_SONGSFOUND'); + SongJumpto.NoSongsFound := Language.Translate('SONG_JUMPTO_NOSONGSFOUND'); + SongJumpto.CatText := Language.Translate('SONG_JUMPTO_CATTEXT'); + + //Party Screens: + //Party NewRound + ThemeLoadBasic(PartyNewRound, 'PartyNewRound'); + + ThemeLoadText (PartyNewRound.TextRound1, 'PartyNewRoundTextRound1'); + ThemeLoadText (PartyNewRound.TextRound2, 'PartyNewRoundTextRound2'); + ThemeLoadText (PartyNewRound.TextRound3, 'PartyNewRoundTextRound3'); + ThemeLoadText (PartyNewRound.TextRound4, 'PartyNewRoundTextRound4'); + ThemeLoadText (PartyNewRound.TextRound5, 'PartyNewRoundTextRound5'); + ThemeLoadText (PartyNewRound.TextRound6, 'PartyNewRoundTextRound6'); + ThemeLoadText (PartyNewRound.TextRound7, 'PartyNewRoundTextRound7'); + ThemeLoadText (PartyNewRound.TextWinner1, 'PartyNewRoundTextWinner1'); + ThemeLoadText (PartyNewRound.TextWinner2, 'PartyNewRoundTextWinner2'); + ThemeLoadText (PartyNewRound.TextWinner3, 'PartyNewRoundTextWinner3'); + ThemeLoadText (PartyNewRound.TextWinner4, 'PartyNewRoundTextWinner4'); + ThemeLoadText (PartyNewRound.TextWinner5, 'PartyNewRoundTextWinner5'); + ThemeLoadText (PartyNewRound.TextWinner6, 'PartyNewRoundTextWinner6'); + ThemeLoadText (PartyNewRound.TextWinner7, 'PartyNewRoundTextWinner7'); + ThemeLoadText (PartyNewRound.TextNextRound, 'PartyNewRoundTextNextRound'); + ThemeLoadText (PartyNewRound.TextNextRoundNo, 'PartyNewRoundTextNextRoundNo'); + ThemeLoadText (PartyNewRound.TextNextPlayer1, 'PartyNewRoundTextNextPlayer1'); + ThemeLoadText (PartyNewRound.TextNextPlayer2, 'PartyNewRoundTextNextPlayer2'); + ThemeLoadText (PartyNewRound.TextNextPlayer3, 'PartyNewRoundTextNextPlayer3'); + + ThemeLoadStatic (PartyNewRound.StaticRound1, 'PartyNewRoundStaticRound1'); + ThemeLoadStatic (PartyNewRound.StaticRound2, 'PartyNewRoundStaticRound2'); + ThemeLoadStatic (PartyNewRound.StaticRound3, 'PartyNewRoundStaticRound3'); + ThemeLoadStatic (PartyNewRound.StaticRound4, 'PartyNewRoundStaticRound4'); + ThemeLoadStatic (PartyNewRound.StaticRound5, 'PartyNewRoundStaticRound5'); + ThemeLoadStatic (PartyNewRound.StaticRound6, 'PartyNewRoundStaticRound6'); + ThemeLoadStatic (PartyNewRound.StaticRound7, 'PartyNewRoundStaticRound7'); + + ThemeLoadText (PartyNewRound.TextScoreTeam1, 'PartyNewRoundTextScoreTeam1'); + ThemeLoadText (PartyNewRound.TextScoreTeam2, 'PartyNewRoundTextScoreTeam2'); + ThemeLoadText (PartyNewRound.TextScoreTeam3, 'PartyNewRoundTextScoreTeam3'); + ThemeLoadText (PartyNewRound.TextNameTeam1, 'PartyNewRoundTextNameTeam1'); + ThemeLoadText (PartyNewRound.TextNameTeam2, 'PartyNewRoundTextNameTeam2'); + ThemeLoadText (PartyNewRound.TextNameTeam3, 'PartyNewRoundTextNameTeam3'); + + ThemeLoadText (PartyNewRound.TextTeam1Players, 'PartyNewRoundTextTeam1Players'); + ThemeLoadText (PartyNewRound.TextTeam2Players, 'PartyNewRoundTextTeam2Players'); + ThemeLoadText (PartyNewRound.TextTeam3Players, 'PartyNewRoundTextTeam3Players'); + + ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1'); + ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2'); + ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3'); + ThemeLoadStatic (PartyNewRound.StaticNextPlayer1, 'PartyNewRoundStaticNextPlayer1'); + ThemeLoadStatic (PartyNewRound.StaticNextPlayer2, 'PartyNewRoundStaticNextPlayer2'); + ThemeLoadStatic (PartyNewRound.StaticNextPlayer3, 'PartyNewRoundStaticNextPlayer3'); + + //Party Score + ThemeLoadBasic(PartyScore, 'PartyScore'); + + ThemeLoadText (PartyScore.TextScoreTeam1, 'PartyScoreTextScoreTeam1'); + ThemeLoadText (PartyScore.TextScoreTeam2, 'PartyScoreTextScoreTeam2'); + ThemeLoadText (PartyScore.TextScoreTeam3, 'PartyScoreTextScoreTeam3'); + ThemeLoadText (PartyScore.TextNameTeam1, 'PartyScoreTextNameTeam1'); + ThemeLoadText (PartyScore.TextNameTeam2, 'PartyScoreTextNameTeam2'); + ThemeLoadText (PartyScore.TextNameTeam3, 'PartyScoreTextNameTeam3'); + + ThemeLoadStatic (PartyScore.StaticTeam1, 'PartyScoreStaticTeam1'); + ThemeLoadStatic (PartyScore.StaticTeam1BG, 'PartyScoreStaticTeam1BG'); + ThemeLoadStatic (PartyScore.StaticTeam1Deco, 'PartyScoreStaticTeam1Deco'); + ThemeLoadStatic (PartyScore.StaticTeam2, 'PartyScoreStaticTeam2'); + ThemeLoadStatic (PartyScore.StaticTeam2BG, 'PartyScoreStaticTeam2BG'); + ThemeLoadStatic (PartyScore.StaticTeam2Deco, 'PartyScoreStaticTeam2Deco'); + ThemeLoadStatic (PartyScore.StaticTeam3, 'PartyScoreStaticTeam3'); + ThemeLoadStatic (PartyScore.StaticTeam3BG, 'PartyScoreStaticTeam3BG'); + ThemeLoadStatic (PartyScore.StaticTeam3Deco, 'PartyScoreStaticTeam3Deco'); + + //Load Party Score DecoTextures Object + PartyScore.DecoTextures.ChangeTextures := (ThemeIni.ReadInteger('PartyScoreDecoTextures', 'ChangeTextures', 0) = 1); + PartyScore.DecoTextures.FirstTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTexture', ''); + PartyScore.DecoTextures.FirstTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', ''), TEXTURE_TYPE_COLORIZED); + PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black'); + + PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', ''); + PartyScore.DecoTextures.SecondTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', ''), TEXTURE_TYPE_COLORIZED); + PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black'); + + PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', ''); + PartyScore.DecoTextures.ThirdTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', ''), TEXTURE_TYPE_COLORIZED); + PartyScore.DecoTextures.ThirdColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdColor', 'Black'); + + ThemeLoadText (PartyScore.TextWinner, 'PartyScoreTextWinner'); + + //Party Win + ThemeLoadBasic(PartyWin, 'PartyWin'); + + ThemeLoadText (PartyWin.TextScoreTeam1, 'PartyWinTextScoreTeam1'); + ThemeLoadText (PartyWin.TextScoreTeam2, 'PartyWinTextScoreTeam2'); + ThemeLoadText (PartyWin.TextScoreTeam3, 'PartyWinTextScoreTeam3'); + ThemeLoadText (PartyWin.TextNameTeam1, 'PartyWinTextNameTeam1'); + ThemeLoadText (PartyWin.TextNameTeam2, 'PartyWinTextNameTeam2'); + ThemeLoadText (PartyWin.TextNameTeam3, 'PartyWinTextNameTeam3'); + + ThemeLoadStatic (PartyWin.StaticTeam1, 'PartyWinStaticTeam1'); + ThemeLoadStatic (PartyWin.StaticTeam1BG, 'PartyWinStaticTeam1BG'); + ThemeLoadStatic (PartyWin.StaticTeam1Deco, 'PartyWinStaticTeam1Deco'); + ThemeLoadStatic (PartyWin.StaticTeam2, 'PartyWinStaticTeam2'); + ThemeLoadStatic (PartyWin.StaticTeam2BG, 'PartyWinStaticTeam2BG'); + ThemeLoadStatic (PartyWin.StaticTeam2Deco, 'PartyWinStaticTeam2Deco'); + ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3'); + ThemeLoadStatic (PartyWin.StaticTeam3BG, 'PartyWinStaticTeam3BG'); + ThemeLoadStatic (PartyWin.StaticTeam3Deco, 'PartyWinStaticTeam3Deco'); + + ThemeLoadText (PartyWin.TextWinner, 'PartyWinTextWinner'); + + //Party Options + ThemeLoadBasic(PartyOptions, 'PartyOptions'); + ThemeLoadSelectSlide(PartyOptions.SelectLevel, 'PartyOptionsSelectLevel'); + ThemeLoadSelectSlide(PartyOptions.SelectPlayList, 'PartyOptionsSelectPlayList'); + ThemeLoadSelectSlide(PartyOptions.SelectPlayList2, 'PartyOptionsSelectPlayList2'); + ThemeLoadSelectSlide(PartyOptions.SelectRounds, 'PartyOptionsSelectRounds'); + ThemeLoadSelectSlide(PartyOptions.SelectTeams, 'PartyOptionsSelectTeams'); + ThemeLoadSelectSlide(PartyOptions.SelectPlayers1, 'PartyOptionsSelectPlayers1'); + ThemeLoadSelectSlide(PartyOptions.SelectPlayers2, 'PartyOptionsSelectPlayers2'); + ThemeLoadSelectSlide(PartyOptions.SelectPlayers3, 'PartyOptionsSelectPlayers3'); + + {ThemeLoadButton (ButtonNext, 'ButtonNext'); + ThemeLoadButton (ButtonPrev, 'ButtonPrev');} + + //Party Player + ThemeLoadBasic(PartyPlayer, 'PartyPlayer'); + ThemeLoadButton(PartyPlayer.Team1Name, 'PartyPlayerTeam1Name'); + ThemeLoadButton(PartyPlayer.Player1Name, 'PartyPlayerPlayer1Name'); + ThemeLoadButton(PartyPlayer.Player2Name, 'PartyPlayerPlayer2Name'); + ThemeLoadButton(PartyPlayer.Player3Name, 'PartyPlayerPlayer3Name'); + ThemeLoadButton(PartyPlayer.Player4Name, 'PartyPlayerPlayer4Name'); + + ThemeLoadButton(PartyPlayer.Team2Name, 'PartyPlayerTeam2Name'); + ThemeLoadButton(PartyPlayer.Player5Name, 'PartyPlayerPlayer5Name'); + ThemeLoadButton(PartyPlayer.Player6Name, 'PartyPlayerPlayer6Name'); + ThemeLoadButton(PartyPlayer.Player7Name, 'PartyPlayerPlayer7Name'); + ThemeLoadButton(PartyPlayer.Player8Name, 'PartyPlayerPlayer8Name'); + + ThemeLoadButton(PartyPlayer.Team3Name, 'PartyPlayerTeam3Name'); + ThemeLoadButton(PartyPlayer.Player9Name, 'PartyPlayerPlayer9Name'); + ThemeLoadButton(PartyPlayer.Player10Name, 'PartyPlayerPlayer10Name'); + ThemeLoadButton(PartyPlayer.Player11Name, 'PartyPlayerPlayer11Name'); + ThemeLoadButton(PartyPlayer.Player12Name, 'PartyPlayerPlayer12Name'); + + {ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext'); + ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');} + + ThemeLoadBasic(StatMain, 'StatMain'); + + ThemeLoadButton(StatMain.ButtonScores, 'StatMainButtonScores'); + ThemeLoadButton(StatMain.ButtonSingers, 'StatMainButtonSingers'); + ThemeLoadButton(StatMain.ButtonSongs, 'StatMainButtonSongs'); + ThemeLoadButton(StatMain.ButtonBands, 'StatMainButtonBands'); + ThemeLoadButton(StatMain.ButtonExit, 'StatMainButtonExit'); + + ThemeLoadText (StatMain.TextOverview, 'StatMainTextOverview'); + + + ThemeLoadBasic(StatDetail, 'StatDetail'); + + ThemeLoadButton(StatDetail.ButtonNext, 'StatDetailButtonNext'); + ThemeLoadButton(StatDetail.ButtonPrev, 'StatDetailButtonPrev'); + ThemeLoadButton(StatDetail.ButtonReverse, 'StatDetailButtonReverse'); + ThemeLoadButton(StatDetail.ButtonExit, 'StatDetailButtonExit'); + + ThemeLoadText (StatDetail.TextDescription, 'StatDetailTextDescription'); + ThemeLoadText (StatDetail.TextPage, 'StatDetailTextPage'); + ThemeLoadTexts(StatDetail.TextList, 'StatDetailTextList'); + + //Translate Texts + StatDetail.Description[0] := Language.Translate('STAT_DESC_SCORES'); + StatDetail.Description[1] := Language.Translate('STAT_DESC_SINGERS'); + StatDetail.Description[2] := Language.Translate('STAT_DESC_SONGS'); + StatDetail.Description[3] := Language.Translate('STAT_DESC_BANDS'); + + StatDetail.DescriptionR[0] := Language.Translate('STAT_DESC_SCORES_REVERSED'); + StatDetail.DescriptionR[1] := Language.Translate('STAT_DESC_SINGERS_REVERSED'); + StatDetail.DescriptionR[2] := Language.Translate('STAT_DESC_SONGS_REVERSED'); + StatDetail.DescriptionR[3] := Language.Translate('STAT_DESC_BANDS_REVERSED'); + + StatDetail.FormatStr[0] := Language.Translate('STAT_FORMAT_SCORES'); + StatDetail.FormatStr[1] := Language.Translate('STAT_FORMAT_SINGERS'); + StatDetail.FormatStr[2] := Language.Translate('STAT_FORMAT_SONGS'); + StatDetail.FormatStr[3] := Language.Translate('STAT_FORMAT_BANDS'); + + StatDetail.PageStr := Language.Translate('STAT_PAGE'); + + //Playlist Translations + Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT'); + + //Level Translations + //Fill ILevel + ILevel[0] := Language.Translate('SING_EASY'); + ILevel[1] := Language.Translate('SING_MEDIUM'); + ILevel[2] := Language.Translate('SING_HARD'); + end; + + ThemeIni.Free; + end; +end; + +procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; Name: string); +begin + ThemeLoadBackground(Theme.Background, Name); + ThemeLoadTexts(Theme.Text, Name + 'Text'); + ThemeLoadStatics(Theme.Static, Name + 'Static'); + ThemeLoadButtonCollections(Theme.ButtonCollection, Name + 'ButtonCollection'); + + LastThemeBasic := Theme; +end; + +procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string); +begin + ThemeBackground.Tex := ThemeIni.ReadString(Name + 'Background', 'Tex', ''); +end; + +procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; Name: string); +var + C: integer; +begin + ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeText.W := ThemeIni.ReadInteger(Name, 'W', 0); + + ThemeText.Z := ThemeIni.ReadFloat(Name, 'Z', 0); + + ThemeText.ColR := ThemeIni.ReadFloat(Name, 'ColR', 0); + ThemeText.ColG := ThemeIni.ReadFloat(Name, 'ColG', 0); + ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0); + + ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0); + ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0); + ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0); + + ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + ThemeText.Color := ThemeIni.ReadString(Name, 'Color', ''); + + //Reflection + ThemeText.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0)) = 1; + ThemeText.Reflectionspacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); + + C := ColorExists(ThemeText.Color); + if C >= 0 then begin + ThemeText.ColR := Color[C].RGB.R; + ThemeText.ColG := Color[C].RGB.G; + ThemeText.ColB := Color[C].RGB.B; + end; +end; + +procedure TTheme.ThemeLoadTexts(var ThemeText: AThemeText; Name: string); +var + T: integer; +begin + T := 1; + while ThemeIni.SectionExists(Name + IntToStr(T)) do begin + SetLength(ThemeText, T); + ThemeLoadText(ThemeText[T-1], Name + IntToStr(T)); + Inc(T); + end; +end; + +procedure TTheme.ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string); +var + C: integer; +begin + ThemeStatic.Tex := ThemeIni.ReadString(Name, 'Tex', ''); + + ThemeStatic.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeStatic.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeStatic.Z := ThemeIni.ReadFloat (Name, 'Z', 0); + ThemeStatic.W := ThemeIni.ReadInteger(Name, 'W', 0); + ThemeStatic.H := ThemeIni.ReadInteger(Name, 'H', 0); + + ThemeStatic.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN); + ThemeStatic.Color := ThemeIni.ReadString(Name, 'Color', ''); + + C := ColorExists(ThemeStatic.Color); + if C >= 0 then begin + ThemeStatic.ColR := Color[C].RGB.R; + ThemeStatic.ColG := Color[C].RGB.G; + ThemeStatic.ColB := Color[C].RGB.B; + end; + + ThemeStatic.TexX1 := ThemeIni.ReadFloat(Name, 'TexX1', 0); + ThemeStatic.TexY1 := ThemeIni.ReadFloat(Name, 'TexY1', 0); + ThemeStatic.TexX2 := ThemeIni.ReadFloat(Name, 'TexX2', 1); + ThemeStatic.TexY2 := ThemeIni.ReadFloat(Name, 'TexY2', 1); + + //Reflection Mod + ThemeStatic.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); + ThemeStatic.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); +end; + +procedure TTheme.ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string); +var + S: integer; +begin + S := 1; + while ThemeIni.SectionExists(Name + IntToStr(S)) do begin + SetLength(ThemeStatic, S); + ThemeLoadStatic(ThemeStatic[S-1], Name + IntToStr(S)); + Inc(S); + end; +end; + +//Button Collection Mod +procedure TTheme.ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string); +var T: Integer; +begin + //Load Collection Style + ThemeLoadButton(Collection.Style, Name); + + //Load Other Attributes + T := ThemeIni.ReadInteger (Name, 'FirstChild', 0); + if (T > 0) And (T < 256) then + Collection.FirstChild := T + else + Collection.FirstChild := 0; +end; + +procedure TTheme.ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string); +var + I: integer; +begin + I := 1; + while ThemeIni.SectionExists(Name + IntToStr(I)) do begin + SetLength(Collections, I); + ThemeLoadButtonCollection(Collections[I-1], Name + IntToStr(I)); + Inc(I); + end; +end; +//End Button Collection Mod + +procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection); +var + C: integer; + TLen: integer; + T: integer; + Collections2: PAThemeButtonCollection; +begin + if not ThemeIni.SectionExists(Name) then + begin + ThemeButton.Visible := False; + exit; + end; + ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', ''); + ThemeButton.X := ThemeIni.ReadInteger (Name, 'X', 0); + ThemeButton.Y := ThemeIni.ReadInteger (Name, 'Y', 0); + ThemeButton.Z := ThemeIni.ReadFloat (Name, 'Z', 0); + ThemeButton.W := ThemeIni.ReadInteger (Name, 'W', 0); + ThemeButton.H := ThemeIni.ReadInteger (Name, 'H', 0); + ThemeButton.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN); + + //Reflection Mod + ThemeButton.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); + ThemeButton.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); + + ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1); + ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1); + ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1); + ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1); + ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1); + ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1); + ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1); + ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); + + ThemeButton.Color := ThemeIni.ReadString(Name, 'Color', ''); + C := ColorExists(ThemeButton.Color); + if C >= 0 then begin + ThemeButton.ColR := Color[C].RGB.R; + ThemeButton.ColG := Color[C].RGB.G; + ThemeButton.ColB := Color[C].RGB.B; + end; + + ThemeButton.DColor := ThemeIni.ReadString(Name, 'DColor', ''); + C := ColorExists(ThemeButton.DColor); + if C >= 0 then begin + ThemeButton.DColR := Color[C].RGB.R; + ThemeButton.DColG := Color[C].RGB.G; + ThemeButton.DColB := Color[C].RGB.B; + end; + + ThemeButton.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 1) = 1); + + //Fade Mod + ThemeButton.SelectH := ThemeIni.ReadInteger (Name, 'SelectH', ThemeButton.H); + ThemeButton.SelectW := ThemeIni.ReadInteger (Name, 'SelectW', ThemeButton.W); + + ThemeButton.DeSelectReflectionspacing := ThemeIni.ReadFloat(Name, 'DeSelectReflectionSpacing', ThemeButton.Reflectionspacing); + + ThemeButton.Fade := (ThemeIni.ReadInteger(Name, 'Fade', 0) = 1); + ThemeButton.FadeText := (ThemeIni.ReadInteger(Name, 'FadeText', 0) = 1); + + + ThemeButton.FadeTex := ThemeIni.ReadString(Name, 'FadeTex', ''); + ThemeButton.FadeTexPos:= ThemeIni.ReadInteger(Name, 'FadeTexPos', 0); + if (ThemeButton.FadeTexPos > 4) Or (ThemeButton.FadeTexPos < 0) then + ThemeButton.FadeTexPos := 0; + + //Button Collection Mod + T := ThemeIni.ReadInteger(Name, 'Parent', 0); + + //Set Collections to Last Basic Collections if no valid Value + if (Collections = nil) then + Collections2 := @LastThemeBasic.ButtonCollection + else + Collections2 := Collections; + //Test for valid Value + if (Collections2 <> nil) AND (T > 0) AND (T <= Length(Collections2^)) then + begin + Inc(Collections2^[T-1].ChildCount); + ThemeButton.Parent := T; + end + else + ThemeButton.Parent := 0; + + //Read ButtonTexts + TLen := ThemeIni.ReadInteger(Name, 'Texts', 0); + SetLength(ThemeButton.Text, TLen); + for T := 1 to TLen do + ThemeLoadText(ThemeButton.Text[T-1], Name + 'Text' + IntToStr(T)); +end; + +procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); +var + C: integer; +begin + ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + + ThemeSelectS.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', ''); + ThemeSelectS.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', ''); + + ThemeSelectS.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeSelectS.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeSelectS.W := ThemeIni.ReadInteger(Name, 'W', 0); + ThemeSelectS.H := ThemeIni.ReadInteger(Name, 'H', 0); + + ThemeSelectS.Z := ThemeIni.ReadFloat(Name, 'Z', 0); + + ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 10); + + ThemeSelectS.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); + + ThemeSelectS.SBGW := ThemeIni.ReadInteger(Name, 'SBGW', 450); + + LoadColor(ThemeSelectS.ColR, ThemeSelectS.ColG, ThemeSelectS.ColB, ThemeIni.ReadString(Name, 'Color', '')); + ThemeSelectS.Int := ThemeIni.ReadFloat(Name, 'Int', 1); + LoadColor(ThemeSelectS.DColR, ThemeSelectS.DColG, ThemeSelectS.DColB, ThemeIni.ReadString(Name, 'DColor', '')); + ThemeSelectS.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); + + LoadColor(ThemeSelectS.TColR, ThemeSelectS.TColG, ThemeSelectS.TColB, ThemeIni.ReadString(Name, 'TColor', '')); + ThemeSelectS.TInt := ThemeIni.ReadFloat(Name, 'TInt', 1); + LoadColor(ThemeSelectS.TDColR, ThemeSelectS.TDColG, ThemeSelectS.TDColB, ThemeIni.ReadString(Name, 'TDColor', '')); + ThemeSelectS.TDInt := ThemeIni.ReadFloat(Name, 'TDInt', 1); + + LoadColor(ThemeSelectS.SBGColR, ThemeSelectS.SBGColG, ThemeSelectS.SBGColB, ThemeIni.ReadString(Name, 'SBGColor', '')); + ThemeSelectS.SBGInt := ThemeIni.ReadFloat(Name, 'SBGInt', 1); + LoadColor(ThemeSelectS.SBGDColR, ThemeSelectS.SBGDColG, ThemeSelectS.SBGDColB, ThemeIni.ReadString(Name, 'SBGDColor', '')); + ThemeSelectS.SBGDInt := ThemeIni.ReadFloat(Name, 'SBGDInt', 1); + + LoadColor(ThemeSelectS.STColR, ThemeSelectS.STColG, ThemeSelectS.STColB, ThemeIni.ReadString(Name, 'STColor', '')); + ThemeSelectS.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1); + LoadColor(ThemeSelectS.STDColR, ThemeSelectS.STDColG, ThemeSelectS.STDColB, ThemeIni.ReadString(Name, 'STDColor', '')); + ThemeSelectS.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1); +end; + +procedure TTheme.LoadColors; +var + SL: TStringList; + C: integer; + S: string; + Col: integer; + RGB: TRGB; +begin + SL := TStringList.Create; + ThemeIni.ReadSection('Colors', SL); + + // normal colors + SetLength(Color, SL.Count); + for C := 0 to SL.Count-1 do begin + Color[C].Name := SL.Strings[C]; + + S := ThemeIni.ReadString('Colors', SL.Strings[C], ''); + + Color[C].RGB.R := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255; + Delete(S, 1, Pos(' ', S)); + + Color[C].RGB.G := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255; + Delete(S, 1, Pos(' ', S)); + + Color[C].RGB.B := StrToInt(S)/255; + end; + + // skin color + SetLength(Color, SL.Count + 3); + C := SL.Count; + Color[C].Name := 'ColorDark'; + Color[C].RGB := GetSystemColor(Skin.Color); //Ini.Color); + + C := C+1; + Color[C].Name := 'ColorLight'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'ColorLightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // players colors + SetLength(Color, Length(Color)+18); + + // P1 + C := C+1; + Color[C].Name := 'P1Dark'; + Color[C].RGB := GetSystemColor(0); // 0 - blue + + C := C+1; + Color[C].Name := 'P1Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P1Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // P2 + C := C+1; + Color[C].Name := 'P2Dark'; + Color[C].RGB := GetSystemColor(3); // 3 - red + + C := C+1; + Color[C].Name := 'P2Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P2Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // P3 + C := C+1; + Color[C].Name := 'P3Dark'; + Color[C].RGB := GetSystemColor(1); // 1 - green + + C := C+1; + Color[C].Name := 'P3Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P3Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // P4 + C := C+1; + Color[C].Name := 'P4Dark'; + Color[C].RGB := GetSystemColor(4); // 4 - brown + + C := C+1; + Color[C].Name := 'P4Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P4Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // P5 + C := C+1; + Color[C].Name := 'P5Dark'; + Color[C].RGB := GetSystemColor(5); // 5 - yellow + + C := C+1; + Color[C].Name := 'P5Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P5Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // P6 + C := C+1; + Color[C].Name := 'P6Dark'; + Color[C].RGB := GetSystemColor(6); // 6 - violet + + C := C+1; + Color[C].Name := 'P6Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P6Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + + SL.Free; +end; + +function ColorExists(Name: string): integer; +var + C: integer; +begin + Result := -1; + for C := 0 to High(Color) do + if Color[C].Name = Name then Result := C; +end; + +procedure LoadColor(var R, G, B: real; ColorName: string); +var + C: integer; +begin + C := ColorExists(ColorName); + if C >= 0 then begin + R := Color[C].RGB.R; + G := Color[C].RGB.G; + B := Color[C].RGB.B; + end; +end; + +function GetSystemColor(Color: integer): TRGB; +begin + case Color of + 0: begin + // blue + Result.R := 71/255; + Result.G := 175/255; + Result.B := 247/255; + end; + 1: begin + // green + Result.R := 63/255; + Result.G := 191/255; + Result.B := 63/255; + end; + 2: begin + // pink + Result.R := 255/255; +{ Result.G := 63/255; + Result.B := 192/255;} + Result.G := 175/255; + Result.B := 247/255; + end; + 3: begin + // red + Result.R := 247/255; + Result.G := 71/255; + Result.B := 71/255; + end; + //'Violet', 'Orange', 'Yellow', 'Brown', 'Black' + //New Theme-Color Patch + 4: begin + // violet + Result.R := 230/255; + Result.G := 63/255; + Result.B := 230/255; + end; + 5: begin + // orange + Result.R := 255/255; + Result.G := 144/255; + Result.B := 0; + end; + 6: begin + // yellow + Result.R := 230/255; + Result.G := 230/255; + Result.B := 95/255; + end; + 7: begin + // brown + Result.R := 192/255; + Result.G := 127/255; + Result.B := 31/255; + end; + 8: begin + // black + Result.R := 0; + Result.G := 0; + Result.B := 0; + end; + //New Theme-Color Patch End + + end; +end; + +function ColorSqrt(RGB: TRGB): TRGB; +begin + Result.R := sqrt(RGB.R); + Result.G := sqrt(RGB.G); + Result.B := sqrt(RGB.B); +end; + +procedure TTheme.ThemeSave(FileName: string); +var + I: integer; +begin + {$IFDEF THEMESAVE} + ThemeIni := TIniFile.Create(FileName); + {$ELSE} + ThemeIni := TMemIniFile.Create(FileName); + {$ENDIF} + + ThemeSaveBasic(Loading, 'Loading'); + + ThemeSaveBasic(Main, 'Main'); + ThemeSaveText(Main.TextDescription, 'MainTextDescription'); + ThemeSaveText(Main.TextDescriptionLong, 'MainTextDescriptionLong'); + ThemeSaveButton(Main.ButtonSolo, 'MainButtonSolo'); + ThemeSaveButton(Main.ButtonEditor, 'MainButtonEditor'); + ThemeSaveButton(Main.ButtonOptions, 'MainButtonOptions'); + ThemeSaveButton(Main.ButtonExit, 'MainButtonExit'); + + ThemeSaveBasic(Name, 'Name'); + for I := 1 to 6 do + ThemeSaveButton(Name.ButtonPlayer[I], 'NameButtonPlayer' + IntToStr(I)); + + ThemeSaveBasic(Level, 'Level'); + ThemeSaveButton(Level.ButtonEasy, 'LevelButtonEasy'); + ThemeSaveButton(Level.ButtonMedium, 'LevelButtonMedium'); + ThemeSaveButton(Level.ButtonHard, 'LevelButtonHard'); + + ThemeSaveBasic(Song, 'Song'); + ThemeSaveText(Song.TextArtist, 'SongTextArtist'); + ThemeSaveText(Song.TextTitle, 'SongTextTitle'); + ThemeSaveText(Song.TextNumber, 'SongTextNumber'); + + //Show CAt in Top Left Mod + ThemeSaveText(Song.TextCat, 'SongTextCat'); + ThemeSaveStatic(Song.StaticCat, 'SongStaticCat'); + + ThemeSaveBasic(Sing, 'Sing'); + + //TimeBar mod + ThemeSaveStatic(Sing.StaticTimeProgress, 'SingTimeProgress'); + ThemeSaveText(Sing.TextTimeText, 'SingTimeText'); + //eoa TimeBar mod + + ThemeSaveStatic(Sing.StaticP1, 'SingP1Static'); + ThemeSaveText(Sing.TextP1, 'SingP1Text'); + ThemeSaveStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); + ThemeSaveText(Sing.TextP1Score, 'SingP1TextScore'); + + //moveable singbar mod + ThemeSaveStatic(Sing.StaticP1SingBar, 'SingP1SingBar'); + ThemeSaveStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar'); + ThemeSaveStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar'); + ThemeSaveStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar'); + ThemeSaveStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar'); + ThemeSaveStatic(Sing.StaticP3SingBar, 'SingP3SingBar'); + //eoa moveable singbar + + //Added for ps3 skin + //This one is shown in 2/4P mode + ThemeSaveStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic'); + ThemeSaveText(Sing.TextP1TwoP, 'SingP1TwoPText'); + ThemeSaveStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2'); + ThemeSaveText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore'); + + //This one is shown in 3/6P mode + ThemeSaveStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic'); + ThemeSaveText(Sing.TextP1ThreeP, 'SingP1ThreePText'); + ThemeSaveStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2'); + ThemeSaveText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore'); + //eoa + + ThemeSaveStatic(Sing.StaticP2R, 'SingP2RStatic'); + ThemeSaveText(Sing.TextP2R, 'SingP2RText'); + ThemeSaveStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); + ThemeSaveText(Sing.TextP2RScore, 'SingP2RTextScore'); + + ThemeSaveStatic(Sing.StaticP2M, 'SingP2MStatic'); + ThemeSaveText(Sing.TextP2M, 'SingP2MText'); + ThemeSaveStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); + ThemeSaveText(Sing.TextP2MScore, 'SingP2MTextScore'); + + ThemeSaveStatic(Sing.StaticP3R, 'SingP3RStatic'); + ThemeSaveText(Sing.TextP3R, 'SingP3RText'); + ThemeSaveStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); + ThemeSaveText(Sing.TextP3RScore, 'SingP3RTextScore'); + + ThemeSaveBasic(Score, 'Score'); + ThemeSaveText(Score.TextArtist, 'ScoreTextArtist'); + ThemeSaveText(Score.TextTitle, 'ScoreTextTitle'); + + for I := 1 to 6 do begin + ThemeSaveStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); + + ThemeSaveText(Score.TextName[I], 'ScoreTextName' + IntToStr(I)); + ThemeSaveText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I)); + ThemeSaveText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I)); + ThemeSaveText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I)); + ThemeSaveText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I)); + ThemeSaveText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I)); + ThemeSaveText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I)); + ThemeSaveText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I)); + ThemeSaveText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I)); + ThemeSaveText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I)); + + ThemeSaveStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I)); + ThemeSaveStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I)); + ThemeSaveStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I)); + ThemeSaveStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I)); + end; + + ThemeSaveBasic(Top5, 'Top5'); + ThemeSaveText(Top5.TextLevel, 'Top5TextLevel'); + ThemeSaveText(Top5.TextArtistTitle, 'Top5TextArtistTitle'); + ThemeSaveStatics(Top5.StaticNumber, 'Top5StaticNumber'); + ThemeSaveTexts(Top5.TextNumber, 'Top5TextNumber'); + ThemeSaveTexts(Top5.TextName, 'Top5TextName'); + ThemeSaveTexts(Top5.TextScore, 'Top5TextScore'); + + + ThemeIni.Free; +end; + +procedure TTheme.ThemeSaveBasic(Theme: TThemeBasic; Name: string); +begin + ThemeIni.WriteInteger(Name, 'Texts', Length(Theme.Text)); + + ThemeSaveBackground(Theme.Background, Name + 'Background'); + ThemeSaveStatics(Theme.Static, Name + 'Static'); + ThemeSaveTexts(Theme.Text, Name + 'Text'); +end; + +procedure TTheme.ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string); +begin + if ThemeBackground.Tex <> '' then + ThemeIni.WriteString(Name, 'Tex', ThemeBackground.Tex) + else begin + ThemeIni.EraseSection(Name); + end; +end; + +procedure TTheme.ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string); +begin + ThemeIni.WriteInteger(Name, 'X', ThemeStatic.X); + ThemeIni.WriteInteger(Name, 'Y', ThemeStatic.Y); + ThemeIni.WriteInteger(Name, 'W', ThemeStatic.W); + ThemeIni.WriteInteger(Name, 'H', ThemeStatic.H); + + ThemeIni.WriteString(Name, 'Tex', ThemeStatic.Tex); + ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeStatic.Typ)); + ThemeIni.WriteString(Name, 'Color', ThemeStatic.Color); + + ThemeIni.WriteFloat(Name, 'TexX1', ThemeStatic.TexX1); + ThemeIni.WriteFloat(Name, 'TexY1', ThemeStatic.TexY1); + ThemeIni.WriteFloat(Name, 'TexX2', ThemeStatic.TexX2); + ThemeIni.WriteFloat(Name, 'TexY2', ThemeStatic.TexY2); +end; + +procedure TTheme.ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string); +var + S: integer; +begin + for S := 0 to Length(ThemeStatic)-1 do + ThemeSaveStatic(ThemeStatic[S], Name + {'Static' +} IntToStr(S+1)); + + ThemeIni.EraseSection(Name + {'Static' + }IntToStr(S+1)); +end; + +procedure TTheme.ThemeSaveText(ThemeText: TThemeText; Name: string); +begin + ThemeIni.WriteInteger(Name, 'X', ThemeText.X); + ThemeIni.WriteInteger(Name, 'Y', ThemeText.Y); + + ThemeIni.WriteInteger(Name, 'Font', ThemeText.Font); + ThemeIni.WriteInteger(Name, 'Size', ThemeText.Size); + ThemeIni.WriteInteger(Name, 'Align', ThemeText.Align); + + ThemeIni.WriteString(Name, 'Text', ThemeText.Text); + ThemeIni.WriteString(Name, 'Color', ThemeText.Color); + + ThemeIni.WriteBool(Name, 'Reflection', ThemeText.Reflection); + ThemeIni.WriteFloat(Name, 'ReflectionSpacing', ThemeText.ReflectionSpacing); +end; + +procedure TTheme.ThemeSaveTexts(ThemeText: AThemeText; Name: string); +var + T: integer; +begin + for T := 0 to Length(ThemeText)-1 do + ThemeSaveText(ThemeText[T], Name + {'Text' + }IntToStr(T+1)); + + ThemeIni.EraseSection(Name + {'Text' + }IntToStr(T+1)); +end; + +procedure TTheme.ThemeSaveButton(ThemeButton: TThemeButton; Name: string); +var + T: integer; +begin + ThemeIni.WriteString(Name, 'Tex', ThemeButton.Tex); + ThemeIni.WriteInteger(Name, 'X', ThemeButton.X); + ThemeIni.WriteInteger(Name, 'Y', ThemeButton.Y); + ThemeIni.WriteInteger(Name, 'W', ThemeButton.W); + ThemeIni.WriteInteger(Name, 'H', ThemeButton.H); + ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeButton.Typ)); + ThemeIni.WriteInteger(Name, 'Texts', Length(ThemeButton.Text)); + + ThemeIni.WriteString(Name, 'Color', ThemeButton.Color); + +{ ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1); + ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1); + ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1); + ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1); + ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1); + ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1); + ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1); + ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);} + +{ C := ColorExists(ThemeIni.ReadString(Name, 'Color', '')); + if C >= 0 then begin + ThemeButton.ColR := Color[C].RGB.R; + ThemeButton.ColG := Color[C].RGB.G; + ThemeButton.ColB := Color[C].RGB.B; + end; + + C := ColorExists(ThemeIni.ReadString(Name, 'DColor', '')); + if C >= 0 then begin + ThemeButton.DColR := Color[C].RGB.R; + ThemeButton.DColG := Color[C].RGB.G; + ThemeButton.DColB := Color[C].RGB.B; + end;} + + for T := 0 to High(ThemeButton.Text) do + ThemeSaveText(ThemeButton.Text[T], Name + 'Text' + IntToStr(T+1)); +end; + +procedure TTheme.create_theme_objects(); +begin + freeandnil( Loading ); + Loading := TThemeLoading.Create; + + freeandnil( Main ); + Main := TThemeMain.Create; + + freeandnil( Name ); + Name := TThemeName.Create; + + freeandnil( Level ); + Level := TThemeLevel.Create; + + freeandnil( Song ); + Song := TThemeSong.Create; + + freeandnil( Sing ); + Sing := TThemeSing.Create; + + freeandnil( Score ); + Score := TThemeScore.Create; + + freeandnil( Top5 ); + Top5 := TThemeTop5.Create; + + freeandnil( Options ); + Options := TThemeOptions.Create; + + freeandnil( OptionsGame ); + OptionsGame := TThemeOptionsGame.Create; + + freeandnil( OptionsGraphics ); + OptionsGraphics := TThemeOptionsGraphics.Create; + + freeandnil( OptionsSound ); + OptionsSound := TThemeOptionsSound.Create; + + freeandnil( OptionsLyrics ); + OptionsLyrics := TThemeOptionsLyrics.Create; + + freeandnil( OptionsThemes ); + OptionsThemes := TThemeOptionsThemes.Create; + + freeandnil( OptionsRecord ); + OptionsRecord := TThemeOptionsRecord.Create; + + freeandnil( OptionsAdvanced ); + OptionsAdvanced := TThemeOptionsAdvanced.Create; + + + freeandnil( ErrorPopup ); + ErrorPopup := TThemeError.Create; + + freeandnil( CheckPopup ); + CheckPopup := TThemeCheck.Create; + + + freeandnil( SongMenu ); + SongMenu := TThemeSongMenu.Create; + + freeandnil( SongJumpto ); + SongJumpto := TThemeSongJumpto.Create; + + //Party Screens + freeandnil( PartyNewRound ); + PartyNewRound := TThemePartyNewRound.Create; + + freeandnil( PartyWin ); + PartyWin := TThemePartyWin.Create; + + freeandnil( PartyScore ); + PartyScore := TThemePartyScore.Create; + + freeandnil( PartyOptions ); + PartyOptions := TThemePartyOptions.Create; + + freeandnil( PartyPlayer ); + PartyPlayer := TThemePartyPlayer.Create; + + + //Stats Screens: + freeandnil( StatMain ); + StatMain := TThemeStatMain.Create; + + freeandnil( StatDetail ); + StatDetail := TThemeStatDetail.Create; + + end; + +end. diff --git a/src/classes0/UTime.pas b/src/classes0/UTime.pas new file mode 100644 index 00000000..f8ae91c4 --- /dev/null +++ b/src/classes0/UTime.pas @@ -0,0 +1,185 @@ +unit UTime; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +type + TTime = class + public + constructor Create; + function GetTime(): real; + end; + + TRelativeTimer = class + private + AbsoluteTime: int64; // system-clock reference time for calculation of CurrentTime + RelativeTimeOffset: real; + Paused: boolean; + TriggerMode: boolean; + public + constructor Create(TriggerMode: boolean = false); + procedure Pause(); + procedure Resume(); + function GetTime(): real; + function GetAndResetTime(): real; + procedure SetTime(Time: real; Trigger: boolean = true); + procedure Reset(); + end; + +procedure CountSkipTimeSet; +procedure CountSkipTime; +procedure CountMidTime; + +var + USTime : TTime; + VideoBGTimer: TRelativeTimer; + + TimeNew : int64; + TimeOld : int64; + TimeSkip : real; + TimeMid : real; + TimeMidTemp : int64; + +implementation + +uses + sdl, + ucommon; + +const + cSDLCorrectionRatio = 1000; + +(* +BEST Option now ( after discussion with whiteshark ) seems to be to use SDL +timer functions... + +SDL_delay +SDL_GetTicks +http://www.gamedev.net/community/forums/topic.asp?topic_id=466145&whichpage=1%EE%8D%B7 +*) + + +procedure CountSkipTimeSet; +begin + TimeNew := SDL_GetTicks(); +end; + +procedure CountSkipTime; +begin + TimeOld := TimeNew; + TimeNew := SDL_GetTicks(); + TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio; +end; + +procedure CountMidTime; +begin + TimeMidTemp := SDL_GetTicks(); + TimeMid := (TimeMidTemp - TimeNew) / cSDLCorrectionRatio; +end; + +{** + * TTime + **} + +constructor TTime.Create; +begin + inherited; + CountSkipTimeSet; +end; + +function TTime.GetTime: real; +begin + Result := SDL_GetTicks() / cSDLCorrectionRatio; +end; + +{** + * TRelativeTimer + **} + +(* + * Creates a new timer. + * If TriggerMode is false (default), the timer + * will immediately begin with counting. + * If TriggerMode is true, it will wait until Get/SetTime() or Pause() is called + * for the first time. + *) +constructor TRelativeTimer.Create(TriggerMode: boolean); +begin + inherited Create(); + Self.TriggerMode := TriggerMode; + Reset(); + Paused := false; +end; + +procedure TRelativeTimer.Pause(); +begin + RelativeTimeOffset := GetTime(); + Paused := true; +end; + +procedure TRelativeTimer.Resume(); +begin + AbsoluteTime := SDL_GetTicks(); + Paused := false; +end; + +(* + * Returns the counter of the timer. + * If in TriggerMode it will return 0 and start the counter on the first call. + *) +function TRelativeTimer.GetTime: real; +begin + // initialize absolute time on first call in triggered mode + if (TriggerMode and (AbsoluteTime = 0)) then + begin + AbsoluteTime := SDL_GetTicks(); + Result := RelativeTimeOffset; + Exit; + end; + + if Paused then + Result := RelativeTimeOffset + else + Result := RelativeTimeOffset + (SDL_GetTicks() - AbsoluteTime) / cSDLCorrectionRatio; +end; + +(* + * Returns the counter of the timer and resets the counter to 0 afterwards. + * Note: In TriggerMode the counter will not be stopped as with Reset(). + *) +function TRelativeTimer.GetAndResetTime(): real; +begin + Result := GetTime(); + SetTime(0); +end; + +(* + * Sets the timer to the given time. This will trigger in TriggerMode if + * Trigger is set to true. Otherwise the counter's state will not change. + *) +procedure TRelativeTimer.SetTime(Time: real; Trigger: boolean); +begin + RelativeTimeOffset := Time; + if ((not TriggerMode) or Trigger) then + AbsoluteTime := SDL_GetTicks(); +end; + +(* + * Resets the counter of the timer to 0. + * If in TriggerMode the timer will not start counting until it is triggered again. + *) +procedure TRelativeTimer.Reset(); +begin + RelativeTimeOffset := 0; + if (TriggerMode) then + AbsoluteTime := 0 + else + AbsoluteTime := SDL_GetTicks(); +end; + +end. diff --git a/src/classes0/UVideo.pas b/src/classes0/UVideo.pas new file mode 100644 index 00000000..0ab1d350 --- /dev/null +++ b/src/classes0/UVideo.pas @@ -0,0 +1,828 @@ +{############################################################################## + # FFmpeg support for UltraStar deluxe # + # # + # Created by b1indy # + # based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # + # with modifications by Jay Binks # + # # + # http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html # + # http://www.nabble.com/file/p11795857/mpegpas01.zip # + # # + ##############################################################################} + +unit UVideo; + +// uncomment if you want to see the debug stuff +{.$define DebugDisplay} +{.$define DebugFrames} +{.$define VideoBenchmark} +{.$define Info} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +// use BGR-format for accelerated colorspace conversion with swscale +{$IFDEF UseSWScale} + {$DEFINE PIXEL_FMT_BGR} +{$ENDIF} + +implementation + +uses + SDL, + textgl, + avcodec, + avformat, + avutil, + avio, + rational, + {$IFDEF UseSWScale} + swscale, + {$ENDIF} + UMediaCore_FFmpeg, + math, + gl, + glext, + SysUtils, + UCommon, + UConfig, + ULog, + UMusic, + UGraphicClasses, + UGraphic; + +const +{$IFDEF PIXEL_FMT_BGR} + PIXEL_FMT_OPENGL = GL_BGR; + PIXEL_FMT_FFMPEG = PIX_FMT_BGR24; +{$ELSE} + PIXEL_FMT_OPENGL = GL_RGB; + PIXEL_FMT_FFMPEG = PIX_FMT_RGB24; +{$ENDIF} + +type + TVideoPlayback_FFmpeg = class( TInterfacedObject, IVideoPlayback ) + private + fVideoOpened, + fVideoPaused: Boolean; + + VideoStream: PAVStream; + VideoStreamIndex : Integer; + VideoFormatContext: PAVFormatContext; + VideoCodecContext: PAVCodecContext; + VideoCodec: PAVCodec; + + AVFrame: PAVFrame; + AVFrameRGB: PAVFrame; + FrameBuffer: PByte; + + {$IFDEF UseSWScale} + SoftwareScaleContext: PSwsContext; + {$ENDIF} + + fVideoTex: GLuint; + TexWidth, TexHeight: Cardinal; + + VideoAspect: Real; + VideoTimeBase, VideoTime: Extended; + fLoopTime: Extended; + + EOF: boolean; + Loop: boolean; + + Initialized: boolean; + + procedure Reset(); + function DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; + procedure SynchronizeVideo(Frame: PAVFrame; var pts: double); + public + function GetName: String; + + function Init(): boolean; + function Finalize: boolean; + + function Open(const aFileName : string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure SetPosition(Time: real); + function GetPosition: real; + + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); + end; + +var + FFmpegCore: TMediaCore_FFmpeg; + + +// These are called whenever we allocate a frame buffer. +// We use this to store the global_pts in a frame at the time it is allocated. +function PtsGetBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame): integer; cdecl; +var + pts: Pint64; + VideoPktPts: Pint64; +begin + Result := avcodec_default_get_buffer(CodecCtx, Frame); + VideoPktPts := CodecCtx^.opaque; + if (VideoPktPts <> nil) then + begin + // Note: we must copy the pts instead of passing a pointer, because the packet + // (and with it the pts) might change before a frame is returned by av_decode_video. + pts := av_malloc(sizeof(int64)); + pts^ := VideoPktPts^; + Frame^.opaque := pts; + end; +end; + +procedure PtsReleaseBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame); cdecl; +begin + if (Frame <> nil) then + av_freep(@Frame^.opaque); + avcodec_default_release_buffer(CodecCtx, Frame); +end; + + +{*------------------------------------------------------------------------------ + * TVideoPlayback_ffmpeg + *------------------------------------------------------------------------------} + +function TVideoPlayback_FFmpeg.GetName: String; +begin + result := 'FFmpeg_Video'; +end; + +function TVideoPlayback_FFmpeg.Init(): boolean; +begin + Result := true; + + if (Initialized) then + Exit; + Initialized := true; + + FFmpegCore := TMediaCore_FFmpeg.GetInstance(); + + Reset(); + av_register_all(); + glGenTextures(1, PGLuint(@fVideoTex)); +end; + +function TVideoPlayback_FFmpeg.Finalize(): boolean; +begin + Close(); + glDeleteTextures(1, PGLuint(@fVideoTex)); + Result := true; +end; + +procedure TVideoPlayback_FFmpeg.Reset(); +begin + // close previously opened video + Close(); + + fVideoOpened := False; + fVideoPaused := False; + VideoTimeBase := 0; + VideoTime := 0; + VideoStream := nil; + VideoStreamIndex := -1; + + EOF := false; + + // TODO: do we really want this by default? + Loop := true; + fLoopTime := 0; +end; + +function TVideoPlayback_FFmpeg.Open(const aFileName : string): boolean; // true if succeed +var + errnum: Integer; + AudioStreamIndex: integer; +begin + Result := false; + + Reset(); + + errnum := av_open_input_file(VideoFormatContext, PChar(aFileName), nil, 0, nil); + if (errnum <> 0) then + begin + Log.LogError('Failed to open file "'+aFileName+'" ('+FFmpegCore.GetErrorString(errnum)+')'); + Exit; + end; + + // update video info + if (av_find_stream_info(VideoFormatContext) < 0) then + begin + Log.LogError('No stream info found', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + Log.LogInfo('VideoStreamIndex : ' + inttostr(VideoStreamIndex), 'TVideoPlayback_ffmpeg.Open'); + + // find video stream + FFmpegCore.FindStreamIDs(VideoFormatContext, VideoStreamIndex, AudioStreamIndex); + if (VideoStreamIndex < 0) then + begin + Log.LogError('No video stream found', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + + VideoStream := VideoFormatContext^.streams[VideoStreamIndex]; + VideoCodecContext := VideoStream^.codec; + + VideoCodec := avcodec_find_decoder(VideoCodecContext^.codec_id); + if (VideoCodec = nil) then + begin + Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + + // set debug options + VideoCodecContext^.debug_mv := 0; + VideoCodecContext^.debug := 0; + + // detect bug-workarounds automatically + VideoCodecContext^.workaround_bugs := FF_BUG_AUTODETECT; + // error resilience strategy (careful/compliant/agressive/very_aggressive) + //VideoCodecContext^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT; + // allow non spec compliant speedup tricks. + //VideoCodecContext^.flags2 := VideoCodecContext^.flags2 or CODEC_FLAG2_FAST; + + // Note: avcodec_open() and avcodec_close() are not thread-safe and will + // fail if called concurrently by different threads. + FFmpegCore.LockAVCodec(); + try + errnum := avcodec_open(VideoCodecContext, VideoCodec); + finally + FFmpegCore.UnlockAVCodec(); + end; + if (errnum < 0) then + begin + Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + + // register custom callbacks for pts-determination + VideoCodecContext^.get_buffer := PtsGetBuffer; + VideoCodecContext^.release_buffer := PtsReleaseBuffer; + + {$ifdef DebugDisplay} + DebugWriteln('Found a matching Codec: '+ VideoCodecContext^.Codec.Name + sLineBreak + + sLineBreak + + ' Width = '+inttostr(VideoCodecContext^.width) + + ', Height='+inttostr(VideoCodecContext^.height) + sLineBreak + + ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num) + '/' + + inttostr(VideoCodecContext^.sample_aspect_ratio.den) + sLineBreak + + ' Framerate : '+inttostr(VideoCodecContext^.time_base.num) + '/' + + inttostr(VideoCodecContext^.time_base.den)); + {$endif} + + // allocate space for decoded frame and rgb frame + AVFrame := avcodec_alloc_frame(); + AVFrameRGB := avcodec_alloc_frame(); + FrameBuffer := av_malloc(avpicture_get_size(PIXEL_FMT_FFMPEG, + VideoCodecContext^.width, VideoCodecContext^.height)); + + if ((AVFrame = nil) or (AVFrameRGB = nil) or (FrameBuffer = nil)) then + begin + Log.LogError('Failed to allocate buffers', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + + // TODO: pad data for OpenGL to GL_UNPACK_ALIGNMENT + // (otherwise video will be distorted if width/height is not a multiple of the alignment) + errnum := avpicture_fill(PAVPicture(AVFrameRGB), FrameBuffer, PIXEL_FMT_FFMPEG, + VideoCodecContext^.width, VideoCodecContext^.height); + if (errnum < 0) then + begin + Log.LogError('avpicture_fill failed: ' + FFmpegCore.GetErrorString(errnum), 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + + // calculate some information for video display + VideoAspect := av_q2d(VideoCodecContext^.sample_aspect_ratio); + if (VideoAspect = 0) then + VideoAspect := VideoCodecContext^.width / + VideoCodecContext^.height + else + VideoAspect := VideoAspect * VideoCodecContext^.width / + VideoCodecContext^.height; + + VideoTimeBase := 1/av_q2d(VideoStream^.r_frame_rate); + + // hack to get reasonable timebase (for divx and others) + if (VideoTimeBase < 0.02) then // 0.02 <-> 50 fps + begin + VideoTimeBase := av_q2d(VideoStream^.r_frame_rate); + while (VideoTimeBase > 50) do + VideoTimeBase := VideoTimeBase/10; + VideoTimeBase := 1/VideoTimeBase; + end; + + Log.LogInfo('VideoTimeBase: ' + floattostr(VideoTimeBase), 'TVideoPlayback_ffmpeg.Open'); + Log.LogInfo('Framerate: '+inttostr(floor(1/VideoTimeBase))+'fps', 'TVideoPlayback_ffmpeg.Open'); + + {$IFDEF UseSWScale} + // if available get a SWScale-context -> faster than the deprecated img_convert(). + // SWScale has accelerated support for PIX_FMT_RGB32/PIX_FMT_BGR24/PIX_FMT_BGR565/PIX_FMT_BGR555. + // Note: PIX_FMT_RGB32 is a BGR- and not an RGB-format (maybe a bug)!!! + // The BGR565-formats (GL_UNSIGNED_SHORT_5_6_5) is way too slow because of its + // bad OpenGL support. The BGR formats have MMX(2) implementations but no speed-up + // could be observed in comparison to the RGB versions. + SoftwareScaleContext := sws_getContext( + VideoCodecContext^.width, VideoCodecContext^.height, + integer(VideoCodecContext^.pix_fmt), + VideoCodecContext^.width, VideoCodecContext^.height, + integer(PIXEL_FMT_FFMPEG), + SWS_FAST_BILINEAR, nil, nil, nil); + if (SoftwareScaleContext = nil) then + begin + Log.LogError('Failed to get swscale context', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + {$ENDIF} + + TexWidth := Round(Power(2, Ceil(Log2(VideoCodecContext^.width)))); + TexHeight := Round(Power(2, Ceil(Log2(VideoCodecContext^.height)))); + + // we retrieve a texture just once with glTexImage2D and update it with glTexSubImage2D later. + // Benefits: glTexSubImage2D is faster and supports non-power-of-two widths/height. + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glTexEnvi(GL_TEXTURE_2D, GL_TEXTURE_ENV_MODE, GL_REPLACE); + glTexImage2D(GL_TEXTURE_2D, 0, 3, TexWidth, TexHeight, 0, + PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, nil); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + + + fVideoOpened := True; + + Result := true; +end; + +procedure TVideoPlayback_FFmpeg.Close; +begin + if (FrameBuffer <> nil) then + av_free(FrameBuffer); + if (AVFrameRGB <> nil) then + av_free(AVFrameRGB); + if (AVFrame <> nil) then + av_free(AVFrame); + + AVFrame := nil; + AVFrameRGB := nil; + FrameBuffer := nil; + + if (VideoCodecContext <> nil) then + begin + // avcodec_close() is not thread-safe + FFmpegCore.LockAVCodec(); + try + avcodec_close(VideoCodecContext); + finally + FFmpegCore.UnlockAVCodec(); + end; + end; + + if (VideoFormatContext <> nil) then + av_close_input_file(VideoFormatContext); + + VideoCodecContext := nil; + VideoFormatContext := nil; + + fVideoOpened := False; +end; + +procedure TVideoPlayback_FFmpeg.SynchronizeVideo(Frame: PAVFrame; var pts: double); +var + FrameDelay: double; +begin + if (pts <> 0) then + begin + // if we have pts, set video clock to it + VideoTime := pts; + end else + begin + // if we aren't given a pts, set it to the clock + pts := VideoTime; + end; + // update the video clock + FrameDelay := av_q2d(VideoCodecContext^.time_base); + // if we are repeating a frame, adjust clock accordingly + FrameDelay := FrameDelay + Frame^.repeat_pict * (FrameDelay * 0.5); + VideoTime := VideoTime + FrameDelay; +end; + +function TVideoPlayback_FFmpeg.DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; +var + FrameFinished: Integer; + VideoPktPts: int64; + pbIOCtx: PByteIOContext; + errnum: integer; +begin + Result := false; + FrameFinished := 0; + + if EOF then + Exit; + + // read packets until we have a finished frame (or there are no more packets) + while (FrameFinished = 0) do + begin + errnum := av_read_frame(VideoFormatContext, AVPacket); + if (errnum < 0) then + begin + // failed to read a frame, check reason + + {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)} + pbIOCtx := VideoFormatContext^.pb; + {$ELSE} + pbIOCtx := @VideoFormatContext^.pb; + {$IFEND} + + // check for end-of-file (eof is not an error) + if (url_feof(pbIOCtx) <> 0) then + begin + EOF := true; + Exit; + end; + + // check for errors + if (url_ferror(pbIOCtx) <> 0) then + Exit; + + // url_feof() does not detect an EOF for some mov-files (e.g. deluxe.mov) + // so we have to do it this way. + if ((VideoFormatContext^.file_size <> 0) and + (pbIOCtx^.pos >= VideoFormatContext^.file_size)) then + begin + EOF := true; + Exit; + end; + + // no error -> wait for user input + SDL_Delay(100); + continue; + end; + + // if we got a packet from the video stream, then decode it + if (AVPacket.stream_index = VideoStreamIndex) then + begin + // save pts to be stored in pFrame in first call of PtsGetBuffer() + VideoPktPts := AVPacket.pts; + VideoCodecContext^.opaque := @VideoPktPts; + + // decode packet + avcodec_decode_video(VideoCodecContext, AVFrame, + frameFinished, AVPacket.data, AVPacket.size); + + // reset opaque data + VideoCodecContext^.opaque := nil; + + // update pts + if (AVPacket.dts <> AV_NOPTS_VALUE) then + begin + pts := AVPacket.dts; + end + else if ((AVFrame^.opaque <> nil) and + (Pint64(AVFrame^.opaque)^ <> AV_NOPTS_VALUE)) then + begin + pts := Pint64(AVFrame^.opaque)^; + end + else + begin + pts := 0; + end; + pts := pts * av_q2d(VideoStream^.time_base); + + // synchronize on each complete frame + if (frameFinished <> 0) then + SynchronizeVideo(AVFrame, pts); + end; + + // free the packet from av_read_frame + av_free_packet( @AVPacket ); + end; + + Result := true; +end; + +procedure TVideoPlayback_FFmpeg.GetFrame(Time: Extended); +var + AVPacket: TAVPacket; + errnum: Integer; + myTime: Extended; + TimeDifference: Extended; + DropFrameCount: Integer; + pts: double; + i: Integer; +const + FRAME_DROPCOUNT = 3; +begin + if not fVideoOpened then + Exit; + + if fVideoPaused then + Exit; + + // current time, relative to last loop (if any) + myTime := Time - fLoopTime; + // time since the last frame was returned + TimeDifference := myTime - VideoTime; + + {$IFDEF DebugDisplay} + DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak + + 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak + + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); + {$endif} + + // check if a new frame is needed + if (VideoTime <> 0) and (TimeDifference < VideoTimeBase) then + begin + {$ifdef DebugFrames} + // frame delay debug display + GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00); + {$endif} + + {$IFDEF DebugDisplay} + DebugWriteln('not getting new frame' + sLineBreak + + 'Time: '+inttostr(floor(Time*1000)) + sLineBreak + + 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak + + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); + {$endif} + + // we do not need a new frame now + Exit; + end; + + // update video-time to the next frame + VideoTime := VideoTime + VideoTimeBase; + TimeDifference := myTime - VideoTime; + + // check if we have to skip frames + if (TimeDifference >= FRAME_DROPCOUNT*VideoTimeBase) then + begin + {$IFDEF DebugFrames} + //frame drop debug display + GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); + {$ENDIF} + {$IFDEF DebugDisplay} + DebugWriteln('skipping frames' + sLineBreak + + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); + {$endif} + + // update video-time + DropFrameCount := Trunc(TimeDifference / VideoTimeBase); + VideoTime := VideoTime + DropFrameCount*VideoTimeBase; + + // skip half of the frames, this is much smoother than to skip all at once + for i := 1 to DropFrameCount (*div 2*) do + DecodeFrame(AVPacket, pts); + end; + + {$IFDEF VideoBenchmark} + Log.BenchmarkStart(15); + {$ENDIF} + + if (not DecodeFrame(AVPacket, pts)) then + begin + if Loop then + begin + // Record the time we looped. This is used to keep the loops in time. otherwise they speed + SetPosition(0); + fLoopTime := Time; + end; + Exit; + end; + + // TODO: support for pan&scan + //if (AVFrame.pan_scan <> nil) then + //begin + // Writeln(Format('PanScan: %d/%d', [AVFrame.pan_scan.width, AVFrame.pan_scan.height])); + //end; + + // otherwise we convert the pixeldata from YUV to RGB + {$IFDEF UseSWScale} + errnum := sws_scale(SoftwareScaleContext, @(AVFrame.data), @(AVFrame.linesize), + 0, VideoCodecContext^.Height, + @(AVFrameRGB.data), @(AVFrameRGB.linesize)); + {$ELSE} + errnum := img_convert(PAVPicture(AVFrameRGB), PIXEL_FMT_FFMPEG, + PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, + VideoCodecContext^.width, VideoCodecContext^.height); + {$ENDIF} + + if (errnum < 0) then + begin + Log.LogError('Image conversion failed', 'TVideoPlayback_ffmpeg.GetFrame'); + Exit; + end; + + {$IFDEF VideoBenchmark} + Log.BenchmarkEnd(15); + Log.BenchmarkStart(16); + {$ENDIF} + + // TODO: data is not padded, so we will need to tell OpenGL. + // Or should we add padding with avpicture_fill? (check which one is faster) + //glPixelStorei(GL_UNPACK_ALIGNMENT, 1); + + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, + VideoCodecContext^.width, VideoCodecContext^.height, + PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]); + + {$ifdef DebugFrames} + //frame decode debug display + GoldenRec.Spawn(200, 35, 1, 16, 0, -1, ColoredStar, $ffff00); + {$endif} + + {$IFDEF VideoBenchmark} + Log.BenchmarkEnd(16); + Log.LogBenchmark('FFmpeg', 15); + Log.LogBenchmark('Texture', 16); + {$ENDIF} +end; + +procedure TVideoPlayback_FFmpeg.DrawGL(Screen: integer); +var + TexVideoRightPos, TexVideoLowerPos: Single; + ScreenLeftPos, ScreenRightPos: Single; + ScreenUpperPos, ScreenLowerPos: Single; + ScaledVideoWidth, ScaledVideoHeight: Single; + ScreenMidPosX, ScreenMidPosY: Single; + ScreenAspect: Single; +begin + // have a nice black background to draw on (even if there were errors opening the vid) + if (Screen = 1) then + begin + glClearColor(0, 0, 0, 0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + end; + + // exit if there's nothing to draw + if (not fVideoOpened) then + Exit; + + {$IFDEF VideoBenchmark} + Log.BenchmarkStart(15); + {$ENDIF} + + // TODO: add a SetAspectCorrectionMode() function so we can switch + // aspect correction. The screens video backgrounds look very ugly with aspect + // correction because of the white bars at the top and bottom. + + ScreenAspect := ScreenW / ScreenH; + ScaledVideoWidth := RenderW; + ScaledVideoHeight := RenderH * ScreenAspect/VideoAspect; + + // Note: Scaling the width does not look good because the video might contain + // black borders at the top already + //ScaledVideoHeight := RenderH; + //ScaledVideoWidth := RenderW * VideoAspect/ScreenAspect; + + // center the video + ScreenMidPosX := RenderW/2; + ScreenMidPosY := RenderH/2; + ScreenLeftPos := ScreenMidPosX - ScaledVideoWidth/2; + ScreenRightPos := ScreenMidPosX + ScaledVideoWidth/2; + ScreenUpperPos := ScreenMidPosY - ScaledVideoHeight/2; + ScreenLowerPos := ScreenMidPosY + ScaledVideoHeight/2; + // the video-texture contains empty borders because its width and height must be + // a power of 2. So we have to determine the texture coords of the video. + TexVideoRightPos := VideoCodecContext^.width / TexWidth; + TexVideoLowerPos := VideoCodecContext^.height / TexHeight; + + // we could use blending for brightness control, but do we need this? + glDisable(GL_BLEND); + + // TODO: disable other stuff like lightning, etc. + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glColor3f(1, 1, 1); + glBegin(GL_QUADS); + // upper-left coord + glTexCoord2f(0, 0); + glVertex2f(ScreenLeftPos, ScreenUpperPos); + // lower-left coord + glTexCoord2f(0, TexVideoLowerPos); + glVertex2f(ScreenLeftPos, ScreenLowerPos); + // lower-right coord + glTexCoord2f(TexVideoRightPos, TexVideoLowerPos); + glVertex2f(ScreenRightPos, ScreenLowerPos); + // upper-right coord + glTexCoord2f(TexVideoRightPos, 0); + glVertex2f(ScreenRightPos, ScreenUpperPos); + glEnd; + glDisable(GL_TEXTURE_2D); + + {$IFDEF VideoBenchmark} + Log.BenchmarkEnd(15); + Log.LogBenchmark('DrawGL', 15); + {$ENDIF} + + {$IFDEF Info} + if (fVideoSkipTime+VideoTime+VideoTimeBase < 0) then + begin + glColor4f(0.7, 1, 0.3, 1); + SetFontStyle (1); + SetFontItalic(False); + SetFontSize(9); + SetFontPos (300, 0); + glPrint('Delay due to negative VideoGap'); + glColor4f(1, 1, 1, 1); + end; + {$ENDIF} + + {$IFDEF DebugFrames} + glColor4f(0, 0, 0, 0.2); + glbegin(GL_QUADS); + glVertex2f(0, 0); + glVertex2f(0, 70); + glVertex2f(250, 70); + glVertex2f(250, 0); + glEnd; + + glColor4f(1, 1, 1, 1); + SetFontStyle (1); + SetFontItalic(False); + SetFontSize(9); + SetFontPos (5, 0); + glPrint('delaying frame'); + SetFontPos (5, 20); + glPrint('fetching frame'); + SetFontPos (5, 40); + glPrint('dropping frame'); + {$ENDIF} +end; + +procedure TVideoPlayback_FFmpeg.Play; +begin +end; + +procedure TVideoPlayback_FFmpeg.Pause; +begin + fVideoPaused := not fVideoPaused; +end; + +procedure TVideoPlayback_FFmpeg.Stop; +begin +end; + +procedure TVideoPlayback_FFmpeg.SetPosition(Time: real); +var + SeekFlags: integer; +begin + if not fVideoOpened then + Exit; + + if (Time < 0) then + Time := 0; + + // TODO: handle loop-times + //Time := Time mod VideoDuration; + + // backward seeking might fail without AVSEEK_FLAG_BACKWARD + SeekFlags := AVSEEK_FLAG_ANY; + if (Time < VideoTime) then + SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD; + + VideoTime := Time; + EOF := false; + + if (av_seek_frame(VideoFormatContext, VideoStreamIndex, Floor(Time/VideoTimeBase), SeekFlags) < 0) then + begin + Log.LogError('av_seek_frame() failed', 'TVideoPlayback_ffmpeg.SetPosition'); + Exit; + end; + + avcodec_flush_buffers(VideoCodecContext); +end; + +function TVideoPlayback_FFmpeg.GetPosition: real; +begin + // TODO: return video-position in seconds + Result := VideoTime; +end; + +initialization + MediaManager.Add(TVideoPlayback_FFmpeg.Create); + +end. diff --git a/src/classes0/UVisualizer.pas b/src/classes0/UVisualizer.pas new file mode 100644 index 00000000..e2125201 --- /dev/null +++ b/src/classes0/UVisualizer.pas @@ -0,0 +1,442 @@ +unit UVisualizer; + +(* TODO: + * - fix video/visualizer switching + * - use GL_EXT_framebuffer_object for rendering to a separate framebuffer, + * this will prevent plugins from messing up our render-context + * (-> no stack corruption anymore, no need for Save/RestoreOpenGLState()). + * - create a generic (C-compatible) interface for visualization plugins + * - create a visualization plugin manager + * - write a plugin for projectM in C/C++ (so we need no wrapper anymore) + *) + +{* Note: + * It would be easier to create a seperate Render-Context (RC) for projectM + * and switch to it when necessary. This can be achieved by pbuffers + * (slow and platform specific) or the OpenGL FramebufferObject (FBO) extension + * (fast and plattform-independent but not supported by older graphic-cards/drivers). + * + * See http://oss.sgi.com/projects/ogl-sample/registry/EXT/framebuffer_object.txt + * + * To support as many cards as possible we will stick to the current dirty + * solution for now even if it is a pain to save/restore projectM's state due + * to bugs etc. + * + * This also restricts us to projectM. As other plug-ins might have different + * needs and bugs concerning the OpenGL state, USDX's state would probably be + * corrupted after the plug-in finshed drawing. + *} + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + UGraphicClasses, + textgl, + math, + gl, + SysUtils, + UIni, + projectM, + UMusic; + +implementation + +uses + UGraphic, + UMain, + UConfig, + ULog; + +{$IF PROJECTM_VERSION < 1000000} // < 1.0 +// Initialization data used on projectM 0.9x creation. +// Since projectM 1.0 this data is passed via the config-file. +const + meshX = 32; + meshY = 24; + fps = 30; + textureSize = 512; +{$IFEND} + +type + TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization ) + private + pm: TProjectM; + ProjectMPath : string; + Initialized: boolean; + + VisualizerStarted: boolean; + VisualizerPaused: boolean; + + VisualTex: GLuint; + PCMData: TPCMData; + RndPCMcount: integer; + + projMatrix: array[0..3, 0..3] of GLdouble; + texMatrix: array[0..3, 0..3] of GLdouble; + + procedure VisualizerStart; + procedure VisualizerStop; + + procedure VisualizerTogglePause; + + function GetRandomPCMData(var data: TPCMData): Cardinal; + + procedure SaveOpenGLState(); + procedure RestoreOpenGLState(); + + public + function GetName: String; + + function Init(): boolean; + function Finalize(): boolean; + + function Open(const aFileName : string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure SetPosition(Time: real); + function GetPosition: real; + + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); + end; + + +function TVideoPlayback_ProjectM.GetName: String; +begin + Result := 'ProjectM'; +end; + +function TVideoPlayback_ProjectM.Init(): boolean; +begin + Result := true; + + if (Initialized) then + Exit; + Initialized := true; + + RndPCMcount := 0; + + ProjectMPath := ProjectM_DataDir + PathDelim; + + VisualizerStarted := False; + VisualizerPaused := False; + + {$IFDEF UseTexture} + glGenTextures(1, PglUint(@VisualTex)); + glBindTexture(GL_TEXTURE_2D, VisualTex); + + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + {$ENDIF} +end; + +function TVideoPlayback_ProjectM.Finalize(): boolean; +begin + VisualizerStop(); + {$IFDEF UseTexture} + glDeleteTextures(1, PglUint(@VisualTex)); + {$ENDIF} + Result := true; +end; + +function TVideoPlayback_ProjectM.Open(const aFileName : string): boolean; // true if succeed +begin + Result := false; +end; + +procedure TVideoPlayback_ProjectM.Close; +begin + VisualizerStop(); +end; + +procedure TVideoPlayback_ProjectM.Play; +begin + VisualizerStart(); +end; + +procedure TVideoPlayback_ProjectM.Pause; +begin + VisualizerTogglePause(); +end; + +procedure TVideoPlayback_ProjectM.Stop; +begin + VisualizerStop(); +end; + +procedure TVideoPlayback_ProjectM.SetPosition(Time: real); +begin + if assigned(pm) then + pm.RandomPreset(); +end; + +function TVideoPlayback_ProjectM.GetPosition: real; +begin + Result := 0; +end; + +{** + * Saves the current OpenGL state. + * This is necessary to prevent projectM from corrupting USDX's current + * OpenGL state. + * + * The following steps are performed: + * - All attributes are pushed to the attribute-stack + * - Projection-/Texture-matrices are saved + * - Modelview-matrix is pushed to the Modelview-stack + * - the OpenGL error-state (glGetError) is cleared + *} +procedure TVideoPlayback_ProjectM.SaveOpenGLState(); +begin + // save all OpenGL state-machine attributes + glPushAttrib(GL_ALL_ATTRIB_BITS); + + // Note: we do not use glPushMatrix() for the GL_PROJECTION and GL_TEXTURE stacks. + // OpenGL specifies the depth of those stacks to be at least 2 but projectM + // already uses 2 stack-entries so overflows might be possible on older hardware. + // In contrast to this the GL_MODELVIEW stack-size is at least 32, so we can + // use glPushMatrix() for this stack. + + // save projection-matrix + glMatrixMode(GL_PROJECTION); + glGetDoublev(GL_PROJECTION_MATRIX, @projMatrix); + {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01 + // bugfix: projection-matrix is popped without being pushed first + glPushMatrix(); + {$IFEND} + + // save texture-matrix + glMatrixMode(GL_TEXTURE); + glGetDoublev(GL_TEXTURE_MATRIX, @texMatrix); + + // save modelview-matrix + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01 + // bugfix: modelview-matrix is popped without being pushed first + glPushMatrix(); + {$IFEND} + + // reset OpenGL error-state + glGetError(); +end; + +{** + * Restores the OpenGL state saved by SaveOpenGLState() + * and resets the error-state. + *} +procedure TVideoPlayback_ProjectM.RestoreOpenGLState(); +begin + // reset OpenGL error-state + glGetError(); + + // restore projection-matrix + glMatrixMode(GL_PROJECTION); + glLoadMatrixd(@projMatrix); + + // restore texture-matrix + glMatrixMode(GL_TEXTURE); + glLoadMatrixd(@texMatrix); + + // restore modelview-matrix + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + + // restore all OpenGL state-machine attributes + glPopAttrib(); +end; + +procedure TVideoPlayback_ProjectM.VisualizerStart; +begin + if VisualizerStarted then + Exit; + + // the OpenGL state must be saved before + SaveOpenGLState(); + try + + try + {$IF PROJECTM_VERSION >= 1000000} // >= 1.0 + pm := TProjectM.Create(ProjectMPath + 'config.inp'); + {$ELSE} + pm := TProjectM.Create( + meshX, meshY, fps, textureSize, ScreenW, ScreenH, + ProjectMPath + 'presets', ProjectMPath + 'fonts'); + {$IFEND} + except on E: Exception do + begin + // Create() might fail if the config-file is not found + Log.LogError('TProjectM.Create: ' + E.Message, 'TVideoPlayback_ProjectM.VisualizerStart'); + Exit; + end; + end; + + // initialize OpenGL + pm.ResetGL(ScreenW, ScreenH); + // skip projectM default-preset + pm.RandomPreset(); + // projectM >= 1.0 uses the OpenGL FramebufferObject (FBO) extension. + // Unfortunately it does NOT reset the framebuffer-context after + // TProjectM.Create. Either glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0) for + // a manual reset or TProjectM.RenderFrame() must be called. + // We use the latter so we do not need to load the FBO extension in USDX. + pm.RenderFrame(); + + VisualizerStarted := True; + finally + RestoreOpenGLState(); + end; +end; + +procedure TVideoPlayback_ProjectM.VisualizerStop; +begin + if VisualizerStarted then + begin + VisualizerStarted := False; + FreeAndNil(pm); + end; +end; + +procedure TVideoPlayback_ProjectM.VisualizerTogglePause; +begin + VisualizerPaused := not VisualizerPaused; +end; + +procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); +var + nSamples: cardinal; + stackDepth: Integer; +begin + if not VisualizerStarted then + Exit; + + if VisualizerPaused then + Exit; + + // get audio data + nSamples := AudioPlayback.GetPCMData(PcmData); + + // generate some data if non is available + if (nSamples = 0) then + nSamples := GetRandomPCMData(PcmData); + + // send audio-data to projectM + if (nSamples > 0) then + pm.AddPCM16Data(PSmallInt(@PcmData), nSamples); + + // store OpenGL state (might be messed up otherwise) + SaveOpenGLState(); + try + // setup projectM's OpenGL state + pm.ResetGL(ScreenW, ScreenH); + + // let projectM render a frame + pm.RenderFrame(); + + {$IFDEF UseTexture} + glBindTexture(GL_TEXTURE_2D, VisualTex); + glFlush(); + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0); + {$ENDIF} + finally + // restore USDX OpenGL state + RestoreOpenGLState(); + end; + + // discard projectM's depth buffer information (avoid overlay) + glClear(GL_DEPTH_BUFFER_BIT); +end; + +{** + * Draws the current frame to screen. + * TODO: this is not used yet. Data is directly drawn on GetFrame(). + *} +procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer); +begin + {$IFDEF UseTexture} + // have a nice black background to draw on + if (Screen = 1) then + begin + glClearColor(0, 0, 0, 0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + end; + + // exit if there's nothing to draw + if not VisualizerStarted then + Exit; + + // setup display + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glLoadIdentity(); + gluOrtho2D(0, 1, 0, 1); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glLoadIdentity(); + + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); + glBindTexture(GL_TEXTURE_2D, VisualTex); + glColor4f(1, 1, 1, 1); + + // draw projectM frame + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(0, 0); + glTexCoord2f(1, 0); glVertex2f(1, 0); + glTexCoord2f(1, 1); glVertex2f(1, 1); + glTexCoord2f(0, 1); glVertex2f(0, 1); + glEnd(); + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + // restore state + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + {$ENDIF} +end; + +{** + * Produces random "sound"-data in case no audio-data is available. + * Otherwise the visualization will look rather boring. + *} +function TVideoPlayback_ProjectM.GetRandomPCMData(var data: TPCMData): Cardinal; +var + i: integer; +begin + // Produce some fake PCM data + if (RndPCMcount mod 500 = 0) then + begin + FillChar(data, SizeOf(TPCMData), 0); + end + else + begin + for i := 0 to 511 do + begin + data[i][0] := Random(High(Word)+1); + data[i][1] := Random(High(Word)+1); + end; + end; + Inc(RndPCMcount); + Result := 512; +end; + + +initialization + MediaManager.Add(TVideoPlayback_ProjectM.Create); + +end. diff --git a/src/classes0/UXMLSong.pas b/src/classes0/UXMLSong.pas new file mode 100644 index 00000000..1a1fe6bc --- /dev/null +++ b/src/classes0/UXMLSong.pas @@ -0,0 +1,573 @@ +unit UXMLSong; + +interface +uses Classes; + +type + TNote = record + Start: Cardinal; + Duration: Cardinal; + Tone: Integer; + NoteTyp: Byte; + Lyric: String; + end; + ANote = Array of TNote; + + TSentence = record + Singer: Byte; + Duration: Cardinal; + Notes: ANote; + end; + ASentence = Array of TSentence; + + TSongInfo = Record + ID: Cardinal; + DualChannel: Boolean; + Header: Record + Artist: String; + Title: String; + Gap: Cardinal; + BPM: Real; + Resolution: Byte; + Edition: String; + Genre: String; + Year: String; + Language: String; + end; + CountSentences: Cardinal; + Sentences: ASentence; + end; + + TParser = class + private + SSFile: TStringList; + + ParserState: Byte; + CurPosinSong: Cardinal; //Cur Beat Pos in the Song + CurDuettSinger: Byte; //Who sings this Part? + BindLyrics: Boolean; //Should the Lyrics be bind to the last Word (no Space) + FirstNote: Boolean; //Is this the First Note found? For Gap calculating + + Function ParseLine(Line: String): Boolean; + public + SongInfo: TSongInfo; + ErrorMessage: String; + Edition: String; + SingstarVersion: String; + + Settings: Record + DashReplacement: Char; + end; + + Constructor Create; + + Function ParseConfigforEdition(const Filename: String): String; + + Function ParseSongHeader(const Filename: String): Boolean; //Parse Song Header only + Function ParseSong (const Filename: String): Boolean; //Parse whole Song + end; + +const + PS_None = 0; + PS_Melody = 1; + PS_Sentence = 2; + + NT_Normal = 1; + NT_Freestyle = 0; + NT_Golden = 2; + + DS_Player1 = 1; + DS_Player2 = 2; + DS_Both = 3; + +implementation +uses SysUtils, StrUtils; + +Constructor TParser.Create; +begin + inherited Create; + ErrorMessage := ''; + + DecimalSeparator := '.'; +end; + +Function TParser.ParseSong (const Filename: String): Boolean; +var I: Integer; +begin + Result := False; + if FileExists(Filename) then + begin + SSFile := TStringList.Create; + + try + ErrorMessage := 'Can''t open melody.xml file'; + SSFile.LoadFromFile(Filename); + ErrorMessage := ''; + Result := True; + I := 0; + + SongInfo.CountSentences := 0; + CurDuettSinger := DS_Both; //Both is Singstar Standard + CurPosinSong := 0; //Start at Pos 0 + BindLyrics := True; //Dont start with Space + FirstNote := True; //First Note found should be the First Note ;) + + SongInfo.Header.Language := ''; + SongInfo.Header.Edition := Edition; + SongInfo.DualChannel := False; + + ParserState := PS_None; + + SetLength(SongInfo.Sentences, 0); + + While Result And (I < SSFile.Count) do + begin + Result := ParseLine(SSFile.Strings[I]); + + Inc(I); + end; + + finally + SSFile.Free; + end; + end; +end; + +Function TParser.ParseSongHeader (const Filename: String): Boolean; +var I: Integer; +begin + Result := False; + if FileExists(Filename) then + begin + SSFile := TStringList.Create; + SSFile.Clear; + + try + SSFile.LoadFromFile(Filename); + + If (SSFile.Count > 0) then + begin + Result := True; + I := 0; + + SongInfo.CountSentences := 0; + CurDuettSinger := DS_Both; //Both is Singstar Standard + CurPosinSong := 0; //Start at Pos 0 + BindLyrics := True; //Dont start with Space + FirstNote := True; //First Note found should be the First Note ;) + + SongInfo.ID := 0; + SongInfo.Header.Language := ''; + SongInfo.Header.Edition := Edition; + SongInfo.DualChannel := False; + ParserState := PS_None; + + While (SongInfo.ID < 4) AND Result And (I < SSFile.Count) do + begin + Result := ParseLine(SSFile.Strings[I]); + + Inc(I); + end; + end + else + ErrorMessage := 'Can''t open melody.xml file'; + + finally + SSFile.Free; + end; + end + else + ErrorMessage := 'Can''t find melody.xml file'; +end; + +Function TParser.ParseLine(Line: String): Boolean; +var + Tag: String; + Values: String; + AValues: Array of Record + Name: String; + Value: String; + end; + I, J, K: Integer; + Duration, Tone: Integer; + Lyric: String; + NoteType: Byte; + + Procedure MakeValuesArray; + var Len, Pos, State, StateChange: Integer; + begin + Len := -1; + SetLength(AValues, Len + 1); + + Pos := 1; + State := 0; + While (Pos <= Length(Values)) AND (Pos <> 0) do + begin + Case State of + + 0: begin //Search for ValueName + If (Values[Pos] <> ' ') AND (Values[Pos] <> '=') then + begin + //Found Something + State := 1; //State search for '=' + StateChange := Pos; //Save Pos of Change + Pos := PosEx('=', Values, Pos + 1); + end + else Inc(Pos); //When nothing found then go to next char + end; + + 1: begin //Search for Equal Mark + //Add New Value + Inc(Len); + SetLength(AValues, Len + 1); + + AValues[Len].Name := UpperCase(Copy(Values, StateChange, Pos - StateChange)); + + + State := 2; //Now Search for starting '"' + StateChange := Pos; //Save Pos of Change + Pos := PosEx('"', Values, Pos + 1); + end; + + 2: begin //Search for starting '"' or ' ' <- End if there was no " + If (Values[Pos] = '"') then + begin //Found starting '"' + State := 3; //Now Search for ending '"' + StateChange := Pos; //Save Pos of Change + Pos := PosEx('"', Values, Pos + 1); + end + else If (Values[Pos] = ' ') then //Found ending Space + begin + //Save Value to Array + AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1); + + //Search for next Valuename + State := 0; + StateChange := Pos; + Inc(Pos); + end; + end; + + 3: begin //Search for ending '"' + //Save Value to Array + AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1); + + //Search for next Valuename + State := 0; + StateChange := Pos; + Inc(Pos); + end; + end; + + If (State >= 2) then + begin //Save Last Value + AValues[Len].Value := Copy(Values, StateChange + 1, Length(Values) - StateChange); + end; + end; + end; +begin + Result := True; + + Line := Trim(Line); + If (Length(Line) > 0) then + begin + I := Pos('<', Line); + J := PosEx(' ', Line, I+1); + K := PosEx('>', Line, I+1); + + If (J = 0) then J := K + Else If (K < J) AND (K <> 0) then J := K; //Use nearest Tagname End indicator + Tag := UpperCase(copy(Line, I + 1, J - I - 1)); + Values := copy(Line, J + 1, K - J - 1); + + Case ParserState of + PS_None: begin//Search for Melody Tag + If (Tag = 'MELODY') then + begin + Inc(SongInfo.ID); //Inc SongID when header Information is added + MakeValuesArray; + For I := 0 to High(AValues) do + begin + If (AValues[I].Name = 'TEMPO') then + begin + SongInfo.Header.BPM := StrtoFloatDef(AValues[I].Value, 0); + If (SongInfo.Header.BPM <= 0) then + begin + Result := False; + ErrorMessage := 'Can''t read BPM from Song'; + end; + end + + Else If (AValues[I].Name = 'RESOLUTION') then + begin + AValues[I].Value := Uppercase(AValues[I].Value); + //Ultrastar Resolution is "how often a Beat is split / 4" + If (AValues[I].Value = 'HEMIDEMISEMIQUAVER') then + SongInfo.Header.Resolution := 64 div 4 + Else If (AValues[I].Value = 'DEMISEMIQUAVER') then + SongInfo.Header.Resolution := 32 div 4 + Else If (AValues[I].Value = 'SEMIQUAVER') then + SongInfo.Header.Resolution := 16 div 4 + Else If (AValues[I].Value = 'QUAVER') then + SongInfo.Header.Resolution := 8 div 4 + Else If (AValues[I].Value = 'CROTCHET') then + SongInfo.Header.Resolution := 4 div 4 + Else + begin //Can't understand teh Resolution :/ + Result := False; + ErrorMessage := 'Can''t read Resolution from Song'; + end; + end + + Else If (AValues[I].Name = 'GENRE') then + begin + SongInfo.Header.Genre := AValues[I].Value; + end + + Else If (AValues[I].Name = 'YEAR') then + begin + SongInfo.Header.Year := AValues[I].Value; + end + + Else If (AValues[I].Name = 'VERSION') then + begin + SingstarVersion := AValues[I].Value; + end; + end; + + ParserState := PS_Melody; //In Melody Tag + end; + end; + + + PS_Melody: begin //Search for Sentence, Artist/Title Info or eo Melody + If (Tag = 'SENTENCE') then + begin + ParserState := PS_Sentence; //Parse in a Sentence Tag now + + //Increase SentenceCount + Inc(SongInfo.CountSentences); + + BindLyrics := True; //Don't let Txts Begin w/ Space + + //Search for Duett Singer Info + MakeValuesArray; + For I := 0 to High(AValues) do + If (AValues[I].Name = 'SINGER') then + begin + AValues[I].Value := Uppercase(AValues[I].Value); + If (AValues[I].Value = 'SOLO 1') then + CurDuettSinger := DS_Player1 + Else If (AValues[I].Value = 'SOLO 2') then + CurDuettSinger := DS_Player2 + Else + CurDuettSinger := DS_Both; //In case of "Group" or anything that is not identified use Both + end; + end + + Else If (Tag = '!--') then + begin //Comment, this may be Artist or Title Info + I := Pos(':', Values); //Search for Delimiter + + If (I <> 0) then //If Found check for Title or Artist + begin + //Copy Title or Artist Tag to Tag String + Tag := Uppercase(Trim(Copy(Values, 1, I - 1))); + + If (Tag = 'ARTIST') then + begin + SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); + Inc(SongInfo.ID); //Inc SongID when header Information is added + end + Else If (Tag = 'TITLE') then + begin + SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); + Inc(SongInfo.ID); //Inc SongID when header Information is added + end; + end; + end + + //Parsing for weird "Die toten Hosen" Tags + Else If (Tag = '!--ARTIST:') OR (Tag = '!--ARTIST') then + begin //Comment, with Artist Info + I := Pos(':', Values); //Search for Delimiter + + Inc(SongInfo.ID); //Inc SongID when header Information is added + + SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); + end + + Else If (Tag = '!--TITLE:') OR (Tag = '!--TITLE') then + begin //Comment, with Artist Info + I := Pos(':', Values); //Search for Delimiter + + Inc(SongInfo.ID); //Inc SongID when header Information is added + + SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); + end + + Else If (Tag = '/MELODY') then + begin + ParserState := PS_None; + Exit; //Stop Parsing, Melody iTag ended + end + end; + + + PS_Sentence: begin //Search for Notes or eo Sentence + If (Tag = 'NOTE') then + begin //Found Note + //Get Values + MakeValuesArray; + + NoteType := NT_Normal; + For I := 0 to High(AValues) do + begin + If (AValues[I].Name = 'DURATION') then + begin + Duration := StrtoIntDef(AValues[I].Value, -1); + If (Duration < 0) then + begin + Result := False; + ErrorMessage := 'Can''t read duration from Note in Line: "' + Line + '"'; + Exit; + end; + end + Else If (AValues[I].Name = 'MIDINOTE') then + begin + Tone := StrtoIntDef(AValues[I].Value, 0); + end + Else If (AValues[I].Name = 'BONUS') AND (Uppercase(AValues[I].Value) = 'YES') then + begin + NoteType := NT_Golden; + end + Else If (AValues[I].Name = 'FREESTYLE') AND (Uppercase(AValues[I].Value) = 'YES') then + begin + NoteType := NT_Freestyle; + end + Else If (AValues[I].Name = 'LYRIC') then + begin + Lyric := AValues[I].Value; + + If (Length(Lyric) > 0) then + begin + If (Lyric = '-') then + Lyric[1] := Settings.DashReplacement; + + If (not BindLyrics) then + Lyric := ' ' + Lyric; + + + If (Length(Lyric) > 2) AND (Lyric[Length(Lyric)-1] = ' ') AND (Lyric[Length(Lyric)] = '-') then + begin //Between this and the next Lyric should be no space + BindLyrics := True; + SetLength(Lyric, Length(Lyric) - 2); + end + else + BindLyrics := False; //There should be a Space + end; + end; + end; + + //Add Note + I := SongInfo.CountSentences - 1; + + If (Length(Lyric) > 0) then + begin //Real note, no rest + //First Note of Sentence + If (Length(SongInfo.Sentences) < SongInfo.CountSentences) then + begin + SetLength(SongInfo.Sentences, SongInfo.CountSentences); + SetLength(SongInfo.Sentences[I].Notes, 0); + end; + + //First Note of Song -> Generate Gap + If (FirstNote) then + begin + //Calculate Gap + If (SongInfo.Header.Resolution <> 0) AND (SongInfo.Header.BPM <> 0) then + SongInfo.Header.Gap := Round(CurPosinSong / (SongInfo.Header.BPM*SongInfo.Header.Resolution) * 60000) + Else + begin + Result := False; + ErrorMessage := 'Can''t calculate Gap, no Resolution or BPM present.'; + Exit; + end; + + CurPosinSong := 0; //Start at 0, because Gap goes until here + Inc(SongInfo.ID); //Add Header Value therefore Inc + FirstNote := False; + end; + + J := Length(SongInfo.Sentences[I].Notes); + SetLength(SongInfo.Sentences[I].Notes, J + 1); + SongInfo.Sentences[I].Notes[J].Start := CurPosinSong; + SongInfo.Sentences[I].Notes[J].Duration := Duration; + SongInfo.Sentences[I].Notes[J].Tone := Tone; + SongInfo.Sentences[I].Notes[J].NoteTyp := NoteType; + SongInfo.Sentences[I].Notes[J].Lyric := Lyric; + + //Inc Pos in Song + Inc(CurPosInSong, Duration); + end + else + begin + //just change pos in Song + Inc(CurPosInSong, Duration); + end; + + + end + Else If (Tag = '/SENTENCE') then + begin //End of Sentence Tag + ParserState := PS_Melody; + + //Delete Sentence if no Note is Added + If (Length(SongInfo.Sentences) <> SongInfo.CountSentences) then + begin + SongInfo.CountSentences := Length(SongInfo.Sentences); + end; + end; + end; + end; + + end + else //Empty Line -> parsed succesful ;) + Result := true; +end; + +Function TParser.ParseConfigforEdition(const Filename: String): String; +var + txt: TStringlist; + I: Integer; + J, K: Integer; + S: String; +begin + Result := ''; + txt := TStringlist.Create; + try + txt.LoadFromFile(Filename); + + For I := 0 to txt.Count-1 do + begin + S := Trim(txt.Strings[I]); + J := Pos('', S); + + If (J <> 0) then + begin + Inc(J, 14); + K := Pos('', S); + If (K nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) + function GetPluginState(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Return PluginInfo of Plugin with Index(wParam)) + + end; + + {********************* + TtehPlugins + Class Represents the Plugins in Module Chain. + It Calls the Plugins Procs and Funcs + *********************} + TtehPlugins = class (TCoreModule) + private + PluginLoader: PPluginLoader; + public + //TCoreModule methods to inherit + constructor Create; override; + + procedure Info(const pInfo: PModuleInfo); override; + function Load: Boolean; override; + function Init: Boolean; override; + procedure DeInit; override; + end; + +const + {$IFDEF MSWINDOWS} + PluginFileExtension = '.dll'; + {$ENDIF} + {$IFDEF LINUX} + PluginFileExtension = '.so'; + {$ENDIF} + {$IFDEF DARWIN} + PluginFileExtension = '.dylib'; + {$ENDIF} + +implementation + +uses + UCore, + UPluginInterface, +{$IFDEF MSWINDOWS} + windows, +{$ELSE} + dynlibs, +{$ENDIF} + UMain, + SysUtils; + +{********************* + TPluginLoader + Implentation +*********************} + +//------------- +// function that gives some Infos about the Module to the Core +//------------- +procedure TPluginLoader.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TPluginLoader'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Searches for Plugins, loads and unloads them'; +end; + +//------------- +// Just the Constructor +//------------- +constructor TPluginLoader.Create; +begin + inherited; + + //Init PluginInterface + //Using Methods from UPluginInterface + PluginInterface.CreateHookableEvent := CreateHookableEvent; + PluginInterface.DestroyHookableEvent := DestroyHookableEvent; + PluginInterface.NotivyEventHooks := NotivyEventHooks; + PluginInterface.HookEvent := HookEvent; + PluginInterface.UnHookEvent := UnHookEvent; + PluginInterface.EventExists := EventExists; + + PluginInterface.CreateService := @CreateService; + PluginInterface.DestroyService := DestroyService; + PluginInterface.CallService := CallService; + PluginInterface.ServiceExists := ServiceExists; + + //UnSet Private Var + LoadingProcessFinished := False; +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 TPluginLoader.Load: Boolean; +begin + Result := True; + + try + //Start Searching for Plugins + BrowseDir(PluginPath); + except + Result := False; + Core.ReportError(integer(PChar('Error Browsing and Loading.')), PChar('TPluginLoader')); + end; +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 TPluginLoader.Init: Boolean; +begin + //Just set Prvate Var to true. + LoadingProcessFinished := True; + Result := True; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +procedure TPluginLoader.DeInit; +var + I: integer; +begin + //Force DeInit + //If some Plugins aren't DeInited for some Reason o0 + for I := 0 to High(Plugins) do + begin + if (Plugins[I].State < 4) then + FreePlugin(I); + end; + + //Nothing to do here. Core will remove the Hooks +end; + +//------------- +//Is Called if this Module will be unloaded and has been created +//Should be used to Free Memory +//------------- +Destructor TPluginLoader.Destroy; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Plugins, 0); + inherited; +end; + +//-------------- +// Browses the Path at _Path_ for Plugins +//-------------- +procedure TPluginLoader.BrowseDir(Path: String); +var + SR: TSearchRec; +begin + //Search for other Dirs to Browse + if FindFirst(Path + '*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + BrowseDir(Path + Sr.Name + PathDelim); + until FindNext(SR) <> 0; + end; + FindClose(SR); + + //Search for Plugins at Path + if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then + begin + repeat + AddPlugin(Path + SR.Name); + until FindNext(SR) <> 0; + end; + FindClose(SR); +end; + +//-------------- +// If Plugin Exists: Index of Plugin, else -1 +//-------------- +function TPluginLoader.PluginExists(Name: String): integer; +var + I: integer; +begin + Result := -1; + + if (Length(Name) <= 32 { =>Length(TUS_PluginInfo.Name)}) then + begin + for I := 0 to High(Plugins) do + if (Plugins[I].Info.Name = Name) then + begin //Found the Plugin + Result := I; + Break; + end; + end; +end; + +//-------------- +// Adds Plugin to the Array +//-------------- +procedure TPluginLoader.AddPlugin(Filename: String); +var + hLib: THandle; + PInfo: Proc_PluginInfo; + Info: TUS_PluginInfo; + PluginID: integer; +begin + if (FileExists(Filename)) then + begin //Load Libary + hLib := LoadLibrary(PChar(Filename)); + if (hLib <> 0) then + begin //Try to get Address of the Info Proc + PInfo := GetProcAddress (hLib, PChar('USPlugin_Info')); + if (@PInfo <> nil) then + begin + Info.cbSize := SizeOf(TUS_PluginInfo); + + try //Call Info Proc + PInfo(@Info); + except + Info.Name := ''; + Core.ReportError(integer(PChar('Error getting Plugin Info: ' + Filename)), PChar('TPluginLoader')); + end; + + //Is Name set ? + if (Trim(Info.Name) <> '') then + begin + PluginID := PluginExists(Info.Name); + + if (PluginID > 0) and (Plugins[PluginID].State >=4) then + PluginID := -1; + + if (PluginID = -1) then + begin + //Add new item to array + PluginID := Length(Plugins); + SetLength(Plugins, PluginID + 1); + + //Fill with Info: + Plugins[PluginID].Info := Info; + Plugins[PluginID].State := 0; + Plugins[PluginID].Path := Filename; + Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].hLib := hLib; + + //Try to get Procs + Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); + Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); + Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); + + if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + begin + Plugins[PluginID].State := 255; + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); + end; + + //Emulate loading process if this Plugin is loaded to late + if (LoadingProcessFinished) then + begin + CallLoad(PluginID); + CallInit(PluginID); + end; + end + else if (LoadingProcessFinished = False) then + begin + if (Plugins[PluginID].Info.Version < Info.Version) then + begin //Found newer Version of this Plugin + Core.ReportDebug(integer(PChar('Found a newer Version of Plugin: ' + String(Info.Name))), PChar('TPluginLoader')); + + //Unload Old Plugin + UnloadPlugin(PluginID, nil); + + //Fill with new Info + Plugins[PluginID].Info := Info; + Plugins[PluginID].State := 0; + Plugins[PluginID].Path := Filename; + Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].hLib := hLib; + + //Try to get Procs + Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); + Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); + Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); + + if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + begin + FreeLibrary(hLib); + Plugins[PluginID].State := 255; + Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); + end; + end + else + begin //Newer Version already loaded + FreeLibrary(hLib); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Plugin with this Name already exists: ' + String(Info.Name))), PChar('TPluginLoader')); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('No name reported: ' + Filename)), PChar('TPluginLoader')); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Can''t find Info procedure: ' + Filename)), PChar('TPluginLoader')); + end; + end + else + Core.ReportError(integer(PChar('Can''t load Plugin Libary: ' + Filename)), PChar('TPluginLoader')); + end; +end; + +//-------------- +// Calls Load Func of Plugin with the given Index +//-------------- +function TPluginLoader.CallLoad(Index: Cardinal): integer; +begin + Result := -2; + if(Index < Length(Plugins)) then + begin + if (@Plugins[Index].Procs.Load <> nil) and (Plugins[Index].State = 0) then + begin + try + Result := Plugins[Index].Procs.Load(@PluginInterface); + except + Result := -3; + End; + + if (Result = 0) then + Plugins[Index].State := 1 + else + begin + FreePlugin(Index); + Plugins[Index].State := 255; + Core.ReportError(integer(PChar('Error calling Load function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + end; + end; + end; +end; + +//-------------- +// Calls Init Func of Plugin with the given Index +//-------------- +function TPluginLoader.CallInit(Index: Cardinal): integer; +begin + Result := -2; + if(Index < Length(Plugins)) then + begin + if (@Plugins[Index].Procs.Init <> nil) and (Plugins[Index].State = 1) then + begin + try + Result := Plugins[Index].Procs.Init(@PluginInterface); + except + Result := -3; + End; + + if (Result = 0) then + begin + Plugins[Index].State := 2; + Plugins[Index].NeedsDeInit := True; + end + else + begin + FreePlugin(Index); + Plugins[Index].State := 255; + Core.ReportError(integer(PChar('Error calling Init function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + end; + end; + end; +end; + +//-------------- +// Calls DeInit Proc of Plugin with the given Index +//-------------- +procedure TPluginLoader.CallDeInit(Index: Cardinal); +begin + if(Index < Length(Plugins)) then + begin + if (Plugins[Index].State < 4) then + begin + if (@Plugins[Index].Procs.DeInit <> nil) and (Plugins[Index].NeedsDeInit) then + try + Plugins[Index].Procs.DeInit(@PluginInterface); + except + + End; + + //Don't forget to remove Services and Subscriptions by this Plugin + Core.Hooks.DelbyOwner(-1 - Index); + + FreePlugin(Index); + end; + end; +end; + +//-------------- +// Frees all Plugin Sources (Procs and Handles) - Helper for Deiniting Functions +//-------------- +procedure TPluginLoader.FreePlugin(Index: Cardinal); +begin + Plugins[Index].State := 4; + Plugins[Index].Procs.Load := nil; + Plugins[Index].Procs.Init := nil; + Plugins[Index].Procs.DeInit := nil; + + if (Plugins[Index].hLib <> 0) then + FreeLibrary(Plugins[Index].hLib); +end; + + + +//-------------- +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin +//-------------- +function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; +var + Index: integer; + sFile: String; +begin + Result := -1; + sFile := ''; + //lParam is ID + if (lParam = nil) then + begin + Index := wParam; + end + else + begin //lParam is PChar + try + sFile := String(PChar(lParam)); + Index := PluginExists(sFile); + if (Index < 0) And FileExists(sFile) then + begin //Is Filename + AddPlugin(sFile); + Result := Plugins[High(Plugins)].State; + end; + except + Index := -2; + end; + end; + + + if (Index >= 0) and (Index < Length(Plugins)) then + begin + AddPlugin(Plugins[Index].Path); + Result := Plugins[Index].State; + end; +end; + +//-------------- +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin +//-------------- +function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; +var + Index: integer; + sName: String; +begin + Result := -1; + //lParam is ID + if (lParam = nil) then + begin + Index := wParam; + end + else + begin //wParam is PChar + try + sName := String(PChar(lParam)); + Index := PluginExists(sName); + except + Index := -2; + end; + end; + + + if (Index >= 0) and (Index < Length(Plugins)) then + CallDeInit(Index) +end; + +//-------------- +// if wParam = -1 then (if lParam = nil then get length of Moduleinfo Array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) +//-------------- +function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; +var I: integer; +begin + Result := 0; + if (wParam > 0) then + begin //Get Info of 1 Plugin + if (lParam <> nil) and (wParam < Length(Plugins)) then + begin + try + Result := 1; + PUS_PluginInfo(lParam)^ := Plugins[wParam].Info; + except + + End; + end; + end + else if (lParam = nil) then + begin //Get Length of Plugin (Info) Array + Result := Length(Plugins); + end + else //Write PluginInfo Array to Address in lParam + begin + try + for I := 0 to high(Plugins) do + PAUS_PluginInfo(lParam)^[I] := Plugins[I].Info; + Result := Length(Plugins); + except + Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader')); + End; + end; + +end; + +//-------------- +// if wParam = -1 then (if lParam = nil then get length of Plugin State Array. if lparam <> nil then write array of Byte to address at lparam) else (Return State of Plugin with Index(wParam)) +//-------------- +function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; +var I: integer; +begin + Result := -1; + if (wParam > 0) then + begin //Get State of 1 Plugin + if (wParam < Length(Plugins)) then + begin + Result := Plugins[wParam].State; + end; + end + else if (lParam = nil) then + begin //Get Length of Plugin (Info) Array + Result := Length(Plugins); + end + else //Write PluginInfo Array to Address in lParam + begin + try + for I := 0 to high(Plugins) do + Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; + Result := Length(Plugins); + except + Core.ReportError(integer(PChar('Could not write PluginState Array')), PChar('TPluginLoader')); + End; + end; +end; + + +{********************* + TtehPlugins + Implentation +*********************} + +//------------- +// function that gives some Infos about the Module to the Core +//------------- +procedure TtehPlugins.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TtehPlugins'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Module executing the Plugins!'; +end; + +//------------- +// Just the Constructor +//------------- +constructor TtehPlugins.Create; +begin + inherited; + PluginLoader := nil; +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 TtehPlugins.Load: Boolean; +var + i: integer; //Counter + CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute +begin + //Get Pointer to PluginLoader + PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader')); + if (PluginLoader = nil) then + begin + Result := false; + Core.ReportError(integer(PChar('Could not get Pointer to PluginLoader')), PChar('TtehPlugins')); + end + else + begin + Result := true; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + for i := 0 to High(PluginLoader.Plugins) do + begin + Core.CurExecuted := -1 - i; + + try + //Unload Plugin if not correctly Executed + if (PluginLoader.CallLoad(i) <> 0) then + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 254; //Plugin asks for unload + Core.ReportDebug(integer(PChar('Plugin Selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end + else + begin + Core.ReportDebug(integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end; + except + //Plugin could not be loaded. + // => Show Error Message, then ShutDown Plugin + on E: Exception do + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 255; //Plugin causes Error + Core.ReportError(integer(PChar('Plugin causes Error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins')); + end; + end; + end; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; +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 TtehPlugins.Init: Boolean; +var + i: integer; //Counter + CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute +begin + Result := true; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + for i := 0 to High(PluginLoader.Plugins) do + try + Core.CurExecuted := -1 - i; + + //Unload Plugin if not correctly Executed + if (PluginLoader.CallInit(i) <> 0) then + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 254; //Plugin asks for unload + Core.ReportDebug(integer(PChar('Plugin Selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end + else + Core.ReportDebug(integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + except + //Plugin could not be loaded. + // => Show Error Message, then ShutDown Plugin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 255; //Plugin causes Error + Core.ReportError(integer(PChar('Plugin causes Error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +procedure TtehPlugins.DeInit; +var + i: integer; //Counter + CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute +begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loop + + for i := 0 to High(PluginLoader.Plugins) do + begin + try + //DeInit Plugin + PluginLoader.CallDeInit(i); + except + end; + end; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +end. -- cgit v1.2.3