From 46bb010ca7c5eb04551c030105f9999ca80e472f Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 8 Jun 2008 15:33:48 +0000 Subject: - set svn:eol-style to native - removed some svn:executable properties from non-executable files git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1144 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/TextGL.pas | 1170 +++--- Game/Code/Classes/UAudioCore_Bass.pas | 222 +- Game/Code/Classes/UAudioPlayback_Portaudio.pas | 700 ++-- Game/Code/Classes/UAudioPlayback_SDL.pas | 300 +- Game/Code/Classes/UCatCovers.pas | 300 +- Game/Code/Classes/UCommon.pas | 1582 ++++---- Game/Code/Classes/UCore.pas | 1020 +++--- Game/Code/Classes/UDraw.pas | 2680 +++++++------- Game/Code/Classes/UGraphicClasses.pas | 1346 +++---- Game/Code/Classes/UImage.pas | 1538 ++++---- Game/Code/Classes/UJoystick.pas | 564 +-- Game/Code/Classes/ULCD.pas | 608 ++-- Game/Code/Classes/ULog.pas | 832 ++--- Game/Code/Classes/ULyrics.pas | 1506 ++++---- Game/Code/Classes/UMedia_dummy.pas | 460 +-- Game/Code/Classes/UModules.pas | 50 +- Game/Code/Classes/UParty.pas | 1236 +++---- Game/Code/Classes/UPlatformWindows.pas | 452 +-- Game/Code/Classes/UPluginInterface.pas | 312 +- Game/Code/Classes/UServices.pas | 712 ++-- Game/Code/Classes/USingNotes.pas | 26 +- Game/Code/Classes/UTextClasses.pas | 120 +- Game/Code/Classes/UThemes.pas | 4566 ++++++++++++------------ Game/Code/Classes/UVideo.pas | 1714 ++++----- Game/Code/Classes/UXMLSong.pas | 1146 +++--- Game/Code/Classes/uPluginLoader.pas | 1550 ++++---- 26 files changed, 13356 insertions(+), 13356 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas index 1396ae1b..2c29af59 100644 --- a/Game/Code/Classes/TextGL.pas +++ b/Game/Code/Classes/TextGL.pas @@ -1,585 +1,585 @@ -unit TextGL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -{$IFDEF FPC} - {$ASMMODE Intel} -{$ENDIF} - -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 glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real); -procedure glPrintLetter(letter: char); -procedure glPrintLetterCut(letter: char; Start, Finish: real); -procedure glPrint(text: pchar); // custom GL "Print" routine -procedure glPrintCut(text: pchar); -procedure SetFontPos(X, Y: real); // sets X and Y -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 - -// Start of SDL_ttf -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; -procedure printrandomtext(); -// End of SDL_ttf - -type - TTextGL = record - X: real; - Y: real; - Text: string; - Size: real; - ColR: real; - ColG: real; - ColB: real; - end; - - TFont = record - Tex: TTexture; - Width: array[0..255] of byte; - AspectW: real; - Centered: boolean; - Done: real; - Outline: real; - Italic: boolean; - Reflection: boolean; - ReflectionSpacing: real; - end; - - -var - base: GLuint; // base display list for the font set - Fonts: array of TFont; - ActFont: integer; - PColR: real; // temps for glPrintDone - PColG: real; - PColB: real; - - // Colours for the reflection - TempColor: array[0..3] of GLfloat; - PTempColor: PGLfloat; - -implementation - -uses - UMain, - UCommon, - SysUtils, - UGraphic; - -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; - - //Log.LogStatus( '' , '---------------------------'); - - //Log.LogStatus( 'Font' , '---------------------------'); - 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].Done := -1; - Fonts[0].Outline := 0; - - //Log.LogStatus( 'FontB' , '---------------------------'); - - Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[1].Tex.H := 30; - Fonts[1].AspectW := 1; - Fonts[1].Done := -1; - Fonts[1].Outline := 0; - - //Log.LogStatus( 'FontO' , '---------------------------'); - Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[2].Tex.H := 30; - Fonts[2].AspectW := 0.95; - Fonts[2].Done := -1; - Fonts[2].Outline := 5; - - //Log.LogStatus( 'FontO2' , '---------------------------'); - Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[3].Tex.H := 30; - Fonts[3].AspectW := 0.95; - Fonts[3].Done := -1; - 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;} - -end; - -// Deletes the font -procedure KillFont; -begin - // delete all characters - //glDeleteLists(base, 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 glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real); -begin - Fonts[ActFont].Done := Done; - PColR := ColR; - PColG := ColG; - PColB := ColB; - glPrintCut(text); - Fonts[ActFont].Done := -1; -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 -begin - with Fonts[ActFont].Tex do - begin - FWidth := Fonts[ActFont].Width[Ord(Letter)]; - - W := FWidth * (H/30) * Fonts[ActFont].AspectW; - - // set texture positions - TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024; - TexY := (ord(Letter) div 16) * 1/16 + 2/1024; - TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024; - TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; - - TexHeight := TexB - TexY; - - // set vector positions - PL := X - Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW /2; - PT := Y; - PR := PL + W + Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW; - PB := PT + H; - - if Fonts[ActFont].Italic = false then - XItal := 0 - else - XItal := 12; - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, TexNum); - - glBegin(GL_QUADS); - try - 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); - finally - glEnd; - end; - - // 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 Fonts[ActFont].Reflection = true then - begin - ReflectionSpacing := Fonts[ActFont].ReflectionSpacing + H/2; - - glDepthRange(0, 10); - glDepthFunc(GL_LEQUAL); - glEnable(GL_DEPTH_TEST); - - glBegin(GL_QUADS); - try - glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); - glTexCoord2f(TexX, TexY + TexHeight/2); - glVertex3f(PL, PB + ReflectionSpacing - H/2, z); - - glColor4f(TempColor[0], TempColor[1], TempColor[2], Alpha-0.3); - glTexCoord2f(TexX, TexB ); - glVertex3f(PL + XItal, PT + ReflectionSpacing, z); - - glTexCoord2f(TexR, TexB ); - glVertex3f(PR + XItal, PT + ReflectionSpacing, z); - - glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); - glTexCoord2f(TexR, TexY + TexHeight/2); - glVertex3f(PR, PB + ReflectionSpacing - H/2, z); - finally - glEnd; - end; - glDisable(GL_DEPTH_TEST); - end; // reflection - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - X := X + W; - end; // with - - //write the colour back - glColor4fv(PTempColor); -end; - -procedure glPrintLetterCut(letter: char; Start, Finish: real); -var - TexX, TexY: real; - TexR, TexB: real; - TexTemp: real; - FWidth: real; - PL, PT: real; - PR, PB: real; - OutTemp: real; - XItal: real; -begin - with Fonts[ActFont].Tex do - begin - FWidth := Fonts[ActFont].Width[Ord(Letter)]; - - W := FWidth * (H/30) * Fonts[ActFont].AspectW; - //H := 30; - OutTemp := Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW; - - // set texture positions - TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024; - TexY := (ord(Letter) div 16) * 1/16 + 2/1024; // 2/1024 - TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024; - TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; - - TexTemp := TexX + Start * (TexR - TexX); - TexR := TexX + Finish * (TexR - TexX); - TexX := TexTemp; - - // set vector positions - PL := X - OutTemp / 2 + OutTemp * Start; - PT := Y; - PR := PL + (W + OutTemp) * (Finish - Start); - PB := PT + H; - if Fonts[ActFont].Italic = false then - XItal := 0 - else - XItal := 12; - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, 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); // not tested with XItal - glEnd; - X := X + W * (Finish - Start); - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; // with - -end; - -// Custom GL "Print" Routine -procedure glPrint(text: pchar); -var - //Letter : char; - iPos : integer; -begin - if (Text = '') then // If There's No Text - Exit; // Do Nothing - -(* - while (length(text) > 0) do - begin - // cut - Letter := Text[0]; - Text := pchar(Copy(Text, 2, Length(Text)-1)); - - // print - glPrintLetter(Letter); - end; // while -*) - - //Save the actual color and alpha (for reflection) - PTempColor:= @TempColor; - //I've read that glGetFloat is quite slow, but it seems that there is no alternative - glGetFloatv(GL_CURRENT_COLOR, PTempColor); - - // This code is better, because doing a Copy of for every - // letter in a string is a waste of CPU & Memory resources. - // Copy operations are quite memory intensive, and this simple - // code achieves the same result. - for iPos := 0 to length( text ) - 1 do - begin - glPrintLetter( Text[iPos] ); - end; - -end; - -// tyty to Asphyre -// FIXME: check if the non-asm version is fast enough and use it by default if so -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; - -procedure glPrintCut(text: pchar); -var - Letter: char; - PToDo: real; - PTotWidth: real; - PDoingNow: real; - S: string; -begin - if (Text = '') then // If There's No Text - Exit; // Do Nothing - - PTotWidth := glTextWidth(Text); - PToDo := Fonts[ActFont].Done; - - while (length(text) > 0) do - begin - // cut - Letter := Text[0]; - Text := pchar(Copy(Text, 2, Length(Text)-1)); - - // analyze - S := Letter; - PDoingNow := glTextWidth(pchar(S)) / PTotWidth; - - // drawing - if (PToDo > 0) and (PDoingNow <= PToDo) then - glPrintLetter(Letter); - - if (PToDo > 0) and (PDoingNow > PToDo) then - begin - glPrintLetterCut(Letter, 0, PToDo / PDoingNow); - glColor3f(PColR, PColG, PColB); - glPrintLetterCut(Letter, PToDo / PDoingNow, 1); - end; - - if (PToDo <= 0) then - glPrintLetter(Letter); - - PToDo := PToDo - PDoingNow; - - end; // while -end; - - -procedure SetFontPos(X, Y: real); -begin - Fonts[ActFont].Tex.X := X; - Fonts[ActFont].Tex.Y := Y; -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; - -end. +unit TextGL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} + +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 glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real); +procedure glPrintLetter(letter: char); +procedure glPrintLetterCut(letter: char; Start, Finish: real); +procedure glPrint(text: pchar); // custom GL "Print" routine +procedure glPrintCut(text: pchar); +procedure SetFontPos(X, Y: real); // sets X and Y +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 + +// Start of SDL_ttf +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; +procedure printrandomtext(); +// End of SDL_ttf + +type + TTextGL = record + X: real; + Y: real; + Text: string; + Size: real; + ColR: real; + ColG: real; + ColB: real; + end; + + TFont = record + Tex: TTexture; + Width: array[0..255] of byte; + AspectW: real; + Centered: boolean; + Done: real; + Outline: real; + Italic: boolean; + Reflection: boolean; + ReflectionSpacing: real; + end; + + +var + base: GLuint; // base display list for the font set + Fonts: array of TFont; + ActFont: integer; + PColR: real; // temps for glPrintDone + PColG: real; + PColB: real; + + // Colours for the reflection + TempColor: array[0..3] of GLfloat; + PTempColor: PGLfloat; + +implementation + +uses + UMain, + UCommon, + SysUtils, + UGraphic; + +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; + + //Log.LogStatus( '' , '---------------------------'); + + //Log.LogStatus( 'Font' , '---------------------------'); + 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].Done := -1; + Fonts[0].Outline := 0; + + //Log.LogStatus( 'FontB' , '---------------------------'); + + Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[1].Tex.H := 30; + Fonts[1].AspectW := 1; + Fonts[1].Done := -1; + Fonts[1].Outline := 0; + + //Log.LogStatus( 'FontO' , '---------------------------'); + Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[2].Tex.H := 30; + Fonts[2].AspectW := 0.95; + Fonts[2].Done := -1; + Fonts[2].Outline := 5; + + //Log.LogStatus( 'FontO2' , '---------------------------'); + Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[3].Tex.H := 30; + Fonts[3].AspectW := 0.95; + Fonts[3].Done := -1; + 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;} + +end; + +// Deletes the font +procedure KillFont; +begin + // delete all characters + //glDeleteLists(base, 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 glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real); +begin + Fonts[ActFont].Done := Done; + PColR := ColR; + PColG := ColG; + PColB := ColB; + glPrintCut(text); + Fonts[ActFont].Done := -1; +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 +begin + with Fonts[ActFont].Tex do + begin + FWidth := Fonts[ActFont].Width[Ord(Letter)]; + + W := FWidth * (H/30) * Fonts[ActFont].AspectW; + + // set texture positions + TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024; + TexY := (ord(Letter) div 16) * 1/16 + 2/1024; + TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024; + TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; + + TexHeight := TexB - TexY; + + // set vector positions + PL := X - Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW /2; + PT := Y; + PR := PL + W + Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW; + PB := PT + H; + + if Fonts[ActFont].Italic = false then + XItal := 0 + else + XItal := 12; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, TexNum); + + glBegin(GL_QUADS); + try + 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); + finally + glEnd; + end; + + // 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 Fonts[ActFont].Reflection = true then + begin + ReflectionSpacing := Fonts[ActFont].ReflectionSpacing + H/2; + + glDepthRange(0, 10); + glDepthFunc(GL_LEQUAL); + glEnable(GL_DEPTH_TEST); + + glBegin(GL_QUADS); + try + glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); + glTexCoord2f(TexX, TexY + TexHeight/2); + glVertex3f(PL, PB + ReflectionSpacing - H/2, z); + + glColor4f(TempColor[0], TempColor[1], TempColor[2], Alpha-0.3); + glTexCoord2f(TexX, TexB ); + glVertex3f(PL + XItal, PT + ReflectionSpacing, z); + + glTexCoord2f(TexR, TexB ); + glVertex3f(PR + XItal, PT + ReflectionSpacing, z); + + glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); + glTexCoord2f(TexR, TexY + TexHeight/2); + glVertex3f(PR, PB + ReflectionSpacing - H/2, z); + finally + glEnd; + end; + glDisable(GL_DEPTH_TEST); + end; // reflection + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + X := X + W; + end; // with + + //write the colour back + glColor4fv(PTempColor); +end; + +procedure glPrintLetterCut(letter: char; Start, Finish: real); +var + TexX, TexY: real; + TexR, TexB: real; + TexTemp: real; + FWidth: real; + PL, PT: real; + PR, PB: real; + OutTemp: real; + XItal: real; +begin + with Fonts[ActFont].Tex do + begin + FWidth := Fonts[ActFont].Width[Ord(Letter)]; + + W := FWidth * (H/30) * Fonts[ActFont].AspectW; + //H := 30; + OutTemp := Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW; + + // set texture positions + TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024; + TexY := (ord(Letter) div 16) * 1/16 + 2/1024; // 2/1024 + TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024; + TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; + + TexTemp := TexX + Start * (TexR - TexX); + TexR := TexX + Finish * (TexR - TexX); + TexX := TexTemp; + + // set vector positions + PL := X - OutTemp / 2 + OutTemp * Start; + PT := Y; + PR := PL + (W + OutTemp) * (Finish - Start); + PB := PT + H; + if Fonts[ActFont].Italic = false then + XItal := 0 + else + XItal := 12; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, 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); // not tested with XItal + glEnd; + X := X + W * (Finish - Start); + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; // with + +end; + +// Custom GL "Print" Routine +procedure glPrint(text: pchar); +var + //Letter : char; + iPos : integer; +begin + if (Text = '') then // If There's No Text + Exit; // Do Nothing + +(* + while (length(text) > 0) do + begin + // cut + Letter := Text[0]; + Text := pchar(Copy(Text, 2, Length(Text)-1)); + + // print + glPrintLetter(Letter); + end; // while +*) + + //Save the actual color and alpha (for reflection) + PTempColor:= @TempColor; + //I've read that glGetFloat is quite slow, but it seems that there is no alternative + glGetFloatv(GL_CURRENT_COLOR, PTempColor); + + // This code is better, because doing a Copy of for every + // letter in a string is a waste of CPU & Memory resources. + // Copy operations are quite memory intensive, and this simple + // code achieves the same result. + for iPos := 0 to length( text ) - 1 do + begin + glPrintLetter( Text[iPos] ); + end; + +end; + +// tyty to Asphyre +// FIXME: check if the non-asm version is fast enough and use it by default if so +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; + +procedure glPrintCut(text: pchar); +var + Letter: char; + PToDo: real; + PTotWidth: real; + PDoingNow: real; + S: string; +begin + if (Text = '') then // If There's No Text + Exit; // Do Nothing + + PTotWidth := glTextWidth(Text); + PToDo := Fonts[ActFont].Done; + + while (length(text) > 0) do + begin + // cut + Letter := Text[0]; + Text := pchar(Copy(Text, 2, Length(Text)-1)); + + // analyze + S := Letter; + PDoingNow := glTextWidth(pchar(S)) / PTotWidth; + + // drawing + if (PToDo > 0) and (PDoingNow <= PToDo) then + glPrintLetter(Letter); + + if (PToDo > 0) and (PDoingNow > PToDo) then + begin + glPrintLetterCut(Letter, 0, PToDo / PDoingNow); + glColor3f(PColR, PColG, PColB); + glPrintLetterCut(Letter, PToDo / PDoingNow, 1); + end; + + if (PToDo <= 0) then + glPrintLetter(Letter); + + PToDo := PToDo - PDoingNow; + + end; // while +end; + + +procedure SetFontPos(X, Y: real); +begin + Fonts[ActFont].Tex.X := X; + Fonts[ActFont].Tex.Y := Y; +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; + +end. diff --git a/Game/Code/Classes/UAudioCore_Bass.pas b/Game/Code/Classes/UAudioCore_Bass.pas index e20d81c0..1f754be2 100644 --- a/Game/Code/Classes/UAudioCore_Bass.pas +++ b/Game/Code/Classes/UAudioCore_Bass.pas @@ -1,111 +1,111 @@ -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 - private - constructor Create(); - public - class function GetInstance(): TAudioCore_Bass; - function ErrorGetString(): string; overload; - function ErrorGetString(errCode: integer): string; overload; - function ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): 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; - -end. +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 + private + constructor Create(); + public + class function GetInstance(): TAudioCore_Bass; + function ErrorGetString(): string; overload; + function ErrorGetString(errCode: integer): string; overload; + function ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): 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; + +end. diff --git a/Game/Code/Classes/UAudioPlayback_Portaudio.pas b/Game/Code/Classes/UAudioPlayback_Portaudio.pas index 2c52c41e..b27fa83c 100644 --- a/Game/Code/Classes/UAudioPlayback_Portaudio.pas +++ b/Game/Code/Classes/UAudioPlayback_Portaudio.pas @@ -1,350 +1,350 @@ -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; - function OpenDevice(deviceIndex: TPaDeviceIndex): boolean; - function EnumDevices(): boolean; - protected - function InitializeAudioPlaybackEngine(): boolean; override; - function StartAudioPlaybackEngine(): boolean; override; - procedure StopAudioPlaybackEngine(); override; - function FinalizeAudioPlaybackEngine(): boolean; override; - public - function GetName: String; override; - end; - - TPortaudioOutputDevice = class(TAudioOutputDevice) - private - PaDeviceIndex: TPaDeviceIndex; - end; - -var - singleton_AudioPlaybackPortaudio : IAudioPlayback; - - -{ 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); - 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; - 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; - - 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; - inputParams: 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 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 if mic-callback works (might not be called on some devices) - if (not TAudioCore_Portaudio.TestDevice(@inputParams, nil, sampleRate)) then - begin - // ignore device if callback did not work - Log.LogError('Device "'+paDevice.Name+'" does not respond', - 'TAudioInput_Portaudio.InitializeRecord'); - 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.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('InputDevice "'+paDevice.Name+'"@' + - IntToStr(paDevice.AudioFormat.Channels)+'x'+ - FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+ - FloatTostr(inputParams.suggestedLatency)+'sec)' , - '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; - - -initialization - singleton_AudioPlaybackPortaudio := TAudioPlayback_Portaudio.create(); - AudioManager.add( singleton_AudioPlaybackPortaudio ); - -finalization - AudioManager.Remove( singleton_AudioPlaybackPortaudio ); - - -end. +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; + function OpenDevice(deviceIndex: TPaDeviceIndex): boolean; + function EnumDevices(): boolean; + protected + function InitializeAudioPlaybackEngine(): boolean; override; + function StartAudioPlaybackEngine(): boolean; override; + procedure StopAudioPlaybackEngine(); override; + function FinalizeAudioPlaybackEngine(): boolean; override; + public + function GetName: String; override; + end; + + TPortaudioOutputDevice = class(TAudioOutputDevice) + private + PaDeviceIndex: TPaDeviceIndex; + end; + +var + singleton_AudioPlaybackPortaudio : IAudioPlayback; + + +{ 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); + 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; + 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; + + 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; + inputParams: 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 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 if mic-callback works (might not be called on some devices) + if (not TAudioCore_Portaudio.TestDevice(@inputParams, nil, sampleRate)) then + begin + // ignore device if callback did not work + Log.LogError('Device "'+paDevice.Name+'" does not respond', + 'TAudioInput_Portaudio.InitializeRecord'); + 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.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('InputDevice "'+paDevice.Name+'"@' + + IntToStr(paDevice.AudioFormat.Channels)+'x'+ + FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+ + FloatTostr(inputParams.suggestedLatency)+'sec)' , + '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; + + +initialization + singleton_AudioPlaybackPortaudio := TAudioPlayback_Portaudio.create(); + AudioManager.add( singleton_AudioPlaybackPortaudio ); + +finalization + AudioManager.Remove( singleton_AudioPlaybackPortaudio ); + + +end. diff --git a/Game/Code/Classes/UAudioPlayback_SDL.pas b/Game/Code/Classes/UAudioPlayback_SDL.pas index 39ecc72f..14990855 100644 --- a/Game/Code/Classes/UAudioPlayback_SDL.pas +++ b/Game/Code/Classes/UAudioPlayback_SDL.pas @@ -1,150 +1,150 @@ -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 - function EnumDevices(): boolean; - protected - function InitializeAudioPlaybackEngine(): boolean; override; - function StartAudioPlaybackEngine(): boolean; override; - procedure StopAudioPlaybackEngine(); override; - function FinalizeAudioPlaybackEngine(): boolean; override; - public - function GetName: String; override; - procedure MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); override; - end; - -var - singleton_AudioPlaybackSDL : IAudioPlayback; - - -{ 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 defaults to 1024 samples - SampleBufferSize := 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; - - 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 - ); - - 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; - -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 - singleton_AudioPlaybackSDL := TAudioPlayback_SDL.create(); - AudioManager.add( singleton_AudioPlaybackSDL ); - -finalization - AudioManager.Remove( singleton_AudioPlaybackSDL ); - -end. +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 + function EnumDevices(): boolean; + protected + function InitializeAudioPlaybackEngine(): boolean; override; + function StartAudioPlaybackEngine(): boolean; override; + procedure StopAudioPlaybackEngine(); override; + function FinalizeAudioPlaybackEngine(): boolean; override; + public + function GetName: String; override; + procedure MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); override; + end; + +var + singleton_AudioPlaybackSDL : IAudioPlayback; + + +{ 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 defaults to 1024 samples + SampleBufferSize := 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; + + 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 + ); + + 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; + +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 + singleton_AudioPlaybackSDL := TAudioPlayback_SDL.create(); + AudioManager.add( singleton_AudioPlaybackSDL ); + +finalization + AudioManager.Remove( singleton_AudioPlaybackSDL ); + +end. diff --git a/Game/Code/Classes/UCatCovers.pas b/Game/Code/Classes/UCatCovers.pas index d8cebffa..36a69b8e 100644 --- a/Game/Code/Classes/UCatCovers.pas +++ b/Game/Code/Classes/UCatCovers.pas @@ -1,150 +1,150 @@ -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 [low(ISorting)..high(ISorting)] of array of string; - cFiles: array [low(ISorting)..high(ISorting)] of array of string; - public - constructor Create; - procedure Load; //Load Cover aus Cover.ini and Cover Folder - 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; - - //Load Cover aus Cover.ini and Cover Folder -procedure TCatCovers.Load; -var - Ini: TMemIniFile; - SR: TSearchRec; - List: TStringlist; - I, J: Integer; - Name, Filename, Temp: string; -begin - try - Ini := TMemIniFile.Create(CoversPath + 'covers.ini'); - List := TStringlist.Create; - - //Add every Cover in Covers Ini for Every Sorting option - for I := low(ISorting) 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 := low(ISorting) 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 := low(cNames[Sorting]) 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 := low(cNames[Sorting]) to high(cNames[Sorting]) do - begin - if cNames[Sorting][I] = Name then - begin - Result := cFiles[Sorting][I]; - Break; - end; - end; - - //No Cover - if (Result = '') AND (FileExists(CoversPath + 'NoCover.jpg')) then - Result := CoversPath + 'NoCover.jpg'; -end; - -end. +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 [low(ISorting)..high(ISorting)] of array of string; + cFiles: array [low(ISorting)..high(ISorting)] of array of string; + public + constructor Create; + procedure Load; //Load Cover aus Cover.ini and Cover Folder + 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; + + //Load Cover aus Cover.ini and Cover Folder +procedure TCatCovers.Load; +var + Ini: TMemIniFile; + SR: TSearchRec; + List: TStringlist; + I, J: Integer; + Name, Filename, Temp: string; +begin + try + Ini := TMemIniFile.Create(CoversPath + 'covers.ini'); + List := TStringlist.Create; + + //Add every Cover in Covers Ini for Every Sorting option + for I := low(ISorting) 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 := low(ISorting) 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 := low(cNames[Sorting]) 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 := low(cNames[Sorting]) to high(cNames[Sorting]) do + begin + if cNames[Sorting][I] = Name then + begin + Result := cFiles[Sorting][I]; + Break; + end; + end; + + //No Cover + if (Result = '') AND (FileExists(CoversPath + 'NoCover.jpg')) then + Result := CoversPath + 'NoCover.jpg'; +end; + +end. diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index f3edd62a..418c0c1a 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -1,791 +1,791 @@ -unit UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - Classes, - {$IFDEF MSWINDOWS} - Windows, - Messages, - {$ENDIF} - sdl, - ULog; - -{$IFNDEF DARWIN} -// FIXME: remove this if it is not needed anymore -type - hStream = THandle; - HGLRC = THandle; - TLargeInteger = Int64; - TWin32FindData = LongInt; -{$ENDIF} - -type - TMessageType = ( mtInfo, mtError ); - -procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo ); - -procedure ConsoleWriteLn(const msg: string); - -function GetResourceStream(const aName, aType : string): TStream; -function RWopsFromStream(Stream: TStream): PSDL_RWops; - -{$IFDEF FPC} -function RandomRange(aMin: Integer; aMax: Integer) : Integer; -{$ENDIF} - -{$IF Defined(MSWINDOWS) and Defined(FPC)} -function AllocateHWnd(Method: TWndMethod): HWND; -procedure DeallocateHWnd(hWnd: HWND); -{$IFEND} - -function StringReplaceW(text : WideString; search, rep: WideChar):WideString; -function AdaptFilePaths( const aPath : widestring ): widestring; - -procedure DisableFloatingPointExceptions(); -procedure SetDefaultNumericLocale(); -procedure RestoreNumericLocale(); - -{$IFNDEF 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); - - -implementation - -uses - Math, - {$IFDEF Delphi} - Dialogs, - {$ENDIF} - {$IFDEF LINUX} - libc, - {$ENDIF} - UMain, - UConfig; - -var - PrevNumLocale: string; - -// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '') -// to set the language/country specific locale (e.g. charset) for this application. -// Unfortunately, LC_NUMERIC is set by this call too. -// It defines the decimal-separator and other country-specific numeric settings. -// This parameter is used by the C string-to-float parsing functions atof() and strtod(). -// After changing LC_NUMERIC some external C-based libs (like projectM) are not -// able to parse strings correctly -// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is). -// So we reset the numeric settings to the default ('C'). -// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not -// changed by this because it doesn't use the locale-settings. -// TODO: -// - Check if this is needed in MacOSX (at least the locale is set in cwstring) -// - Find out which libs are concerned by this problem. -// If only projectM is concerned by this problem set and restore the numeric locale -// for each call to projectM instead of changing it globally. -procedure SetDefaultNumericLocale(); -begin - {$ifdef LINUX} - PrevNumLocale := setlocale(LC_NUMERIC, nil); - setlocale(LC_NUMERIC, 'C'); - {$endif} -end; - -procedure RestoreNumericLocale(); -begin - {$ifdef LINUX} - setlocale(LC_NUMERIC, PChar(PrevNumLocale)); - {$endif} -end; - -(* - * If an invalid floating point operation was performed the Floating-point unit (FPU) - * generates a Floating-point exception (FPE). Dependending on the settings in - * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself - * (we will call this as "FPE disabled" later on) or is passed to the application - * (FPE enabled). - * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is - * considered an error and an exception is thrown. Otherwise the FPU will handle - * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without - * throwing an error to the application. - * The same applies to a division by INF that either raises an exception - * (FPE enabled) or returns 0.0 (FPE disabled). - * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED - * on program startup (at least with Intel CPUs), but for some strange reasons - * they are ENABLED in pascal (both delphi and FPC) by default. - * Many libs operating with floating-point values rely heavily on the C-specific - * behaviour. So using them in delphi is a ticking time-bomb because sooner or - * later they will crash because of an FPE (this problem occurs massively - * in OpenGL-based libs like projectM). In contrast to this no error will occur - * if the lib is linked to a C-program. - * - * Further info on FPUs: - * For x86 and x86_64 CPUs we have to consider two FPU instruction sets. - * The math co-processor i387 (aka 8087 or x87) set introduced with the i386 - * and SSE (Streaming SIMD Extensions) introduced with the Pentium3. - * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR) - * to control FPEs. Either has (among others) 6bits to enable/disable several - * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision). - * Those exception-types must all be masked (=1) to get the default C behaviour. - * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE). - * Instead of using assembler code, we can use Set8087CW() provided by delphi and - * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR. - * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program - * startup but only FPC enables FPEs (especially div-by-zero) for SSE too. - * So we have to mask FPEs for x87 in Delphi and FPC and for SSE in FPC only. - * FPC and Delphi both provide a SetExceptionMask() for control of the FPE - * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE - * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask() - * is what we need and it even is plattform and CPU independent. - * - * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers) - * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL - * headers they do not work properly with FPC. I already patched them, so they - * work at least until they are updated the next time. In addition Set8086CW() - * does not suffice to disable FPEs because the SSE FPEs are not disabled by this. - * FPEs with SSE are a big problem with some libs because many linux distributions - * optimize code for SSE or Pentium3 (for example: int(INF) which convert the - * double value "infinity" to an integer might be automatically optimized by - * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case - * to make USDX portable. - * - * Summary: - * Call this function on initialization to make sure FPEs are turned off. - * It will solve a lot of errors with FPEs in external libs. - *) -procedure DisableFloatingPointExceptions(); -begin - (* - // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR(). - // Note: Leave these lines for documentation purposes just in case - // SetExceptionMask() does not work anymore (due to bugs in FPC etc.). - {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)} - Set8087CW($133F); - {$IFEND} - {$IF Defined(FPC)} - if (has_sse_support) then - SetSSECSR($1F80); - {$IFEND} - *) - - // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and - // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore). - SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, - exOverflow, exUnderflow, exPrecision]); -end; - -function StringReplaceW(text : WideString; search, rep: WideChar):WideString; -var - iPos : integer; -// sTemp : WideString; -begin -(* - result := text; - iPos := Pos(search, result); - while (iPos > 0) do - begin - sTemp := copy(result, iPos + length(search), length(result)); - result := copy(result, 1, iPos - 1) + rep + sTEmp; - iPos := Pos(search, result); - end; -*) - result := text; - - if search = rep then - exit; - - for iPos := 0 to length( result ) - 1 do - begin - if result[ iPos ] = search then - result[ iPos ] := rep; - end; -end; - -function AdaptFilePaths( const aPath : widestring ): widestring; -begin - result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); -end; - - -{$IFNDEF 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 here maybe ... from libc - lpPerformanceCount := RDTSC(); - result := true; -end; - -function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -begin - lpFrequency := 0; - result := true; -end; -*) -{$ENDIF} - -// Checks if a regular files or directory with the given name exists. -// The comparison is case insensitive. -function FileExistsInsensitive(var FileName: string): boolean; -var - FilePath, LocalFileName: string; - SearchInfo: TSearchRec; -begin -{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems - // speed up standard case - if FileExists(FileName) then - begin - Result := true; - exit; - end; - - Result := false; - - FilePath := ExtractFilePath(FileName); - if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then - begin - LocalFileName := ExtractFileName(FileName); - repeat - if (AnsiSameText(LocalFileName, SearchInfo.Name)) then - begin - FileName := FilePath + SearchInfo.Name; - Result := true; - break; - end; - until (FindNext(SearchInfo) <> 0); - end; - FindClose(SearchInfo); -{$ELSE} - Result := FileExists(FileName); -{$ENDIF} -end; - - -{$IFDEF 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} - -{$IF Defined(MSWINDOWS) and Defined(FPC)} -function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; -var - Msg: TMessage; - MethodPtr: ^TWndMethod; -begin - FillChar(Msg, SizeOf(Msg), 0); - Msg.msg := uMsg; - Msg.wParam := wParam; - Msg.lParam := lParam; - - MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA)); - if Assigned(MethodPtr) then - MethodPtr^(Msg); - - Result := DefWindowProc(hwnd, uMsg, wParam, lParam); -end; - -function AllocateHWnd(Method: TWndMethod): HWND; -var - ClassExists: Boolean; - WndClass, OldClass: TWndClass; - MethodPtr: ^TMethod; -begin - Result := 0; - - // setup class-info - FillChar(WndClass, SizeOf(TWndClass), 0); - WndClass.hInstance := HInstance; - // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned, - // otherwise race-conditions might occur - WndClass.lpfnWndProc := @DefWindowProc; - WndClass.lpszClassName:= 'USDXUtilWindowClass'; - - // check if class is already registered - ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass); - // create window-class shared by all windows created by AllocateHWnd() - if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then - begin - if ClassExists then - UnregisterClass(WndClass.lpszClassName, HInstance); - if (RegisterClass(WndClass) = 0) then - Exit; - end; - // create window - Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '', - DWORD(WS_POPUP), 0, 0, 0, 0, 0, 0, HInstance, nil); - if (Result = 0) then - Exit; - // assign individual callback procedure to the window - if Assigned(Method) then - begin - // TMethod contains two pointers but we can pass just one as USERDATA - GetMem(MethodPtr, SizeOf(TMethod)); - MethodPtr^ := TMethod(Method); - SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr)); - end; - // now enable AllocateHWndCallback for this window - SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback)); -end; - -procedure DeallocateHWnd(hWnd: HWND); -var - MethodPtr: ^TMethod; -begin - if (hWnd <> 0) then - begin - MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA)); - DestroyWindow(hWnd); - if Assigned(MethodPtr) then - FreeMem(MethodPtr); - end; -end; -{$IFEND} - -{$IFDEF FPC} -var - MessageList: TStringList; - ConsoleHandler: TThreadID; - // 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; - - -initialization - InitConsoleOutput(); - -finalization - FinalizeConsoleOutput(); - -end. +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes, + {$IFDEF MSWINDOWS} + Windows, + Messages, + {$ENDIF} + sdl, + ULog; + +{$IFNDEF DARWIN} +// FIXME: remove this if it is not needed anymore +type + hStream = THandle; + HGLRC = THandle; + TLargeInteger = Int64; + TWin32FindData = LongInt; +{$ENDIF} + +type + TMessageType = ( mtInfo, mtError ); + +procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo ); + +procedure ConsoleWriteLn(const msg: string); + +function GetResourceStream(const aName, aType : string): TStream; +function RWopsFromStream(Stream: TStream): PSDL_RWops; + +{$IFDEF FPC} +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +{$ENDIF} + +{$IF Defined(MSWINDOWS) and Defined(FPC)} +function AllocateHWnd(Method: TWndMethod): HWND; +procedure DeallocateHWnd(hWnd: HWND); +{$IFEND} + +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; +function AdaptFilePaths( const aPath : widestring ): widestring; + +procedure DisableFloatingPointExceptions(); +procedure SetDefaultNumericLocale(); +procedure RestoreNumericLocale(); + +{$IFNDEF 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); + + +implementation + +uses + Math, + {$IFDEF Delphi} + Dialogs, + {$ENDIF} + {$IFDEF LINUX} + libc, + {$ENDIF} + UMain, + UConfig; + +var + PrevNumLocale: string; + +// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '') +// to set the language/country specific locale (e.g. charset) for this application. +// Unfortunately, LC_NUMERIC is set by this call too. +// It defines the decimal-separator and other country-specific numeric settings. +// This parameter is used by the C string-to-float parsing functions atof() and strtod(). +// After changing LC_NUMERIC some external C-based libs (like projectM) are not +// able to parse strings correctly +// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is). +// So we reset the numeric settings to the default ('C'). +// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not +// changed by this because it doesn't use the locale-settings. +// TODO: +// - Check if this is needed in MacOSX (at least the locale is set in cwstring) +// - Find out which libs are concerned by this problem. +// If only projectM is concerned by this problem set and restore the numeric locale +// for each call to projectM instead of changing it globally. +procedure SetDefaultNumericLocale(); +begin + {$ifdef LINUX} + PrevNumLocale := setlocale(LC_NUMERIC, nil); + setlocale(LC_NUMERIC, 'C'); + {$endif} +end; + +procedure RestoreNumericLocale(); +begin + {$ifdef LINUX} + setlocale(LC_NUMERIC, PChar(PrevNumLocale)); + {$endif} +end; + +(* + * If an invalid floating point operation was performed the Floating-point unit (FPU) + * generates a Floating-point exception (FPE). Dependending on the settings in + * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself + * (we will call this as "FPE disabled" later on) or is passed to the application + * (FPE enabled). + * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is + * considered an error and an exception is thrown. Otherwise the FPU will handle + * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without + * throwing an error to the application. + * The same applies to a division by INF that either raises an exception + * (FPE enabled) or returns 0.0 (FPE disabled). + * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED + * on program startup (at least with Intel CPUs), but for some strange reasons + * they are ENABLED in pascal (both delphi and FPC) by default. + * Many libs operating with floating-point values rely heavily on the C-specific + * behaviour. So using them in delphi is a ticking time-bomb because sooner or + * later they will crash because of an FPE (this problem occurs massively + * in OpenGL-based libs like projectM). In contrast to this no error will occur + * if the lib is linked to a C-program. + * + * Further info on FPUs: + * For x86 and x86_64 CPUs we have to consider two FPU instruction sets. + * The math co-processor i387 (aka 8087 or x87) set introduced with the i386 + * and SSE (Streaming SIMD Extensions) introduced with the Pentium3. + * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR) + * to control FPEs. Either has (among others) 6bits to enable/disable several + * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision). + * Those exception-types must all be masked (=1) to get the default C behaviour. + * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE). + * Instead of using assembler code, we can use Set8087CW() provided by delphi and + * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR. + * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program + * startup but only FPC enables FPEs (especially div-by-zero) for SSE too. + * So we have to mask FPEs for x87 in Delphi and FPC and for SSE in FPC only. + * FPC and Delphi both provide a SetExceptionMask() for control of the FPE + * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE + * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask() + * is what we need and it even is plattform and CPU independent. + * + * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers) + * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL + * headers they do not work properly with FPC. I already patched them, so they + * work at least until they are updated the next time. In addition Set8086CW() + * does not suffice to disable FPEs because the SSE FPEs are not disabled by this. + * FPEs with SSE are a big problem with some libs because many linux distributions + * optimize code for SSE or Pentium3 (for example: int(INF) which convert the + * double value "infinity" to an integer might be automatically optimized by + * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case + * to make USDX portable. + * + * Summary: + * Call this function on initialization to make sure FPEs are turned off. + * It will solve a lot of errors with FPEs in external libs. + *) +procedure DisableFloatingPointExceptions(); +begin + (* + // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR(). + // Note: Leave these lines for documentation purposes just in case + // SetExceptionMask() does not work anymore (due to bugs in FPC etc.). + {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)} + Set8087CW($133F); + {$IFEND} + {$IF Defined(FPC)} + if (has_sse_support) then + SetSSECSR($1F80); + {$IFEND} + *) + + // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and + // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore). + SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, + exOverflow, exUnderflow, exPrecision]); +end; + +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; +var + iPos : integer; +// sTemp : WideString; +begin +(* + result := text; + iPos := Pos(search, result); + while (iPos > 0) do + begin + sTemp := copy(result, iPos + length(search), length(result)); + result := copy(result, 1, iPos - 1) + rep + sTEmp; + iPos := Pos(search, result); + end; +*) + result := text; + + if search = rep then + exit; + + for iPos := 0 to length( result ) - 1 do + begin + if result[ iPos ] = search then + result[ iPos ] := rep; + end; +end; + +function AdaptFilePaths( const aPath : widestring ): widestring; +begin + result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); +end; + + +{$IFNDEF 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 here maybe ... from libc + lpPerformanceCount := RDTSC(); + result := true; +end; + +function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +begin + lpFrequency := 0; + result := true; +end; +*) +{$ENDIF} + +// Checks if a regular files or directory with the given name exists. +// The comparison is case insensitive. +function FileExistsInsensitive(var FileName: string): boolean; +var + FilePath, LocalFileName: string; + SearchInfo: TSearchRec; +begin +{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems + // speed up standard case + if FileExists(FileName) then + begin + Result := true; + exit; + end; + + Result := false; + + FilePath := ExtractFilePath(FileName); + if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then + begin + LocalFileName := ExtractFileName(FileName); + repeat + if (AnsiSameText(LocalFileName, SearchInfo.Name)) then + begin + FileName := FilePath + SearchInfo.Name; + Result := true; + break; + end; + until (FindNext(SearchInfo) <> 0); + end; + FindClose(SearchInfo); +{$ELSE} + Result := FileExists(FileName); +{$ENDIF} +end; + + +{$IFDEF 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} + +{$IF Defined(MSWINDOWS) and Defined(FPC)} +function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; +var + Msg: TMessage; + MethodPtr: ^TWndMethod; +begin + FillChar(Msg, SizeOf(Msg), 0); + Msg.msg := uMsg; + Msg.wParam := wParam; + Msg.lParam := lParam; + + MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA)); + if Assigned(MethodPtr) then + MethodPtr^(Msg); + + Result := DefWindowProc(hwnd, uMsg, wParam, lParam); +end; + +function AllocateHWnd(Method: TWndMethod): HWND; +var + ClassExists: Boolean; + WndClass, OldClass: TWndClass; + MethodPtr: ^TMethod; +begin + Result := 0; + + // setup class-info + FillChar(WndClass, SizeOf(TWndClass), 0); + WndClass.hInstance := HInstance; + // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned, + // otherwise race-conditions might occur + WndClass.lpfnWndProc := @DefWindowProc; + WndClass.lpszClassName:= 'USDXUtilWindowClass'; + + // check if class is already registered + ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass); + // create window-class shared by all windows created by AllocateHWnd() + if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then + begin + if ClassExists then + UnregisterClass(WndClass.lpszClassName, HInstance); + if (RegisterClass(WndClass) = 0) then + Exit; + end; + // create window + Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '', + DWORD(WS_POPUP), 0, 0, 0, 0, 0, 0, HInstance, nil); + if (Result = 0) then + Exit; + // assign individual callback procedure to the window + if Assigned(Method) then + begin + // TMethod contains two pointers but we can pass just one as USERDATA + GetMem(MethodPtr, SizeOf(TMethod)); + MethodPtr^ := TMethod(Method); + SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr)); + end; + // now enable AllocateHWndCallback for this window + SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback)); +end; + +procedure DeallocateHWnd(hWnd: HWND); +var + MethodPtr: ^TMethod; +begin + if (hWnd <> 0) then + begin + MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA)); + DestroyWindow(hWnd); + if Assigned(MethodPtr) then + FreeMem(MethodPtr); + end; +end; +{$IFEND} + +{$IFDEF FPC} +var + MessageList: TStringList; + ConsoleHandler: TThreadID; + // 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; + + +initialization + InitConsoleOutput(); + +finalization + FinalizeConsoleOutput(); + +end. diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index 2e1304de..cb632b79 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -1,510 +1,510 @@ -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); -end; - -//------------- -// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) -//------------- -function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer; -begin - Hooks.CallEventChain(hDebug, wParam, lParam); -end; - -//------------- -// Calls Translate hook -//------------- -function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer; -begin - Hooks.CallEventChain(hTranslate, 1, nil); -end; - -//------------- -// Calls LoadTextures hook -//------------- -function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer; -begin - Hooks.CallEventChain(hLoadTextures, 1, nil); -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; -begin - if (Pointer(lParam) = nil) then - begin - Result := Length(Modules); - end - else - begin - try - for Result := 0 to High(Modules) do - begin - AModuleInfo(Pointer(lParam))[Result].Name := Modules[Result].Info.Name; - AModuleInfo(Pointer(lParam))[Result].Version := Modules[Result].Info.Version; - AModuleInfo(Pointer(lParam))[Result].Description := Modules[Result].Info.Description; - end; - 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. +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); +end; + +//------------- +// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hDebug, wParam, lParam); +end; + +//------------- +// Calls Translate hook +//------------- +function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hTranslate, 1, nil); +end; + +//------------- +// Calls LoadTextures hook +//------------- +function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hLoadTextures, 1, nil); +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; +begin + if (Pointer(lParam) = nil) then + begin + Result := Length(Modules); + end + else + begin + try + for Result := 0 to High(Modules) do + begin + AModuleInfo(Pointer(lParam))[Result].Name := Modules[Result].Info.Name; + AModuleInfo(Pointer(lParam))[Result].Version := Modules[Result].Info.Version; + AModuleInfo(Pointer(lParam))[Result].Description := Modules[Result].Info.Description; + end; + 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/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas index d82fef33..6f918fb2 100644 --- a/Game/Code/Classes/UDraw.pas +++ b/Game/Code/Classes/UDraw.pas @@ -1,1340 +1,1340 @@ -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 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; - - glBegin(GL_LINE_STRIP); - for SampleIndex := 0 to High(Sound.BufferArray) do - begin - glVertex2f(X + MaxX * SampleIndex/High(Sound.BufferArray), - Y + MaxY * (1 - Sound.BufferArray[SampleIndex]/-Low(Smallint))); - end; - glEnd; -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 = LineState.CurrentBeatD) then - Rec.Right := Rec.Right - (1-Frac(LineState.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*(LineState.CurrentTime - GetTimeFromBeat(Start+Length)); - if not (Start+Length-1 = LineState.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; - -procedure SingDraw; -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; - - // background //BG Fullsize Mod - //SingDrawBackground; - - //TimeBar mod - SingDrawTimeBar(); - //eoa TimeBar mod - - // rysuje paski pod nutami - 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 - ScreenSing.Lyrics.Draw(LineState.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 - LineState.MidBeat > 0) and // przed tekstem - (Lines[0].Line[Lines[0].Current].StartNote - LineState.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (LineState.MidBeat - (Lines[0].Line[Lines[0].Current].StartNote - BarFrom)) / BarFrom; - Rec.Left := NR.Left + BarWspol * -// (NR.WMid - Lines[0].Line[Lines[0].Current].LyricWidth / 2 * FS - 50); - (ScreenSing.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; -{ // zapalanie - BarAlpha := (BarWspol*10) * 0.5; - if BarAlpha > 0.5 then BarAlpha := 0.5; - - // gaszenie - if BarWspol > 0.95 then BarAlpha := 0.5 * (1 - (BarWspol - 0.95) * 20);}{ - - //Change fuer Crazy Joker - - 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 - 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(LineState.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 - LineState.MidBeat > 0) and // przed tekstem - (Lines[0].Line[Lines[0].Current].StartNote - LineState.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (LineState.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; - lTmp : 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); - try - glTexCoord2f(0, 0); - glVertex2f(x,y); - - if ( LineState.CurrentTime > 0 ) AND - ( LineState.TotalTime > 0 ) THEN - BEGIN - lTmp := LineState.CurrentTime/LineState.TotalTime; - glTexCoord2f((width*LineState.CurrentTime/LineState.TotalTime)/8, 0); - glVertex2f(x+width*LineState.CurrentTime/LineState.TotalTime, y); - - glTexCoord2f((width*LineState.CurrentTime/LineState.TotalTime)/8, 1); - glVertex2f(x+width*LineState.CurrentTime/LineState.TotalTime, y+height); - END; - - glTexCoord2f(0, 1); - glVertex2f(x, y+height); - finally - glEnd; - end; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - glcolor4f(1,1,1,1); -end; - -end. - +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 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; + + glBegin(GL_LINE_STRIP); + for SampleIndex := 0 to High(Sound.BufferArray) do + begin + glVertex2f(X + MaxX * SampleIndex/High(Sound.BufferArray), + Y + MaxY * (1 - Sound.BufferArray[SampleIndex]/-Low(Smallint))); + end; + glEnd; +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 = LineState.CurrentBeatD) then + Rec.Right := Rec.Right - (1-Frac(LineState.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*(LineState.CurrentTime - GetTimeFromBeat(Start+Length)); + if not (Start+Length-1 = LineState.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; + +procedure SingDraw; +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; + + // background //BG Fullsize Mod + //SingDrawBackground; + + //TimeBar mod + SingDrawTimeBar(); + //eoa TimeBar mod + + // rysuje paski pod nutami + 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 + ScreenSing.Lyrics.Draw(LineState.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 - LineState.MidBeat > 0) and // przed tekstem + (Lines[0].Line[Lines[0].Current].StartNote - LineState.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (LineState.MidBeat - (Lines[0].Line[Lines[0].Current].StartNote - BarFrom)) / BarFrom; + Rec.Left := NR.Left + BarWspol * +// (NR.WMid - Lines[0].Line[Lines[0].Current].LyricWidth / 2 * FS - 50); + (ScreenSing.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; +{ // zapalanie + BarAlpha := (BarWspol*10) * 0.5; + if BarAlpha > 0.5 then BarAlpha := 0.5; + + // gaszenie + if BarWspol > 0.95 then BarAlpha := 0.5 * (1 - (BarWspol - 0.95) * 20);}{ + + //Change fuer Crazy Joker + + 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 + 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(LineState.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 - LineState.MidBeat > 0) and // przed tekstem + (Lines[0].Line[Lines[0].Current].StartNote - LineState.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (LineState.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; + lTmp : 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); + try + glTexCoord2f(0, 0); + glVertex2f(x,y); + + if ( LineState.CurrentTime > 0 ) AND + ( LineState.TotalTime > 0 ) THEN + BEGIN + lTmp := LineState.CurrentTime/LineState.TotalTime; + glTexCoord2f((width*LineState.CurrentTime/LineState.TotalTime)/8, 0); + glVertex2f(x+width*LineState.CurrentTime/LineState.TotalTime, y); + + glTexCoord2f((width*LineState.CurrentTime/LineState.TotalTime)/8, 1); + glVertex2f(x+width*LineState.CurrentTime/LineState.TotalTime, y+height); + END; + + glTexCoord2f(0, 1); + glVertex2f(x, y+height); + finally + glEnd; + end; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + glcolor4f(1,1,1,1); +end; + +end. + diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas index b7792cc1..b7174991 100644 --- a/Game/Code/Classes/UGraphicClasses.pas +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -1,673 +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. - +// 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/Game/Code/Classes/UImage.pas b/Game/Code/Classes/UImage.pas index 0cafeee5..5dd326e7 100644 --- a/Game/Code/Classes/UImage.pas +++ b/Game/Code/Classes/UImage.pas @@ -1,769 +1,769 @@ -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 - ); - - -{$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} - -function LoadImage(const Identifier: string): PSDL_Surface; - -implementation - -uses - SysUtils, - Classes, - {$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, - 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; - -(*************************** - * 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} - -(* - * 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+'"', 'TTextureUnit.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+'"', 'TTextureUnit.LoadImage'); - Exit; - end; - - TexRWops := RWopsFromStream(TexStream); - if (TexRWops = nil) then - begin - Log.LogError( 'Could not assign resource "'+Identifier+'"', 'TTextureUnit.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+'"', 'TTextureUnit.LoadImage'); - end; - - SDL_FreeRW(TexRWops); - TexStream.Free(); - end; -end; - -end. +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 + ); + + +{$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} + +function LoadImage(const Identifier: string): PSDL_Surface; + +implementation + +uses + SysUtils, + Classes, + {$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, + 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; + +(*************************** + * 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} + +(* + * 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+'"', 'TTextureUnit.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+'"', 'TTextureUnit.LoadImage'); + Exit; + end; + + TexRWops := RWopsFromStream(TexStream); + if (TexRWops = nil) then + begin + Log.LogError( 'Could not assign resource "'+Identifier+'"', 'TTextureUnit.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+'"', 'TTextureUnit.LoadImage'); + end; + + SDL_FreeRW(TexRWops); + TexStream.Free(); + end; +end; + +end. diff --git a/Game/Code/Classes/UJoystick.pas b/Game/Code/Classes/UJoystick.pas index 59a1221b..0ca7ba09 100644 --- a/Game/Code/Classes/UJoystick.pas +++ b/Game/Code/Classes/UJoystick.pas @@ -1,282 +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. +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/Game/Code/Classes/ULCD.pas b/Game/Code/Classes/ULCD.pas index 4bbddf46..82f7ba2f 100644 --- a/Game/Code/Classes/ULCD.pas +++ b/Game/Code/Classes/ULCD.pas @@ -1,304 +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. - +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/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 22241d23..95502df8 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -1,416 +1,416 @@ -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].BufferLong.Seek(0, soBeginning); - FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong, AudioInputProcessor.Sound[SoundNr].BufferLong.Size); - - FS.Free; -end; - -procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; 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. - - +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].BufferLong.Seek(0, soBeginning); + FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong, AudioInputProcessor.Sound[SoundNr].BufferLong.Size); + + FS.Free; +end; + +procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; 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/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas index 05d7682e..dff7dec1 100644 --- a/Game/Code/Classes/ULyrics.pas +++ b/Game/Code/Classes/ULyrics.pas @@ -1,753 +1,753 @@ -unit ULyrics; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - gl, - glext, - UTexture, - UThemes, - UMusic; - -type - 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; - - PLyricLine = ^TLyricLine; - TLyricLine = record - 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: Cardinal; // start of this line in quarters - Length: Cardinal; // length in quarters - 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) - Done: Boolean; // is sentence already sung? - LastLine: Boolean; // is this the last line ob the song? - end; - - TLyricEngine = class - private - EoLastSentence: Real; // end of the previous sentence (in beats) - LastDrawBeat: Real; - UpperLine: TLyricLine; // first line displayed (top) - LowerLine: TLyricLine; // second lind displayed (bottom) - QueueLine: TLyricLine; // third line (queue and will be displayed when next line is finished) - PUpperLine, PLowerLine, PQueueLine: PLyricLine; - - IndicatorTex: TTexture; // texture for lyric indikator - BallTex: TTexture; // texture of the ball for the lyric effect - - inQueue: Boolean; // is line in queue - LCounter: Word; // line counter - - // duet mode - textures for player icons - PlayerIconTex: array[0..5] of // player idx - array [0..1] of // enabled disabled - TTexture; - - - //Some helper Procedures for Lyric Drawing - procedure DrawLyrics (Beat: Real); - procedure DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: PLyricLine; Beat: Real); - procedure DrawPlayerIcon(const Player: Byte; const Enabled: Boolean; const X, Y, Size, Alpha: Real); - procedure DrawBall(const 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 LineinQueue: Boolean read inQueue; // 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 - - Procedure Clear (const cBPM: Real = 0; // clears all cached song specific information - const cResolution: Integer = 0); - - 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, - 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; - - - -//--------------- -// Create - Constructor, just get Memory -//--------------- -Constructor TLyricEngine.Create; -begin - inherited; - - BPM := 0; - Resolution := 0; - LCounter := 0; - inQueue := False; - - UpperLine.Done := True; - LowerLine.Done := True; - QueueLine.Done := True; - PUpperline:=@UpperLine; - PLowerLine:=@LowerLine; - PQueueLine:=@QueueLine; - - 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 - inherited; -end; - -//--------------- -// Clear - Clears all cached Song specific Information -//--------------- -Procedure TLyricEngine.Clear (const cBPM: Real; const cResolution: Integer); -begin - BPM := cBPM; - Resolution := cResolution; - LCounter := 0; - inQueue := False; - - UpperLine.Done := True; - LowerLine.Done := True; - QueueLine.Done := True; - - PUpperline:=@UpperLine; - PLowerLine:=@LowerLine; - PQueueLine:=@QueueLine; - - LastDrawBeat:=0; -end; - - -//--------------- -// LoadTextures - Load Player Textures and Create Lyric Textures -//--------------- -Procedure TLyricEngine.LoadTextures; -var - I: Integer; - - function CreateLineTex: glUint; - var - PTexData: Pointer; - begin - try - // get memory - GetMem(pTexData, 1024*64*4); - - // generate and bind Texture - glGenTextures(1, @Result); - glBindTexture(GL_TEXTURE_2D, Result); - - // get texture memeory - glTexImage2D(GL_TEXTURE_2D, 0, 4, 1024, 64, 0, GL_RGBA, GL_UNSIGNED_BYTE, pTexData); - 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; - - finally - // free unused memory - FreeMem(pTexData); - 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 -//--------------- -Procedure TLyricEngine.AddLine(Line: PLine); -var - LyricLine: PLyricLine; - countNotes: Cardinal; - Viewport: Array[0..3] of Integer; - - PosX: Real; - I: Integer; - - function CalcWidth(LyricLine: PLyricLine): 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 LineinQueue then - begin - // set pointer to line to write - - If (LineCounter = 0) then - LyricLine := PUpperLine - else if (LineCounter = 1) then - LyricLine := PLowerLine - else - begin - LyricLine := PQueueLine; - - //now there is a queued line - inQueue := True; - end; - end - else - begin // rotate lines (round-robin-like) - LyricLine := PUpperLine; - PUpperLine := PLowerLine; - PLowerLine := PQueueLine; - PQueueLine := LyricLine; - end; - - // sentence has notes? - If Line = nil then - begin - // reset all values, if the new line is nil (lines after the last line) - LyricLine.Start := 0; - LyricLine.Length := 0; - LyricLine.CurWord := -1; - LyricLine.LastLine := False; - LyricLine.Width := 0; - SetLength(LyricLine.Words, 0); - end - else if Length(Line.Note) > 0 then - begin - // copy values from SongLine to LyricLine - CountNotes := High(Line.Note); - LyricLine.Start := Line.Note[0].Start; - LyricLine.Length := Line.Note[CountNotes].Start + Line.Note[CountNotes].Length - LyricLine.Start; - LyricLine.CurWord := -1; - LyricLine.LastLine := Line.LastLine; - - // default values - set later - LyricLine.HasFreestyle := False; - LyricLine.CountFreestyle := 0; - LyricLine.Text := ''; - - // duet mode: players of that line - LyricLine.Players := 127; - - //copy words - SetLength(LyricLine.Words, CountNotes + 1); - For I := 0 to CountNotes 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 - Inc(LyricLine.CountFreestyle); - end; - - // set font params - SetFontStyle(FontStyle); - SetFontPos(0, 0); - LyricLine.Size := UpperLineSize; - SetFontSize(LyricLine.Size); - SetFontItalic(False); - 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; - - // create LyricTexture - prepare OpenGL - glGetIntegerv(GL_VIEWPORT, @ViewPort); - glClearColor(0.0,0.0,0.0,0.0); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - glViewPort(0,0,800,600); - - // set word positions and line size - PosX := 0; - for I := 0 to High(LyricLine.Words) do - begin - with LyricLine.Words[I] do - begin - SetFontItalic(Freestyle); - - X := PosX; - - //Draw Lyrics - SetFontPos(PosX, 0); - glPrint(PChar(Text)); - - Width := glTextWidth(PChar(Text)); - if (I < High(LyricLine.Words)) AND Freestyle AND not LyricLine.Words[I+1].Freestyle then - Width := Width + 10 - else - if (I = High(LyricLine.Words)) AND Freestyle then - Width := Width + 12; - PosX := PosX + Width; - end; - end; - end - else - begin - // create LyricTexture - prepare OpenGL - glGetIntegerv(GL_VIEWPORT, @ViewPort); - glClearColor(0.0,0.0,0.0,0.0); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - glViewPort(0,0,800,600); - end; - - //for debugging, is this used anymore? - //Display.ScreenShot; - - //Copy to Texture - glEnable(GL_ALPHA); - glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); - glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 600-64, 1024, 64, 0); - glDisable(GL_ALPHA); - - //Clear Buffer - glClearColor(0,0,0,0); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - - glViewPort(ViewPort[0], ViewPort[1], ViewPort[2], ViewPort[3]); - - //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, PUpperline, Beat); - DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, PLowerline, Beat); -end; - -//--------------- -// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon -//--------------- -procedure TLyricEngine.DrawPlayerIcon(const Player: Byte; const Enabled: Boolean; const X, Y, Size, Alpha: Real); -var IEnabled: Byte; -begin - Case Enabled of - True: IEnabled := 0; - False: IEnabled := 1; - end; - - try - 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; - - finally - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; -end; - -//--------------- -// DrawBall(private) - Helper for Draw; Draws the Ball over the LyricLine if needed -//--------------- -procedure TLyricEngine.DrawBall(const XBall, YBall, Alpha:Real); -begin - try - 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; - - finally - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; -end; - -//--------------- -// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine -//--------------- -procedure TLyricEngine.DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: PLyricLine; 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 - - {// duet mode - IconSize: Real; // size of player icons - IconAlpha: Real; // alpha level of player icons - } -begin - // lines with a width lower than 0, have not to be draw - if Line^.Width <= 0 then - exit; - - // 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; - - // word in the sentence is active? - if (Line^.Start < Beat) then - begin - // if this line just got active, then CurWord is still -1 - // this means, we should try to make the first word active - // then we check if the current active word is still meant to be active - // if not, we proceed to the next word - if Line^.CurWord = -1 then - Line^.CurWord:=0; - - if (Line^.CurWord < High(Line^.Words)) AND (Beat >= (Line^.Words[Line^.CurWord + 1].Start)) then - Line^.CurWord:=Line^.CurWord+1; - - FreestyleDiff := 0; - - // last word of this line finished, but this line did not hide - if (Line^.CurWord > High(Line^.Words)) then - begin - CurWordStart := Line^.Words[High(Line^.Words)].X + Line^.Words[High(Line^.Words)].Width; - CurWordEnd := CurWordStart; - - // fade out last line - if Line^.LastLine then - begin - Alpha := 1 - (Beat - (Line^.Words[High(Line^.Words)].Start + Line^.Words[High(Line^.Words)].Length)) / 15; - if (Alpha < 0) then - Alpha := 0; - end; - end - else - begin - with Line^.Words[Line^.CurWord] do - begin - Progress := (Beat - Start) / Length; - if Progress >= 1 then - Progress := 1; - - if Progress <= 0 then - Progress := 0; - - CurWordStart:=X; - CurWordEnd:=X+Width; - - // Slide Effect - // simply paint the active texture to the current position - if Ini.LyricsEffect = 2 then - begin - CurWordStart := CurWordStart + Width * progress; - CurWordEnd := CurWordStart; - end; - - if (Line^.CurWord < High(Line^.Words)) AND Freestyle AND not Line^.Words[Line^.CurWord + 1].Freestyle then - begin - FreestyleDiff := 2; - end - else - if Freestyle then - begin - FreestyleDiff := 12; - CurWordStart := CurWordStart - 1; - CurWordEnd := CurWordEnd - 2; - end; - 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 - if (Ini.LyricsEffect = 3) or (Ini.LyricsEffect = 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); - 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 = 0) or (Ini.LyricsEffect = 3) or (Ini.LyricsEffect = 4) then - begin - { // maybe fade in? - glColor4f(LineColor_en.r,LineColor_en.g,LineColor_en.b,1-progress); - glBegin(GL_QUADS); - glTexCoord2f(CurWordStart/1024, 1); glVertex2f(LyricX+CurWordStart, Y); - glTexCoord2f(CurWordStart/1024, 0); glVertex2f(LyricX+CurWordStart, Y + 64); - glTexCoord2f(CurWordEnd/1024, 0); glVertex2f(LyricX+CurWordEnd, Y + 64); - glTexCoord2f(CurWordEnd/1024, 1); glVertex2f(LyricX+CurWordEnd, Y); - glEnd; - } - - if (Ini.LyricsEffect = 4) then - LyricY := LyricY - 8 * (1-progress); - - glColor3f(LineColor_act.r,LineColor_act.g,LineColor_act.b); - 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); - glScalef(1.0+(1-progress)/2,1.0+(1-progress)/2,1.0); - glColor4f(LineColor_en.r,LineColor_en.g,LineColor_en.b,1-progress); - 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; - glColor4f(LineColor_act.r,LineColor_act.g,LineColor_act.b,1); - 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); - - if Ini.LyricsEffect = 3 then - DrawBall(LyricX + CurWordStart + (CurWordEnd - CurWordStart) * progress, LyricY - 15 - 15*sin(progress * pi), Alpha); - end - else - begin - // draw complete inactive sentence if line hasn't started but is already shown - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Line^.Tex); - - 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; - - -end. - +unit ULyrics; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + gl, + glext, + UTexture, + UThemes, + UMusic; + +type + 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; + + PLyricLine = ^TLyricLine; + TLyricLine = record + 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: Cardinal; // start of this line in quarters + Length: Cardinal; // length in quarters + 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) + Done: Boolean; // is sentence already sung? + LastLine: Boolean; // is this the last line ob the song? + end; + + TLyricEngine = class + private + EoLastSentence: Real; // end of the previous sentence (in beats) + LastDrawBeat: Real; + UpperLine: TLyricLine; // first line displayed (top) + LowerLine: TLyricLine; // second lind displayed (bottom) + QueueLine: TLyricLine; // third line (queue and will be displayed when next line is finished) + PUpperLine, PLowerLine, PQueueLine: PLyricLine; + + IndicatorTex: TTexture; // texture for lyric indikator + BallTex: TTexture; // texture of the ball for the lyric effect + + inQueue: Boolean; // is line in queue + LCounter: Word; // line counter + + // duet mode - textures for player icons + PlayerIconTex: array[0..5] of // player idx + array [0..1] of // enabled disabled + TTexture; + + + //Some helper Procedures for Lyric Drawing + procedure DrawLyrics (Beat: Real); + procedure DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: PLyricLine; Beat: Real); + procedure DrawPlayerIcon(const Player: Byte; const Enabled: Boolean; const X, Y, Size, Alpha: Real); + procedure DrawBall(const 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 LineinQueue: Boolean read inQueue; // 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 + + Procedure Clear (const cBPM: Real = 0; // clears all cached song specific information + const cResolution: Integer = 0); + + 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, + 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; + + + +//--------------- +// Create - Constructor, just get Memory +//--------------- +Constructor TLyricEngine.Create; +begin + inherited; + + BPM := 0; + Resolution := 0; + LCounter := 0; + inQueue := False; + + UpperLine.Done := True; + LowerLine.Done := True; + QueueLine.Done := True; + PUpperline:=@UpperLine; + PLowerLine:=@LowerLine; + PQueueLine:=@QueueLine; + + 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 + inherited; +end; + +//--------------- +// Clear - Clears all cached Song specific Information +//--------------- +Procedure TLyricEngine.Clear (const cBPM: Real; const cResolution: Integer); +begin + BPM := cBPM; + Resolution := cResolution; + LCounter := 0; + inQueue := False; + + UpperLine.Done := True; + LowerLine.Done := True; + QueueLine.Done := True; + + PUpperline:=@UpperLine; + PLowerLine:=@LowerLine; + PQueueLine:=@QueueLine; + + LastDrawBeat:=0; +end; + + +//--------------- +// LoadTextures - Load Player Textures and Create Lyric Textures +//--------------- +Procedure TLyricEngine.LoadTextures; +var + I: Integer; + + function CreateLineTex: glUint; + var + PTexData: Pointer; + begin + try + // get memory + GetMem(pTexData, 1024*64*4); + + // generate and bind Texture + glGenTextures(1, @Result); + glBindTexture(GL_TEXTURE_2D, Result); + + // get texture memeory + glTexImage2D(GL_TEXTURE_2D, 0, 4, 1024, 64, 0, GL_RGBA, GL_UNSIGNED_BYTE, pTexData); + 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; + + finally + // free unused memory + FreeMem(pTexData); + 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 +//--------------- +Procedure TLyricEngine.AddLine(Line: PLine); +var + LyricLine: PLyricLine; + countNotes: Cardinal; + Viewport: Array[0..3] of Integer; + + PosX: Real; + I: Integer; + + function CalcWidth(LyricLine: PLyricLine): 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 LineinQueue then + begin + // set pointer to line to write + + If (LineCounter = 0) then + LyricLine := PUpperLine + else if (LineCounter = 1) then + LyricLine := PLowerLine + else + begin + LyricLine := PQueueLine; + + //now there is a queued line + inQueue := True; + end; + end + else + begin // rotate lines (round-robin-like) + LyricLine := PUpperLine; + PUpperLine := PLowerLine; + PLowerLine := PQueueLine; + PQueueLine := LyricLine; + end; + + // sentence has notes? + If Line = nil then + begin + // reset all values, if the new line is nil (lines after the last line) + LyricLine.Start := 0; + LyricLine.Length := 0; + LyricLine.CurWord := -1; + LyricLine.LastLine := False; + LyricLine.Width := 0; + SetLength(LyricLine.Words, 0); + end + else if Length(Line.Note) > 0 then + begin + // copy values from SongLine to LyricLine + CountNotes := High(Line.Note); + LyricLine.Start := Line.Note[0].Start; + LyricLine.Length := Line.Note[CountNotes].Start + Line.Note[CountNotes].Length - LyricLine.Start; + LyricLine.CurWord := -1; + LyricLine.LastLine := Line.LastLine; + + // default values - set later + LyricLine.HasFreestyle := False; + LyricLine.CountFreestyle := 0; + LyricLine.Text := ''; + + // duet mode: players of that line + LyricLine.Players := 127; + + //copy words + SetLength(LyricLine.Words, CountNotes + 1); + For I := 0 to CountNotes 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 + Inc(LyricLine.CountFreestyle); + end; + + // set font params + SetFontStyle(FontStyle); + SetFontPos(0, 0); + LyricLine.Size := UpperLineSize; + SetFontSize(LyricLine.Size); + SetFontItalic(False); + 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; + + // create LyricTexture - prepare OpenGL + glGetIntegerv(GL_VIEWPORT, @ViewPort); + glClearColor(0.0,0.0,0.0,0.0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + glViewPort(0,0,800,600); + + // set word positions and line size + PosX := 0; + for I := 0 to High(LyricLine.Words) do + begin + with LyricLine.Words[I] do + begin + SetFontItalic(Freestyle); + + X := PosX; + + //Draw Lyrics + SetFontPos(PosX, 0); + glPrint(PChar(Text)); + + Width := glTextWidth(PChar(Text)); + if (I < High(LyricLine.Words)) AND Freestyle AND not LyricLine.Words[I+1].Freestyle then + Width := Width + 10 + else + if (I = High(LyricLine.Words)) AND Freestyle then + Width := Width + 12; + PosX := PosX + Width; + end; + end; + end + else + begin + // create LyricTexture - prepare OpenGL + glGetIntegerv(GL_VIEWPORT, @ViewPort); + glClearColor(0.0,0.0,0.0,0.0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + glViewPort(0,0,800,600); + end; + + //for debugging, is this used anymore? + //Display.ScreenShot; + + //Copy to Texture + glEnable(GL_ALPHA); + glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 600-64, 1024, 64, 0); + glDisable(GL_ALPHA); + + //Clear Buffer + glClearColor(0,0,0,0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + + glViewPort(ViewPort[0], ViewPort[1], ViewPort[2], ViewPort[3]); + + //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, PUpperline, Beat); + DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, PLowerline, Beat); +end; + +//--------------- +// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon +//--------------- +procedure TLyricEngine.DrawPlayerIcon(const Player: Byte; const Enabled: Boolean; const X, Y, Size, Alpha: Real); +var IEnabled: Byte; +begin + Case Enabled of + True: IEnabled := 0; + False: IEnabled := 1; + end; + + try + 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; + + finally + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; +end; + +//--------------- +// DrawBall(private) - Helper for Draw; Draws the Ball over the LyricLine if needed +//--------------- +procedure TLyricEngine.DrawBall(const XBall, YBall, Alpha:Real); +begin + try + 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; + + finally + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; +end; + +//--------------- +// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine +//--------------- +procedure TLyricEngine.DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: PLyricLine; 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 + + {// duet mode + IconSize: Real; // size of player icons + IconAlpha: Real; // alpha level of player icons + } +begin + // lines with a width lower than 0, have not to be draw + if Line^.Width <= 0 then + exit; + + // 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; + + // word in the sentence is active? + if (Line^.Start < Beat) then + begin + // if this line just got active, then CurWord is still -1 + // this means, we should try to make the first word active + // then we check if the current active word is still meant to be active + // if not, we proceed to the next word + if Line^.CurWord = -1 then + Line^.CurWord:=0; + + if (Line^.CurWord < High(Line^.Words)) AND (Beat >= (Line^.Words[Line^.CurWord + 1].Start)) then + Line^.CurWord:=Line^.CurWord+1; + + FreestyleDiff := 0; + + // last word of this line finished, but this line did not hide + if (Line^.CurWord > High(Line^.Words)) then + begin + CurWordStart := Line^.Words[High(Line^.Words)].X + Line^.Words[High(Line^.Words)].Width; + CurWordEnd := CurWordStart; + + // fade out last line + if Line^.LastLine then + begin + Alpha := 1 - (Beat - (Line^.Words[High(Line^.Words)].Start + Line^.Words[High(Line^.Words)].Length)) / 15; + if (Alpha < 0) then + Alpha := 0; + end; + end + else + begin + with Line^.Words[Line^.CurWord] do + begin + Progress := (Beat - Start) / Length; + if Progress >= 1 then + Progress := 1; + + if Progress <= 0 then + Progress := 0; + + CurWordStart:=X; + CurWordEnd:=X+Width; + + // Slide Effect + // simply paint the active texture to the current position + if Ini.LyricsEffect = 2 then + begin + CurWordStart := CurWordStart + Width * progress; + CurWordEnd := CurWordStart; + end; + + if (Line^.CurWord < High(Line^.Words)) AND Freestyle AND not Line^.Words[Line^.CurWord + 1].Freestyle then + begin + FreestyleDiff := 2; + end + else + if Freestyle then + begin + FreestyleDiff := 12; + CurWordStart := CurWordStart - 1; + CurWordEnd := CurWordEnd - 2; + end; + 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 + if (Ini.LyricsEffect = 3) or (Ini.LyricsEffect = 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); + 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 = 0) or (Ini.LyricsEffect = 3) or (Ini.LyricsEffect = 4) then + begin + { // maybe fade in? + glColor4f(LineColor_en.r,LineColor_en.g,LineColor_en.b,1-progress); + glBegin(GL_QUADS); + glTexCoord2f(CurWordStart/1024, 1); glVertex2f(LyricX+CurWordStart, Y); + glTexCoord2f(CurWordStart/1024, 0); glVertex2f(LyricX+CurWordStart, Y + 64); + glTexCoord2f(CurWordEnd/1024, 0); glVertex2f(LyricX+CurWordEnd, Y + 64); + glTexCoord2f(CurWordEnd/1024, 1); glVertex2f(LyricX+CurWordEnd, Y); + glEnd; + } + + if (Ini.LyricsEffect = 4) then + LyricY := LyricY - 8 * (1-progress); + + glColor3f(LineColor_act.r,LineColor_act.g,LineColor_act.b); + 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); + glScalef(1.0+(1-progress)/2,1.0+(1-progress)/2,1.0); + glColor4f(LineColor_en.r,LineColor_en.g,LineColor_en.b,1-progress); + 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; + glColor4f(LineColor_act.r,LineColor_act.g,LineColor_act.b,1); + 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); + + if Ini.LyricsEffect = 3 then + DrawBall(LyricX + CurWordStart + (CurWordEnd - CurWordStart) * progress, LyricY - 15 - 15*sin(progress * pi), Alpha); + end + else + begin + // draw complete inactive sentence if line hasn't started but is already shown + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Line^.Tex); + + 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; + + +end. + diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas index abd8c1e0..62a94aef 100644 --- a/Game/Code/Classes/UMedia_dummy.pas +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -1,230 +1,230 @@ -unit UMedia_dummy; -{< ############################################################################# -# FFmpeg support for UltraStar deluxe # -# # -# Created by b1indy # -# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # -# # -# http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html # -# http://www.nabble.com/file/p11795857/mpegpas01.zip # -# # -############################################################################## } - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -implementation - -uses - SysUtils, - math, - UMusic; - -var - singleton_dummy : IVideoPlayback; - -type - TMedia_dummy = class( TInterfacedObject, IVideoPlayback, IVideoVisualization, IAudioPlayback, IAudioInput ) - private - DummyOutputDeviceList: TAudioOutputDeviceList; - public - constructor create(); - function GetName: string; - - procedure init(); - - 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); - - // 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 PlaySound(stream: TAudioPlaybackStream); - procedure StopSound(stream: TAudioPlaybackStream); - 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; - -procedure Tmedia_dummy.init(); -begin -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; - -// 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.PlaySound(stream: TAudioPlaybackStream); -begin -end; - -procedure Tmedia_dummy.StopSound(stream: TAudioPlaybackStream); -begin -end; - -initialization - singleton_dummy := Tmedia_dummy.create(); - AudioManager.add( singleton_dummy ); - -finalization - AudioManager.Remove( singleton_dummy ); - -end. +unit UMedia_dummy; +{< ############################################################################# +# FFmpeg support for UltraStar deluxe # +# # +# Created by b1indy # +# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # +# # +# http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html # +# http://www.nabble.com/file/p11795857/mpegpas01.zip # +# # +############################################################################## } + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +implementation + +uses + SysUtils, + math, + UMusic; + +var + singleton_dummy : IVideoPlayback; + +type + TMedia_dummy = class( TInterfacedObject, IVideoPlayback, IVideoVisualization, IAudioPlayback, IAudioInput ) + private + DummyOutputDeviceList: TAudioOutputDeviceList; + public + constructor create(); + function GetName: string; + + procedure init(); + + 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); + + // 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 PlaySound(stream: TAudioPlaybackStream); + procedure StopSound(stream: TAudioPlaybackStream); + 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; + +procedure Tmedia_dummy.init(); +begin +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; + +// 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.PlaySound(stream: TAudioPlaybackStream); +begin +end; + +procedure Tmedia_dummy.StopSound(stream: TAudioPlaybackStream); +begin +end; + +initialization + singleton_dummy := Tmedia_dummy.create(); + AudioManager.add( singleton_dummy ); + +finalization + AudioManager.Remove( singleton_dummy ); + +end. diff --git a/Game/Code/Classes/UModules.pas b/Game/Code/Classes/UModules.pas index fe623343..554a24c4 100644 --- a/Game/Code/Classes/UModules.pas +++ b/Game/Code/Classes/UModules.pas @@ -1,26 +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 - +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/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas index 5b9d2400..aac304f4 100644 --- a/Game/Code/Classes/UParty.pas +++ b/Game/Code/Classes/UParty.pas @@ -1,618 +1,618 @@ -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')); -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); - 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; -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); -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. +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')); +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); + 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; +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); +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/Game/Code/Classes/UPlatformWindows.pas b/Game/Code/Classes/UPlatformWindows.pas index 18cbebcb..3f9eb56b 100644 --- a/Game/Code/Classes/UPlatformWindows.pas +++ b/Game/Code/Classes/UPlatformWindows.pas @@ -1,226 +1,226 @@ -unit UPlatformWindows; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses Classes, - UPlatform; - -type - - TPlatformWindows = class( TInterfacedObject, IPlatform) - public - Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; - function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; - function GetGamePath: WideString; - function FindSongFile(Dir, Mask: widestring): widestring; - - procedure Halt; - - function GetLogPath : WideString; - function GetGameSharedPath : WideString; - function GetGameUserPath : WideString; - end; - -implementation - -uses SysUtils, - Windows; - -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; - lAttrib : 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 - lAttrib := FileGetAttr(Dir + SR.name); - if ReturnAllSubDirs and ((lAttrib 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; - -function TPlatformWindows.GetGamePath: WideString; -begin - // Windows and Linux use this: - Result := ExtractFilePath(ParamStr(0)); -end; - -procedure TPlatformWindows.Halt; -begin - System.Halt; // Application.terminate does NOT do the same thing.. -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 := ExtractFilePath(ParamStr(0)); -end; - -function TPlatformWindows.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; // if - SysUtils.FindClose(SR); -end; - - -end. +unit UPlatformWindows; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, + UPlatform; + +type + + TPlatformWindows = class( TInterfacedObject, IPlatform) + public + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; + function GetGamePath: WideString; + function FindSongFile(Dir, Mask: widestring): widestring; + + procedure Halt; + + function GetLogPath : WideString; + function GetGameSharedPath : WideString; + function GetGameUserPath : WideString; + end; + +implementation + +uses SysUtils, + Windows; + +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; + lAttrib : 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 + lAttrib := FileGetAttr(Dir + SR.name); + if ReturnAllSubDirs and ((lAttrib 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; + +function TPlatformWindows.GetGamePath: WideString; +begin + // Windows and Linux use this: + Result := ExtractFilePath(ParamStr(0)); +end; + +procedure TPlatformWindows.Halt; +begin + System.Halt; // Application.terminate does NOT do the same thing.. +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 := ExtractFilePath(ParamStr(0)); +end; + +function TPlatformWindows.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; // if + SysUtils.FindClose(SR); +end; + + +end. diff --git a/Game/Code/Classes/UPluginInterface.pas b/Game/Code/Classes/UPluginInterface.pas index 6a83d7c3..77693d0f 100644 --- a/Game/Code/Classes/UPluginInterface.pas +++ b/Game/Code/Classes/UPluginInterface.pas @@ -1,156 +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. +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/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas index 6a73521d..aa85625c 100644 --- a/Game/Code/Classes/UServices.pas +++ b/Game/Code/Classes/UServices.pas @@ -1,356 +1,356 @@ -unit UServices; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -{$IFDEF FPC} - {$ASMMODE Intel} -{$ENDIF} - -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)} -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)} -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. +unit UServices; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} + +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)} +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)} +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/Game/Code/Classes/USingNotes.pas b/Game/Code/Classes/USingNotes.pas index f0754105..3b268d10 100644 --- a/Game/Code/Classes/USingNotes.pas +++ b/Game/Code/Classes/USingNotes.pas @@ -1,13 +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. +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/Game/Code/Classes/UTextClasses.pas b/Game/Code/Classes/UTextClasses.pas index 9dce207e..fb74f34e 100644 --- a/Game/Code/Classes/UTextClasses.pas +++ b/Game/Code/Classes/UTextClasses.pas @@ -1,60 +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. +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/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas index 805bf51a..e38e08c2 100644 --- a/Game/Code/Classes/UThemes.pas +++ b/Game/Code/Classes/UThemes.pas @@ -1,2283 +1,2283 @@ -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; - 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; - - TThemeSelect = record - Tex: string; - TexSBG: string; - X: integer; - Y: integer; - W: integer; - H: 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; - - 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: TThemeSelect; - SelectDifficulty: TThemeSelect; - SelectLanguage: TThemeSelectSlide; - SelectTabs: TThemeSelect; - SelectSorting: TThemeSelectSlide; - SelectDebug: TThemeSelect; - ButtonExit: TThemeButton; - end; - - TThemeOptionsGraphics = class(TThemeBasic) - SelectFullscreen: TThemeSelect; - SelectSlideResolution: TThemeSelectSlide; - SelectDepth: TThemeSelect; - SelectOscilloscope: TThemeSelect; - SelectLineBonus: TThemeSelect; - SelectMovieSize: TThemeSelect; - ButtonExit: TThemeButton; - end; - - TThemeOptionsSound = class(TThemeBasic) - SelectMicBoost: TThemeSelect; - SelectClickAssist: TThemeSelect; - SelectBeatClick: TThemeSelect; - SelectThreshold: TThemeSelect; - //Song Preview - SelectSlidePreviewVolume: TThemeSelectSlide; - SelectSlidePreviewFading: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsLyrics = class(TThemeBasic) - SelectLyricsFont: TThemeSelect; - SelectLyricsEffect: TThemeSelectSlide; - SelectSolmization: TThemeSelect; - SelectNoteLines: TThemeSelect; - 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: TThemeSelect; - SelectEffectSing: TThemeSelect; - SelectScreenFade: TThemeSelect; - SelectLineBonus: TThemeSelect; - SelectAskbeforeDel: TThemeSelect; - SelectOnSongClick: TThemeSelectSlide; - SelectPartyPopup: TThemeSelect; - 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 ThemeLoadSelect(var ThemeSelect: TThemeSelect; 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'); - - ThemeLoadSelect(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers'); - ThemeLoadSelect(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty'); - ThemeLoadSelectSlide(OptionsGame.SelectLanguage, 'OptionsGameSelectSlideLanguage'); - ThemeLoadSelect(OptionsGame.SelectTabs, 'OptionsGameSelectTabs'); - ThemeLoadSelectSlide(OptionsGame.SelectSorting, 'OptionsGameSelectSlideSorting'); - ThemeLoadSelect(OptionsGame.SelectDebug, 'OptionsGameSelectDebug'); - ThemeLoadButton(OptionsGame.ButtonExit, 'OptionsGameButtonExit'); - - // Options Graphics - ThemeLoadBasic(OptionsGraphics, 'OptionsGraphics'); - - ThemeLoadSelect(OptionsGraphics.SelectFullscreen, 'OptionsGraphicsSelectFullscreen'); - ThemeLoadSelectSlide(OptionsGraphics.SelectSlideResolution, 'OptionsGraphicsSelectSlideResolution'); - ThemeLoadSelect(OptionsGraphics.SelectDepth, 'OptionsGraphicsSelectDepth'); - ThemeLoadSelect(OptionsGraphics.SelectOscilloscope, 'OptionsGraphicsSelectOscilloscope'); - ThemeLoadSelect(OptionsGraphics.SelectLineBonus, 'OptionsGraphicsSelectLineBonus'); - ThemeLoadSelect(OptionsGraphics.SelectMovieSize, 'OptionsGraphicsSelectMovieSize'); - ThemeLoadButton(OptionsGraphics.ButtonExit, 'OptionsGraphicsButtonExit'); - - // Options Sound - ThemeLoadBasic(OptionsSound, 'OptionsSound'); - - ThemeLoadSelect(OptionsSound.SelectMicBoost, 'OptionsSoundSelectMicBoost'); - ThemeLoadSelect(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist'); - ThemeLoadSelect(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick'); - ThemeLoadSelect(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold'); - //Song Preview - ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume'); - ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading'); - - ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); - - // Options Lyrics - ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); - - ThemeLoadSelect(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); - ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); - ThemeLoadSelect(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); - ThemeLoadSelect(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'); - - ThemeLoadSelect (OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation'); - ThemeLoadSelect (OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade'); - ThemeLoadSelect (OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing'); - ThemeLoadSelect (OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus'); - ThemeLoadSelectSlide (OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick'); - ThemeLoadSelect (OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); - ThemeLoadSelect (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.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.ThemeLoadSelect(var ThemeSelect: TThemeSelect; Name: string); -var - C: integer; -begin - ThemeSelect.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - - ThemeSelect.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', ''); - ThemeSelect.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', ''); - - ThemeSelect.X := ThemeIni.ReadInteger(Name, 'X', 0); - ThemeSelect.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeSelect.W := ThemeIni.ReadInteger(Name, 'W', 0); - ThemeSelect.H := ThemeIni.ReadInteger(Name, 'H', 0); - ThemeSelect.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); - - - LoadColor(ThemeSelect.ColR, ThemeSelect.ColG, ThemeSelect.ColB, ThemeIni.ReadString(Name, 'Color', '')); - ThemeSelect.Int := ThemeIni.ReadFloat(Name, 'Int', 1); - LoadColor(ThemeSelect.DColR, ThemeSelect.DColG, ThemeSelect.DColB, ThemeIni.ReadString(Name, 'DColor', '')); - ThemeSelect.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); - - LoadColor(ThemeSelect.TColR, ThemeSelect.TColG, ThemeSelect.TColB, ThemeIni.ReadString(Name, 'TColor', '')); - ThemeSelect.TInt := ThemeIni.ReadFloat(Name, 'TInt', 1); - LoadColor(ThemeSelect.TDColR, ThemeSelect.TDColG, ThemeSelect.TDColB, ThemeIni.ReadString(Name, 'TDColor', '')); - ThemeSelect.TDInt := ThemeIni.ReadFloat(Name, 'TDInt', 1); - - LoadColor(ThemeSelect.SBGColR, ThemeSelect.SBGColG, ThemeSelect.SBGColB, ThemeIni.ReadString(Name, 'SBGColor', '')); - ThemeSelect.SBGInt := ThemeIni.ReadFloat(Name, 'SBGInt', 1); - LoadColor(ThemeSelect.SBGDColR, ThemeSelect.SBGDColG, ThemeSelect.SBGDColB, ThemeIni.ReadString(Name, 'SBGDColor', '')); - ThemeSelect.SBGDInt := ThemeIni.ReadFloat(Name, 'SBGDInt', 1); - - LoadColor(ThemeSelect.STColR, ThemeSelect.STColG, ThemeSelect.STColB, ThemeIni.ReadString(Name, 'STColor', '')); - ThemeSelect.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1); - LoadColor(ThemeSelect.STDColR, ThemeSelect.STDColG, ThemeSelect.STDColB, ThemeIni.ReadString(Name, 'STDColor', '')); - ThemeSelect.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1); -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. +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; + 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; + + TThemeSelect = record + Tex: string; + TexSBG: string; + X: integer; + Y: integer; + W: integer; + H: 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; + + 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: TThemeSelect; + SelectDifficulty: TThemeSelect; + SelectLanguage: TThemeSelectSlide; + SelectTabs: TThemeSelect; + SelectSorting: TThemeSelectSlide; + SelectDebug: TThemeSelect; + ButtonExit: TThemeButton; + end; + + TThemeOptionsGraphics = class(TThemeBasic) + SelectFullscreen: TThemeSelect; + SelectSlideResolution: TThemeSelectSlide; + SelectDepth: TThemeSelect; + SelectOscilloscope: TThemeSelect; + SelectLineBonus: TThemeSelect; + SelectMovieSize: TThemeSelect; + ButtonExit: TThemeButton; + end; + + TThemeOptionsSound = class(TThemeBasic) + SelectMicBoost: TThemeSelect; + SelectClickAssist: TThemeSelect; + SelectBeatClick: TThemeSelect; + SelectThreshold: TThemeSelect; + //Song Preview + SelectSlidePreviewVolume: TThemeSelectSlide; + SelectSlidePreviewFading: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsLyrics = class(TThemeBasic) + SelectLyricsFont: TThemeSelect; + SelectLyricsEffect: TThemeSelectSlide; + SelectSolmization: TThemeSelect; + SelectNoteLines: TThemeSelect; + 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: TThemeSelect; + SelectEffectSing: TThemeSelect; + SelectScreenFade: TThemeSelect; + SelectLineBonus: TThemeSelect; + SelectAskbeforeDel: TThemeSelect; + SelectOnSongClick: TThemeSelectSlide; + SelectPartyPopup: TThemeSelect; + 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 ThemeLoadSelect(var ThemeSelect: TThemeSelect; 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'); + + ThemeLoadSelect(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers'); + ThemeLoadSelect(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty'); + ThemeLoadSelectSlide(OptionsGame.SelectLanguage, 'OptionsGameSelectSlideLanguage'); + ThemeLoadSelect(OptionsGame.SelectTabs, 'OptionsGameSelectTabs'); + ThemeLoadSelectSlide(OptionsGame.SelectSorting, 'OptionsGameSelectSlideSorting'); + ThemeLoadSelect(OptionsGame.SelectDebug, 'OptionsGameSelectDebug'); + ThemeLoadButton(OptionsGame.ButtonExit, 'OptionsGameButtonExit'); + + // Options Graphics + ThemeLoadBasic(OptionsGraphics, 'OptionsGraphics'); + + ThemeLoadSelect(OptionsGraphics.SelectFullscreen, 'OptionsGraphicsSelectFullscreen'); + ThemeLoadSelectSlide(OptionsGraphics.SelectSlideResolution, 'OptionsGraphicsSelectSlideResolution'); + ThemeLoadSelect(OptionsGraphics.SelectDepth, 'OptionsGraphicsSelectDepth'); + ThemeLoadSelect(OptionsGraphics.SelectOscilloscope, 'OptionsGraphicsSelectOscilloscope'); + ThemeLoadSelect(OptionsGraphics.SelectLineBonus, 'OptionsGraphicsSelectLineBonus'); + ThemeLoadSelect(OptionsGraphics.SelectMovieSize, 'OptionsGraphicsSelectMovieSize'); + ThemeLoadButton(OptionsGraphics.ButtonExit, 'OptionsGraphicsButtonExit'); + + // Options Sound + ThemeLoadBasic(OptionsSound, 'OptionsSound'); + + ThemeLoadSelect(OptionsSound.SelectMicBoost, 'OptionsSoundSelectMicBoost'); + ThemeLoadSelect(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist'); + ThemeLoadSelect(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick'); + ThemeLoadSelect(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold'); + //Song Preview + ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume'); + ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading'); + + ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); + + // Options Lyrics + ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); + + ThemeLoadSelect(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); + ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); + ThemeLoadSelect(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); + ThemeLoadSelect(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'); + + ThemeLoadSelect (OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation'); + ThemeLoadSelect (OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade'); + ThemeLoadSelect (OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing'); + ThemeLoadSelect (OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus'); + ThemeLoadSelectSlide (OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick'); + ThemeLoadSelect (OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); + ThemeLoadSelect (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.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.ThemeLoadSelect(var ThemeSelect: TThemeSelect; Name: string); +var + C: integer; +begin + ThemeSelect.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + + ThemeSelect.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', ''); + ThemeSelect.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', ''); + + ThemeSelect.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeSelect.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeSelect.W := ThemeIni.ReadInteger(Name, 'W', 0); + ThemeSelect.H := ThemeIni.ReadInteger(Name, 'H', 0); + ThemeSelect.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); + + + LoadColor(ThemeSelect.ColR, ThemeSelect.ColG, ThemeSelect.ColB, ThemeIni.ReadString(Name, 'Color', '')); + ThemeSelect.Int := ThemeIni.ReadFloat(Name, 'Int', 1); + LoadColor(ThemeSelect.DColR, ThemeSelect.DColG, ThemeSelect.DColB, ThemeIni.ReadString(Name, 'DColor', '')); + ThemeSelect.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); + + LoadColor(ThemeSelect.TColR, ThemeSelect.TColG, ThemeSelect.TColB, ThemeIni.ReadString(Name, 'TColor', '')); + ThemeSelect.TInt := ThemeIni.ReadFloat(Name, 'TInt', 1); + LoadColor(ThemeSelect.TDColR, ThemeSelect.TDColG, ThemeSelect.TDColB, ThemeIni.ReadString(Name, 'TDColor', '')); + ThemeSelect.TDInt := ThemeIni.ReadFloat(Name, 'TDInt', 1); + + LoadColor(ThemeSelect.SBGColR, ThemeSelect.SBGColG, ThemeSelect.SBGColB, ThemeIni.ReadString(Name, 'SBGColor', '')); + ThemeSelect.SBGInt := ThemeIni.ReadFloat(Name, 'SBGInt', 1); + LoadColor(ThemeSelect.SBGDColR, ThemeSelect.SBGDColG, ThemeSelect.SBGDColB, ThemeIni.ReadString(Name, 'SBGDColor', '')); + ThemeSelect.SBGDInt := ThemeIni.ReadFloat(Name, 'SBGDInt', 1); + + LoadColor(ThemeSelect.STColR, ThemeSelect.STColG, ThemeSelect.STColB, ThemeIni.ReadString(Name, 'STColor', '')); + ThemeSelect.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1); + LoadColor(ThemeSelect.STDColR, ThemeSelect.STDColG, ThemeSelect.STDColB, ThemeIni.ReadString(Name, 'STDColor', '')); + ThemeSelect.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1); +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/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index b03f29bf..bef77728 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -1,857 +1,857 @@ -{############################################################################## - # 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; - -//{$define DebugDisplay} // uncomment if u want to see the debug stuff -//{$define DebugFrames} -//{$define VideoBenchmark} -//{$define Info} - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -(* - TODO: look into av_read_play -*) - -// use BGR-format for accelerated colorspace conversion with swscale -{.$DEFINE PIXEL_FMT_BGR} - -implementation - -uses - SDL, - textgl, - avcodec, - avformat, - avutil, - avio, - rational, - {$IFDEF UseSWScale} - swscale, - {$ENDIF} - 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; - - procedure Reset(); - function DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; - function FindStreamIDs( const aFormatCtx : PAVFormatContext; out aFirstVideoStream, aFirstAudioStream : integer ): boolean; - procedure SynchronizeVideo(pFrame: PAVFrame; var pts: double); - public - constructor Create(); - function GetName: String; - procedure Init(); - - 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 - singleton_VideoFFMpeg : IVideoPlayback; - - - -function FFMpegErrorString(Errnum: integer): string; -begin - case Errnum 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(Errnum); - end; -end; - -// 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(pCodecCtx: PAVCodecContext; pFrame: PAVFrame): integer; cdecl; -var - pts: Pint64; - VideoPktPts: Pint64; -begin - Result := avcodec_default_get_buffer(pCodecCtx, pFrame); - VideoPktPts := pCodecCtx^.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^; - pFrame^.opaque := pts; - end; -end; - -procedure PtsReleaseBuffer(pCodecCtx: PAVCodecContext; pFrame: PAVFrame); cdecl; -begin - if (pFrame <> nil) then - av_freep(@pFrame^.opaque); - avcodec_default_release_buffer(pCodecCtx, pFrame); -end; - - -{*------------------------------------------------------------------------------ - * TVideoPlayback_ffmpeg - *------------------------------------------------------------------------------} - -function TVideoPlayback_ffmpeg.GetName: String; -begin - result := 'FFMpeg_Video'; -end; - -{ - @param(aFormatCtx is a PAVFormatContext returned from av_open_input_file ) - @param(aFirstVideoStream is an OUT value of type integer, this is the index of the video stream) - @param(aFirstAudioStream is an OUT value of type integer, this is the index of the audio stream) - @returns(@true on success, @false otherwise) -} -function TVideoPlayback_ffmpeg.FindStreamIDs(const aFormatCtx: PAVFormatContext; out aFirstVideoStream, aFirstAudioStream: integer): boolean; -var - i : integer; - st : PAVStream; -begin - // Find the first video stream - aFirstAudioStream := -1; - aFirstVideoStream := -1; - - {$IFDEF DebugDisplay} - debugwriteln('aFormatCtx.nb_streams : ' + inttostr(aFormatCtx.nb_streams)); - {$ENDIF} - - for i := 0 to aFormatCtx.nb_streams-1 do - begin - st := aFormatCtx.streams[i]; - - if (st.codec.codec_type = CODEC_TYPE_VIDEO) and - (aFirstVideoStream < 0) then - begin - aFirstVideoStream := i; - end; - - if (st.codec.codec_type = CODEC_TYPE_AUDIO) and - (aFirstAudioStream < 0) then - begin - aFirstAudioStream := i; - end; - end; - - // return true if either an audio- or video-stream was found - result := (aFirstAudioStream > -1) or - (aFirstVideoStream > -1) ; -end; - -procedure TVideoPlayback_ffmpeg.SynchronizeVideo(pFrame: 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 + pFrame^.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; - - // 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, RenderAspect: 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} - - ScreenAspect := ScreenW / ScreenH; - RenderAspect := RenderW / RenderH; - ScaledVideoWidth := RenderW; - ScaledVideoHeight := ScaledVideoWidth/VideoAspect * ScreenAspect/RenderAspect; - - // Note: Scaling the width does not look good because the video might contain - // black borders at the top already - //ScaledVideoHeight := RenderH; - //ScaledVideoWidth := ScaledVideoHeight*VideoAspect * RenderAspect/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; - -constructor TVideoPlayback_ffmpeg.Create(); -begin - inherited; - Reset(); - av_register_all(); -end; - -procedure TVideoPlayback_ffmpeg.Init(); -begin - glGenTextures(1, PGLuint(@fVideoTex)); -end; - -procedure TVideoPlayback_ffmpeg.Reset(); -begin - // close previously opened video - Close(); - - fVideoOpened := False; - fVideoPaused := False; - VideoTimeBase := 0; - VideoTime := 0; - VideoStream := nil; - VideoFormatContext := nil; - VideoCodecContext := nil; - VideoStreamIndex := -1; - - AVFrame := nil; - AVFrameRGB := nil; - FrameBuffer := nil; - - 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; - err: GLenum; - AudioStreamIndex: integer; - - procedure CleanOnError(); - begin - if (VideoCodecContext <> nil) then - avcodec_close(VideoCodecContext); - if (VideoFormatContext <> nil) then - av_close_input_file(VideoFormatContext); - av_free(AVFrameRGB); - av_free(AVFrame); - av_free(FrameBuffer); - end; - -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+'" ('+FFMpegErrorString(errnum)+')'); - Exit; - end; - - // update video info - if (av_find_stream_info(VideoFormatContext) < 0) then - begin - Log.LogError('No stream info found', 'TVideoPlayback_ffmpeg.Open'); - CleanOnError(); - Exit; - end; - Log.LogInfo('VideoStreamIndex : ' + inttostr(VideoStreamIndex), 'TVideoPlayback_ffmpeg.Open'); - - // find video stream - FindStreamIDs(VideoFormatContext, VideoStreamIndex, AudioStreamIndex); - if (VideoStreamIndex < 0) then - begin - Log.LogError('No video stream found', 'TVideoPlayback_ffmpeg.Open'); - CleanOnError(); - 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'); - CleanOnError(); - 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; - - errnum := avcodec_open(VideoCodecContext, VideoCodec); - if (errnum < 0) then - begin - Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open'); - CleanOnError(); - 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'); - CleanOnError(); - 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: ' + FFMpegErrorString(errnum), 'TVideoPlayback_ffmpeg.Open'); - CleanOnError(); - 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'); - CleanOnError(); - 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 fVideoOpened then - begin - av_free(FrameBuffer); - av_free(AVFrameRGB); - av_free(AVFrame); - - avcodec_close(VideoCodecContext); - av_close_input_file(VideoFormatContext); - - fVideoOpened := False; - end; -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 (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'); - end; -end; - -function TVideoPlayback_ffmpeg.GetPosition: real; -begin - // TODO: return video-position in seconds - result := VideoTime; -end; - -initialization - singleton_VideoFFMpeg := TVideoPlayback_ffmpeg.create(); - AudioManager.add( singleton_VideoFFMpeg ); - -finalization - AudioManager.Remove( singleton_VideoFFMpeg ); - -end. +{############################################################################## + # 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; + +//{$define DebugDisplay} // uncomment if u want to see the debug stuff +//{$define DebugFrames} +//{$define VideoBenchmark} +//{$define Info} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +(* + TODO: look into av_read_play +*) + +// use BGR-format for accelerated colorspace conversion with swscale +{.$DEFINE PIXEL_FMT_BGR} + +implementation + +uses + SDL, + textgl, + avcodec, + avformat, + avutil, + avio, + rational, + {$IFDEF UseSWScale} + swscale, + {$ENDIF} + 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; + + procedure Reset(); + function DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; + function FindStreamIDs( const aFormatCtx : PAVFormatContext; out aFirstVideoStream, aFirstAudioStream : integer ): boolean; + procedure SynchronizeVideo(pFrame: PAVFrame; var pts: double); + public + constructor Create(); + function GetName: String; + procedure Init(); + + 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 + singleton_VideoFFMpeg : IVideoPlayback; + + + +function FFMpegErrorString(Errnum: integer): string; +begin + case Errnum 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(Errnum); + end; +end; + +// 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(pCodecCtx: PAVCodecContext; pFrame: PAVFrame): integer; cdecl; +var + pts: Pint64; + VideoPktPts: Pint64; +begin + Result := avcodec_default_get_buffer(pCodecCtx, pFrame); + VideoPktPts := pCodecCtx^.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^; + pFrame^.opaque := pts; + end; +end; + +procedure PtsReleaseBuffer(pCodecCtx: PAVCodecContext; pFrame: PAVFrame); cdecl; +begin + if (pFrame <> nil) then + av_freep(@pFrame^.opaque); + avcodec_default_release_buffer(pCodecCtx, pFrame); +end; + + +{*------------------------------------------------------------------------------ + * TVideoPlayback_ffmpeg + *------------------------------------------------------------------------------} + +function TVideoPlayback_ffmpeg.GetName: String; +begin + result := 'FFMpeg_Video'; +end; + +{ + @param(aFormatCtx is a PAVFormatContext returned from av_open_input_file ) + @param(aFirstVideoStream is an OUT value of type integer, this is the index of the video stream) + @param(aFirstAudioStream is an OUT value of type integer, this is the index of the audio stream) + @returns(@true on success, @false otherwise) +} +function TVideoPlayback_ffmpeg.FindStreamIDs(const aFormatCtx: PAVFormatContext; out aFirstVideoStream, aFirstAudioStream: integer): boolean; +var + i : integer; + st : PAVStream; +begin + // Find the first video stream + aFirstAudioStream := -1; + aFirstVideoStream := -1; + + {$IFDEF DebugDisplay} + debugwriteln('aFormatCtx.nb_streams : ' + inttostr(aFormatCtx.nb_streams)); + {$ENDIF} + + for i := 0 to aFormatCtx.nb_streams-1 do + begin + st := aFormatCtx.streams[i]; + + if (st.codec.codec_type = CODEC_TYPE_VIDEO) and + (aFirstVideoStream < 0) then + begin + aFirstVideoStream := i; + end; + + if (st.codec.codec_type = CODEC_TYPE_AUDIO) and + (aFirstAudioStream < 0) then + begin + aFirstAudioStream := i; + end; + end; + + // return true if either an audio- or video-stream was found + result := (aFirstAudioStream > -1) or + (aFirstVideoStream > -1) ; +end; + +procedure TVideoPlayback_ffmpeg.SynchronizeVideo(pFrame: 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 + pFrame^.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; + + // 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, RenderAspect: 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} + + ScreenAspect := ScreenW / ScreenH; + RenderAspect := RenderW / RenderH; + ScaledVideoWidth := RenderW; + ScaledVideoHeight := ScaledVideoWidth/VideoAspect * ScreenAspect/RenderAspect; + + // Note: Scaling the width does not look good because the video might contain + // black borders at the top already + //ScaledVideoHeight := RenderH; + //ScaledVideoWidth := ScaledVideoHeight*VideoAspect * RenderAspect/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; + +constructor TVideoPlayback_ffmpeg.Create(); +begin + inherited; + Reset(); + av_register_all(); +end; + +procedure TVideoPlayback_ffmpeg.Init(); +begin + glGenTextures(1, PGLuint(@fVideoTex)); +end; + +procedure TVideoPlayback_ffmpeg.Reset(); +begin + // close previously opened video + Close(); + + fVideoOpened := False; + fVideoPaused := False; + VideoTimeBase := 0; + VideoTime := 0; + VideoStream := nil; + VideoFormatContext := nil; + VideoCodecContext := nil; + VideoStreamIndex := -1; + + AVFrame := nil; + AVFrameRGB := nil; + FrameBuffer := nil; + + 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; + err: GLenum; + AudioStreamIndex: integer; + + procedure CleanOnError(); + begin + if (VideoCodecContext <> nil) then + avcodec_close(VideoCodecContext); + if (VideoFormatContext <> nil) then + av_close_input_file(VideoFormatContext); + av_free(AVFrameRGB); + av_free(AVFrame); + av_free(FrameBuffer); + end; + +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+'" ('+FFMpegErrorString(errnum)+')'); + Exit; + end; + + // update video info + if (av_find_stream_info(VideoFormatContext) < 0) then + begin + Log.LogError('No stream info found', 'TVideoPlayback_ffmpeg.Open'); + CleanOnError(); + Exit; + end; + Log.LogInfo('VideoStreamIndex : ' + inttostr(VideoStreamIndex), 'TVideoPlayback_ffmpeg.Open'); + + // find video stream + FindStreamIDs(VideoFormatContext, VideoStreamIndex, AudioStreamIndex); + if (VideoStreamIndex < 0) then + begin + Log.LogError('No video stream found', 'TVideoPlayback_ffmpeg.Open'); + CleanOnError(); + 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'); + CleanOnError(); + 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; + + errnum := avcodec_open(VideoCodecContext, VideoCodec); + if (errnum < 0) then + begin + Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open'); + CleanOnError(); + 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'); + CleanOnError(); + 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: ' + FFMpegErrorString(errnum), 'TVideoPlayback_ffmpeg.Open'); + CleanOnError(); + 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'); + CleanOnError(); + 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 fVideoOpened then + begin + av_free(FrameBuffer); + av_free(AVFrameRGB); + av_free(AVFrame); + + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + + fVideoOpened := False; + end; +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 (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'); + end; +end; + +function TVideoPlayback_ffmpeg.GetPosition: real; +begin + // TODO: return video-position in seconds + result := VideoTime; +end; + +initialization + singleton_VideoFFMpeg := TVideoPlayback_ffmpeg.create(); + AudioManager.add( singleton_VideoFFMpeg ); + +finalization + AudioManager.Remove( singleton_VideoFFMpeg ); + +end. diff --git a/Game/Code/Classes/UXMLSong.pas b/Game/Code/Classes/UXMLSong.pas index ddcb173a..1a1fe6bc 100644 --- a/Game/Code/Classes/UXMLSong.pas +++ b/Game/Code/Classes/UXMLSong.pas @@ -1,573 +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 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. +unit UPluginLoader; +{********************* + UPluginLoader + Unit contains to Classes + TPluginLoader: Class Searching for and Loading the Plugins + TtehPlugins: Class that represents the Plugins in Modules chain +*********************} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UPluginDefs, + UCoreModule; + +type + TPluginListItem = record + Info: TUS_PluginInfo; + State: Byte; //State of this Plugin: 0 - undefined; 1 - Loaded; 2 - Inited / Running; 4 - Unloaded; 254 - Loading aborted by Plugin; 255 - Unloaded because of Error + Path: String; //Path to this Plugin + NeedsDeInit: Boolean; //If this is Inited correctly this should be true + hLib: THandle; //Handle of Loaded Libary + Procs: record //Procs offered by Plugin. Don't call this directly use wrappers of TPluginLoader + Load: Func_Load; + Init: Func_Init; + DeInit: Proc_DeInit; + end; + end; + {********************* + TPluginLoader + Class Searches for Plugins and Manages loading and unloading + *********************} + PPluginLoader = ^TPluginLoader; + TPluginLoader = class (TCoreModule) + private + LoadingProcessFinished: Boolean; + sUnloadPlugin: THandle; + sLoadPlugin: THandle; + sGetPluginInfo: THandle; + sGetPluginState: THandle; + + procedure FreePlugin(Index: Cardinal); + public + PluginInterface: TUS_PluginInterface; + Plugins: array of TPluginListItem; + + //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; + + //New Methods + procedure BrowseDir(Path: String); //Browses the Path at _Path_ for Plugins + function PluginExists(Name: String): integer; //If Plugin Exists: Index of Plugin, else -1 + procedure AddPlugin(Filename: String);//Adds Plugin to the Array + + function CallLoad(Index: Cardinal): integer; + function CallInit(Index: Cardinal): integer; + procedure CallDeInit(Index: Cardinal); + + //Services offered + function LoadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + function UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + function GetPluginInfo(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 (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